unit Util;
interface

type PWord = ^Word;

procedure Die(s: string);
function LfsrShift: Word;
function CompareArray(const a, b: array of Byte; const len: Word): boolean;
procedure Delay50(const frames: Word);
procedure HexStr(n: Longint; var s: String);
procedure DebugOut(const s: String);
procedure StopMusic(in_interrupt: boolean);

var counterVal: Longint;
    musicPlaying: boolean;
    musicStartPtr: PChar;
    musicEndPtr: PChar;
    musicDataPtr: PChar;
    musicDelayCount: Byte;

implementation

uses Apricot, Dos;

type ScreenFont = array[0..4095] of Word;

var font0: ScreenFont absolute $0080:0000;

var ExitSave, OldIntFF: Pointer;
var lfsrData: Word;
var savedFont: ^ScreenFont;
var debugFile: Text;

procedure Die(s: string);
begin
    ScreenMode(ScreenModeText);
    Writeln('ERR: ', s);
    Halt(1);
end;

function LfsrShift: Word;
begin
    lfsrData := (
        (((lfsrData SHR 15) XOR (lfsrData SHR 11) XOR
          (lfsrData SHR 8) XOR (lfsrData SHR 5)) AND 1) OR
          (lfsrData SHL 1)
    );
    LfsrShift := lfsrData;
end;

function CompareArray(const a, b: array of Byte; const len: Word): boolean;
var i: Word;
begin
    for i := 0 to len - 1 do begin
        if a[i] <> b[i] then begin
            CompareArray := false;
            Exit;
        end;
    end;
    CompareArray := true;
end;

procedure Delay50(const frames: Word);
var t1: Longint;
begin
    t1 := counterVal + frames;
    repeat until counterVal >= t1;
end;

procedure HexStr(n: Longint; var s: String);
var i: Integer;
    d: Byte;
begin
    s[0] := #8;
    for i := 8 downto 1 do begin
        d := n AND $F;
        if d > 9 then
            s[i] := Char($37 + d)
        else
            s[i] := Char($30 + d);
        n := n SHR 4;
    end;
end;

procedure DebugOut(const s: String);
var f: Text;
begin
    Writeln(debugFile, s);
end;

procedure RestoreSystem; far;
begin
    ExitProc := ExitSave;
    if CurrentScreenMode = ScreenModeGfx then
        ScreenMode(ScreenModeText);

    { stop music }
    StopMusic(false);

    asm cli end;
    SetIntVec($FF, OldIntFF);
    asm sti end;

    { restore the original screen font }
    Move(savedFont^, font0, SizeOf(ScreenFont));
    { no point in deallocating since we're exiting! :P }

    Close(debugFile);

    Writeln('Thank you for playing!');
end;

procedure WasteALittleBitOfTime;
var i: Integer;
begin
    for i := 0 to 10 do;
end;

procedure StopMusic(in_interrupt: boolean);
begin
    musicPlaying := false;
    if not in_interrupt then
        Delay50(1);
    { mute all channels }
    port[$50] := $9F;
    WasteALittleBitOfTime;
    port[$50] := $BF;
    WasteALittleBitOfTime;
    port[$50] := $DF;
    WasteALittleBitOfTime;
    port[$50] := $FF;
end;

procedure ProcessMusic;
var b: Byte;
    i: Word;
begin
    if musicDelayCount > 0 then begin
        Dec(musicDelayCount);
        Exit;
    end;

    repeat
        b := Byte(musicDataPtr^);
        if (b AND $80) = 0 then begin
            for i := 1 to b do begin
                Inc(musicDataPtr);
                port[$50] := Byte(musicDataPtr^);
            end;
        end
        else
        if b = $FF then begin
            StopMusic(true);
            Break;
        end
        else
            musicDelayCount := b AND $7F;
        Inc(musicDataPtr);
        if musicDataPtr = musicEndPtr then
            musicDataPtr := musicStartPtr;
    until musicDelayCount > 0;
end;

procedure TimerHandler(Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP: Word);
interrupt;
begin
    Inc(counterVal);
    if musicPlaying then
        ProcessMusic;
end;

begin
    { set up debug output }
    Assign(debugFile, 'DEBUG.TXT');
    Rewrite(debugFile);

    { restore the screen if we exit }
    ExitSave := ExitProc;
    ExitProc := @RestoreSystem;

    { set up our timing counter }
    counterVal := 0;
    asm cli end;
    GetIntVec($FF, OldIntFF);
    SetIntVec($FF, @TimerHandler);
    asm sti end;

    { seed LFSR }
    lfsrData := 19;

    { save the original screen font }
    New(savedFont);
    Move(font0, savedFont^, SizeOf(ScreenFont));
end.