UNIT Y767UTIL (* Y767 Utility routines  D. J. Wilke N3HGQ 09/26/89 *);

INTERFACE

USES CRT, DOS, Y767GLO;

PROCEDURE ZeroVariables;
PROCEDURE Peep(PeepFreq : INTEGER);
PROCEDURE Warble(HiFreq,LoFreq : INTEGER);
PROCEDURE ErrorAlarm(ErrorStr : String86; Col,Row : INTEGER);
PROCEDURE FreqEntryError;
PROCEDURE InKey(VAR Fk : BOOLEAN; VAR Choice : CHAR);
PROCEDURE Pause;
PROCEDURE ScreenWrite(S : String86; Col,Row : BYTE; Attr : INTEGER);
PROCEDURE WriteHex(Hi : BYTE);
PROCEDURE TestFile;
PROCEDURE CheckFreq(FreqTune : REAL);
FUNCTION MultString(Mult : INTEGER; Ch : CHAR) : STRING;
FUNCTION MakeLSDMSD(FreqInt : STRING; N : INTEGER) : STRING;
FUNCTION FreqParm(LSDFreq : STRING; N : INTEGER) : STRING;
FUNCTION Translate(BCDIn : BYTE) : CHAR;
FUNCTION Bin2BCDHex(BinIn : BYTE) : INTEGER;
FUNCTION Fifo(Lifo : String86) : String86;

IMPLEMENTATION

USES Y767INST;

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
PROCEDURE ZeroVariables;
(* Initialize all global variables *)

BEGIN (* ZeroVariables *)
    FILLCHAR(Zero1,OFS(Zero2) - OFS(Zero1) + SIZEOF(Zero2),0);
END; (* ZeroVariables *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
PROCEDURE Peep(PeepFreq : INTEGER);

BEGIN (* Peep *)
    SOUND(PeepFreq);                         (* Make a peep @ Freq *)
    DELAY(30);                               (* For 30 mSec *)
    NOSOUND;
END; (* Peep *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
PROCEDURE Warble(HiFreq,LoFreq : INTEGER);   (* Error audible alarm *)

VAR
    Index : INTEGER;

BEGIN (* Warble *)
    FOR Index := 1 TO 5 DO BEGIN             (* Number of repetitions *)
        SOUND(HiFreq);
        DELAY(50);
        SOUND(LoFreq);
        DELAY(50);
    END;
    NOSOUND;
END; (* Warble *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
PROCEDURE ErrorAlarm(ErrorStr : String86; Col,Row : INTEGER);
(* Display error banner @ Col, Row. If Col=0, display centered on screen *)

VAR
    Lc : INTEGER;

BEGIN (* ErrorAlarm *)
    TEXTCOLOR(EFG);
    TEXTBACKGROUND(EBG);                     (* Error banner colors *)
    IF Col <> 0 THEN BEGIN                   (* Display at specific loc *)
        ScreenWrite(ErrorStr,Col,Row,207);
        Warble(1000,800);
        Delay(1500);
        TEXTCOLOR(DFG);
        TEXTBACKGROUND(DBG);                 (* Default screen colors *)
        ScreenWrite('                 ' ,Col,Row,0);
    END (* IF Col *)
    ELSE BEGIN
        TEXTCOLOR(DFG);
        TEXTBACKGROUND(DBG);                 (* Default screen colors *)
        CLRSCR;
        Lc := 40 - (LENGTH(ErrorStr) DIV 2) + 1;
        TEXTCOLOR(EFG);
        TEXTBACKGROUND(EBG);                 (* Error banner colors *)
        GOTOXY(Lc,Row); WRITE(ErrorStr);     (* Display centered on screen *)
        TEXTCOLOR(DFG);
        TEXTBACKGROUND(DBG);                 (* Default screen colors *)
    END; (* ELSE *)
END; (* ErrorAlarm *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
PROCEDURE FreqEntryError;

BEGIN (* FreqEntryError *)
    FreqErrorFlag := TRUE;                   (* Raise the flag *)
    ErrorAlarm(FreqErr,58,8);                (* Issue the alarm *)
END; (* FreqEntryError *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
PROCEDURE InKey(VAR Fk : BOOLEAN; VAR Choice : CHAR);
(* Get keyboard input & detect function keys *)

VAR
    Ch : CHAR;

BEGIN (* InKey *)
    Ch := READKEY;
    IF (Ch = #27) AND KEYPRESSED THEN BEGIN  (* Extended code *)
        Ch := READKEY;
        Fk := TRUE;                          (* If true, choice has F key *)
    END; (* IF Ch *)
    Choice := Ch;                            (* Else choice has key *)
END; (* InKey *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
PROCEDURE Pause; (* Pause until any key is struck *)

BEGIN (* Pause *)
    TEXTCOLOR(19);
    TEXTBACKGROUND(DBG);                     (* Pause colors *)
    WINDOW(1,24,80,25);
    GOTOXY(1,2);
    CLREOL;
    GOTOXY(5,2);
    WRITE('Any key to continue...');
    SOUND(2000);
    DELAY(100);
    NOSOUND;
    REPEAT UNTIL KeyPressed;                 (* Tight loop `til key hit *)
    GOTOXY(1,2);
    CLREOL;
    TEXTCOLOR(DFG);
    TEXTBACKGROUND(DBG);                     (* Default screen colors *)
END; (* Pause *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
PROCEDURE ScreenWrite(S : String86; Col,Row : BYTE; Attr : INTEGER);
(* Write string directly to video memory *)

VAR
    Index : INTEGER;

BEGIN
    Attr := Attr SHL 8;                      (* Adjust attribute byte *)
    FOR Index := 1 TO LENGTH(S) DO
        MEMW[ScreenSeg : (Row-1)*160+(Col+Index-2)*2] := ATTR OR ORD(S[Index]);
END; (* ScreenWrite *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
PROCEDURE WriteHex(Hi : BYTE);
(* Display decimal byte as hexadecimal value *)

CONST
    HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';

VAR
    Lo        : BYTE;
    HexStr    : STRING[2];
BEGIN (* WriteHex *)
    Lo     := Hi AND $0F;
    Hi     := Hi SHR 4;
    HexStr := HexDigits[Hi] + HexDigits[Lo];
    WRITE(HexStr);
END; (* WriteHex *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
PROCEDURE TestFile; (* Use UPDATE.DUM for testing purposes *)

VAR
    Ok      : BOOLEAN;
    LIFF    : STRING[86];

BEGIN (* TestFile *)
    ASSIGN(UpdateFile,'UPDATE.DUM');
    {$I-} RESET(UpdateFile) {$I+};
    Ok := (IORESULT = 0);
    IF Ok THEN BEGIN
        READLN(UpdateFile,LIFF);
        Update := Fifo(LIFF);            (* Convert LIFO to FIFO *)
    END (* IF Ok *)
    ELSE BEGIN
        ErrorAlarm(TfileErr,0,12);       (* Issue Test file error warning *)
        Warble(1000,800);
        Pause;
    END; (* ELSE *)
END; (* TestFile *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
PROCEDURE CheckFreq(FreqTune : REAL);
(* Check if frequency is within valid range *)

BEGIN (* CheckFreq *)
    FreqErrorFlag := FALSE;                  (* Bring down the flag *)
    IF (FreqTune < 0.1) THEN FreqEntryError;
    IF (FreqTune > 29.99999) AND (FreqTune < 50.0) THEN FreqEntryError;
    IF (FreqTune > 50.0) AND (FreqTune < 53.99999) THEN
        IF Module6 <> TRUE THEN FreqEntryError;
    IF (FreqTune > 54.0) AND (FreqTune < 144.0) THEN FreqEntryError;
    IF (FreqTune > 144.0) AND (FreqTune < 147.9999) THEN
        IF Module2 <> TRUE THEN FreqEntryError;
    IF (FreqTune > 148.0) AND (FreqTune < 439.99999) THEN
        IF Module70A <> TRUE THEN FreqEntryError;
    IF NOT FreqErrorFlag THEN
        IF (FreqTune > 148.0) AND (FreqTune < 449.99999) THEN
            IF Module70B <> TRUE THEN FreqEntryError;
    IF (FreqTune > 450.0) THEN FreqEntryError;
END; (* CheckFreq *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
FUNCTION MultString(Mult : INTEGER; Ch : CHAR) : STRING;
(* Make a null string of length Nuls *)

VAR
    MC : STRING;

BEGIN (* MultString *)
    MC := '';
    FOR Index := 1 TO Mult DO
        MC := MC + Ch;
    MultString := MC;
END; (* MultString *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
FUNCTION MakeLSDMSD(FreqInt : STRING; N : INTEGER) : STRING;
(* Construct N byte LSDFreq string (LSD -> MSD) *)

VAR
    LSDFreq : STRING[10];

BEGIN (* MakeLSDMSD *)
    LSDFreq := '';
    FOR Index := N DOWNTO 0 DO BEGIN         (* Chars 7&8, 5&6 etc...*)
        IF ODD(Index) THEN BEGIN
            LSDFreq := LSDFreq + COPY(FreqInt,Index,2);
            MakeLSDMSD := LSDFreq;
        END; (* IF ODD *)
    END; (* FOR Index *)
END; (* MakeLSDMSD *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
FUNCTION FreqParm(LSDFreq : STRING; N : INTEGER) : STRING;
(* Convert LSDFreq to N hex bytes *)

VAR
    FreqSet      : STRING[10];
    BCDin,Result : INTEGER;

BEGIN (* FreqParm *)
    FreqSet := '';
    FOR Index := 1 TO N DO BEGIN
        IF ODD(Index) THEN BEGIN             (* Chars 1&2, 3&4 etc...*)
            VAL(COPY(LSDFreq,Index,2),BCDin,Result);
            FreqSet := FreqSet + Translate(BCDin);
            FreqParm := FreqSet;
        END; (* IF ODD *)
    END; (* FOR Index *)
END; (* FreqParm *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
FUNCTION Translate(BCDIn : BYTE) : CHAR;
(* Translate BC Decimal numeric variable to BC Hex character *)
(* Don't use Hex ABCDEF *)

VAR
    FreqTrans : CHAR;

BEGIN (* Translate *)
    IF (BCDIn >= 0) AND (BCDIn < 10)  THEN Translate := CHR(BCDIn);
    IF (BCDIn >  9) AND (BCDIn < 20)  THEN Translate := CHR(BCDIn + 6);
    IF (BCDIn > 19) AND (BCDIn < 30)  THEN Translate := CHR(BCDIn + 12);
    IF (BCDIn > 29) AND (BCDIn < 40)  THEN Translate := CHR(BCDIn + 18);
    IF (BCDIn > 39) AND (BCDIn < 50)  THEN Translate := CHR(BCDIn + 24);
    IF (BCDIn > 49) AND (BCDIn < 60)  THEN Translate := CHR(BCDIn + 30);
    IF (BCDIn > 59) AND (BCDIn < 70)  THEN Translate := CHR(BCDIn + 36);
    IF (BCDIn > 69) AND (BCDIn < 80)  THEN Translate := CHR(BCDIn + 42);
    IF (BCDIn > 79) AND (BCDIn < 90)  THEN Translate := CHR(BCDIn + 48);
    IF (BCDIn > 89) AND (BCDIn < 100) THEN Translate := CHR(BCDIn + 54);
END; (* Translate *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
FUNCTION Bin2BCDHex(BinIn : BYTE) : INTEGER;
(* Convert binary input byte to BCD hexadecimal digit *)

CONST
    (* Use only first 10 Hex digits for BCD Hex conversion *)
    HexDigits : ARRAY[0..9] OF CHAR = '0123456789';

VAR
    Hi,Lo         : BYTE;
    HexStr        : STRING[2];
    BCD,Code      : INTEGER;

BEGIN (* Bin2BCDHex *)
    Hi            := BinIn;                  (* Start with 8 bits *)
    Lo            := Hi AND $0F;             (* Mask off LS 4 bits for Lo *)
    Hi            := Hi SHR 4;               (* Process MS 4 bits for Hi *)
    HexStr        := HexDigits[Hi] + HexDigits[Lo];    (* Find Hex byte equiv *)
    VAL(HexStr,BCD,Code);                    (* Convert to integer *)
    Bin2BCDHex    := BCD;                    (* Return BCD Hex digit *)
END; (* Bin2BCDHex *)

(*²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²*)
FUNCTION Fifo(Lifo : String86) : String86;
(* Inverts Update$ as received (LIFO) to FIFO *)

VAR
    Temp : String86;

BEGIN
    Temp := '';
    FOR Index := LENGTH(Lifo) DOWNTO 1 DO    (* Invert the string *)
        Temp := Temp + COPY(Lifo,Index,1);
    Fifo := Temp;                            (* Fifo is now update stream *)
END;

END. (* of UNIT Y767UTIL *)