home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / c / caty16.zip / CATYUTIL.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-07  |  11KB  |  307 lines
  1. UNIT CATYUTIL (* CATY Utility routines  D. J. Wilke N3HGQ 1/7/91 *);
  2.  
  3. INTERFACE
  4.  
  5. USES CRT, DOS, CATYGLO;
  6.  
  7. PROCEDURE ZeroVariables;
  8. PROCEDURE Peep(PeepFreq : INTEGER);
  9. PROCEDURE Warble(HiFreq,LoFreq : INTEGER);
  10. PROCEDURE ErrorAlarm(ErrorStr : String86; Col,Row : INTEGER);
  11. PROCEDURE FreqEntryError;
  12. PROCEDURE InKey(VAR Fk : BOOLEAN; VAR Choice : CHAR);
  13. PROCEDURE Pause;
  14. PROCEDURE ScreenWrite(S : String86; Col,Row : BYTE; Attr : INTEGER);
  15. PROCEDURE WriteHex(Hi : BYTE);
  16. PROCEDURE TestFile;
  17. PROCEDURE CheckFreq(FreqTune : REAL);
  18. FUNCTION MultString(Mult : INTEGER; Ch : CHAR) : STRING;
  19. FUNCTION MakeLSDMSD(FreqInt : STRING; N : INTEGER) : STRING;
  20. FUNCTION FreqParm(LSDFreq : STRING; N : INTEGER) : STRING;
  21. FUNCTION Translate(BCDIn : BYTE) : CHAR;
  22. FUNCTION Bin2BCDHex(BinIn : BYTE) : INTEGER;
  23. FUNCTION Fifo(Lifo : String86) : String86;
  24.  
  25. IMPLEMENTATION
  26.  
  27. USES CATYINST, CATYDISP;
  28.  
  29. (*═══════════════════════════════════════════════════════════════════════*)
  30. PROCEDURE ZeroVariables;
  31. (* Initialize all global variables *)
  32.  
  33. BEGIN (* ZeroVariables *)
  34.    FILLCHAR(Zero1,OFS(Zero2) - OFS(Zero1) + SIZEOF(Zero2),0);
  35. END; (* ZeroVariables *)
  36.  
  37. (*═══════════════════════════════════════════════════════════════════════*)
  38. PROCEDURE Peep(PeepFreq : INTEGER);
  39.  
  40. BEGIN (* Peep *)
  41.    SOUND(PeepFreq);                          (* Make a peep @ Freq *)
  42.    DELAY(30);                                (* For 30 mSec *)
  43.    NOSOUND;
  44. END; (* Peep *)
  45.  
  46. (*═══════════════════════════════════════════════════════════════════════*)
  47. PROCEDURE Warble(HiFreq,LoFreq : INTEGER);   (* Error audible alarm *)
  48.  
  49. VAR
  50.    Index : INTEGER;
  51.  
  52. BEGIN (* Warble *)
  53.    SOUND(HiFreq);                            (* High part of warble *)
  54.    DELAY(50);                                (* 50 mSec *)
  55.    SOUND(LoFreq);                            (* Low part of warble *)
  56.    DELAY(50);                                (* 50 mSec *)
  57.    NOSOUND;
  58. END; (* Warble *)
  59.  
  60. (*═══════════════════════════════════════════════════════════════════════*)
  61. PROCEDURE ErrorAlarm(ErrorStr : String86; Col,Row : INTEGER);
  62. (* Display error banner @ Col, Row. If Col=0, display centered on screen *)
  63.  
  64. VAR
  65.    Lc : INTEGER;
  66.  
  67. BEGIN (* ErrorAlarm *)
  68.    TEXTCOLOR(EFG); TEXTBACKGROUND(EBG);      (* Error banner colors *)
  69.    IF Col <> 0 THEN BEGIN                    (* Display at specif loc *)
  70.       ScreenWrite(ErrorStr,Col,Row,207);
  71.       Warble(1000,800);
  72.       Delay(1500);
  73.       TEXTCOLOR(DFG); TEXTBACKGROUND(DBG);   (* Default screen colors *)
  74.       ScreenWrite('                 ' ,Col,Row,0);
  75.    END (* IF Col *)
  76.    ELSE BEGIN
  77.       TEXTCOLOR(DFG); TEXTBACKGROUND(DBG);   (* Default screen colors *)
  78.       CLRSCR;
  79.       Lc := 40 - (LENGTH(ErrorStr) DIV 2) + 1;
  80.       TEXTCOLOR(EFG); TEXTBACKGROUND(EBG);   (* Error banner colors *)
  81.       GOTOXY(Lc,Row); WRITE(ErrorStr);       (* Display centered *)
  82.       TEXTCOLOR(DFG); TEXTBACKGROUND(DBG);   (* Default screen colors *)
  83.    END; (* ELSE *)
  84. END; (* ErrorAlarm *)
  85.  
  86. (*═══════════════════════════════════════════════════════════════════════*)
  87. PROCEDURE FreqEntryError;
  88.  
  89. BEGIN (* FreqEntryError *)
  90.    FreqErrorFlag := TRUE;                    (* Raise the flag *)
  91.    ErrorAlarm(FreqErr,58,8);                 (* Issue the alarm *)
  92. END; (* FreqEntryError *)
  93.  
  94. (*═══════════════════════════════════════════════════════════════════════*)
  95. PROCEDURE InKey(VAR Fk : BOOLEAN; VAR Choice : CHAR);
  96. (* Get keyboard input & detect function keys *)
  97.  
  98. VAR
  99.    Ch : CHAR;
  100.  
  101. BEGIN (* InKey *)
  102.    Ch := READKEY;
  103.    IF (Ch = #27) AND KEYPRESSED THEN BEGIN   (* Extended code *)
  104.       Ch := READKEY;
  105.       Fk := TRUE;                            (* True, choice has F key *)
  106.    END; (* IF Ch *)
  107.    Choice := Ch;                             (* Else choice has key *)
  108. END; (* InKey *)
  109.  
  110. (*═══════════════════════════════════════════════════════════════════════*)
  111. PROCEDURE Pause; (* Pause until any key is struck *)
  112.  
  113. BEGIN (* Pause *)
  114.    SOUND(2000);
  115.    DELAY(100);
  116.    NOSOUND;
  117.    REPEAT UNTIL KeyPressed;                  (* Tight loop `til key hit *)
  118. END; (* Pause *)
  119.  
  120. (*═══════════════════════════════════════════════════════════════════════*)
  121. PROCEDURE ScreenWrite(S : String86; Col,Row : BYTE; Attr : INTEGER);
  122. (* Write string directly to video memory *)
  123.  
  124. VAR
  125.    Index : INTEGER;
  126.  
  127. BEGIN
  128.    Attr := Attr SHL 8;                       (* Adjust attribute byte *)
  129.    FOR Index := 1 TO LENGTH(S) DO
  130.       MEMW[ScreenSeg : (Row-1)*160+(Col+Index-2)*2] 
  131.            := ATTR OR ORD(S[Index]);         (* Place the string w/attr *)
  132. END; (* ScreenWrite *)
  133.  
  134. (*═══════════════════════════════════════════════════════════════════════*)
  135. PROCEDURE WriteHex(Hi : BYTE);
  136. (* Display decimal byte as hexadecimal value *)
  137.  
  138. CONST
  139.    HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';
  140.  
  141. VAR
  142.    Lo        : BYTE;
  143.    HexStr    : STRING[2];
  144.  
  145. BEGIN (* WriteHex *)
  146.    Lo     := Hi AND $0F;
  147.    Hi     := Hi SHR 4;
  148.    HexStr := HexDigits[Hi] + HexDigits[Lo];
  149.    WRITE(HexStr);
  150. END; (* WriteHex *)
  151.  
  152. (*═══════════════════════════════════════════════════════════════════════*)
  153. PROCEDURE TestFile; (* Use UPDATE.DUM for testing purposes *)
  154.  
  155. VAR
  156.    Ok      : BOOLEAN;
  157.    LIFF    : STRING[86];
  158.  
  159. BEGIN (* TestFile *)
  160.    ASSIGN(UpdateFile,'UPDATE.DUM');          (* Name of test file *)
  161.    {$I-} RESET(UpdateFile) {$I+};
  162.    Ok := (IORESULT = 0);
  163.    IF Ok THEN BEGIN
  164.       READLN(UpdateFile,LIFF);               (* Get a line *)
  165.       Update := Fifo(LIFF);                  (* Convert LIFO to FIFO *)
  166.    END (* IF Ok *)
  167.    ELSE BEGIN
  168.       ErrorAlarm(TfileErr,0,12);             (* Issue file error warning *)
  169.       Warble(1000,800);
  170.       PromptLine('M');                       (* Put up Main Menu message *)
  171.    END; (* ELSE *)
  172. END; (* TestFile *)
  173.  
  174. (*═══════════════════════════════════════════════════════════════════════*)
  175. PROCEDURE CheckFreq(FreqTune : REAL);
  176. (* Check if frequency is within valid range *)
  177.  
  178. BEGIN (* CheckFreq *)
  179.    FreqErrorFlag := FALSE;                   (* Bring down the flag *)
  180.    IF (FreqTune < 0.1) THEN FreqEntryError;
  181.    IF (FreqTune > 29.99999) AND (FreqTune < 50.0) THEN FreqEntryError;
  182.    IF NOT MARS THEN 
  183.    BEGIN
  184.        IF (FreqTune > 50.0) AND (FreqTune < 53.99999) THEN
  185.           IF Module6 <> TRUE THEN FreqEntryError;
  186.        IF (FreqTune > 54.0) AND (FreqTune < 144.0) THEN FreqEntryError;
  187.        IF (FreqTune > 144.0) AND (FreqTune < 147.9999) THEN
  188.           IF Module2 <> TRUE THEN FreqEntryError;
  189.        IF (FreqTune > 148.0) AND (FreqTune < 439.99999) THEN
  190.           IF Module70A <> TRUE THEN FreqEntryError;
  191.        IF NOT FreqErrorFlag THEN
  192.           IF (FreqTune > 148.0) AND (FreqTune < 449.99999) THEN
  193.           IF Module70B <> TRUE THEN FreqEntryError;
  194.    END; (* IF NOT MARS *)
  195.    IF (FreqTune > 450.0) THEN FreqEntryError;
  196. END; (* CheckFreq *)
  197.  
  198. (*═══════════════════════════════════════════════════════════════════════*)
  199. FUNCTION MultString(Mult : INTEGER; Ch : CHAR) : STRING;
  200. (* Make a null string of length Nuls *)
  201.  
  202. VAR
  203.    MC : STRING;
  204.  
  205. BEGIN (* MultString *)
  206.    MC := '';
  207.    FOR Index := 1 TO Mult DO
  208.       MC := MC + Ch;                         (* Build string of 0s *)
  209.    MultString := MC;
  210. END; (* MultString *)
  211.  
  212. (*═══════════════════════════════════════════════════════════════════════*)
  213. FUNCTION MakeLSDMSD(FreqInt : STRING; N : INTEGER) : STRING;
  214. (* Construct N byte LSDFreq string (LSD -> MSD) *)
  215.  
  216. VAR
  217.    LSDFreq : STRING[10];
  218.  
  219. BEGIN (* MakeLSDMSD *)
  220.    LSDFreq := '';
  221.    FOR Index := N DOWNTO 0 DO BEGIN          (* Chars 7&8, 5&6 etc...*)
  222.       IF ODD(Index) THEN BEGIN               (* Every other *)
  223.          LSDFreq := LSDFreq + COPY(FreqInt,Index,2);
  224.          MakeLSDMSD := LSDFreq;              (* Now MSD is 1st *)
  225.       END; (* IF ODD *)
  226.    END; (* FOR Index *)
  227. END; (* MakeLSDMSD *)
  228.  
  229. (*═══════════════════════════════════════════════════════════════════════*)
  230. FUNCTION FreqParm(LSDFreq : STRING; N : INTEGER) : STRING;
  231. (* Convert LSDFreq to N hex bytes *)
  232.  
  233. VAR
  234.    FreqSet      : STRING[10];
  235.    BCDin,Result : INTEGER;
  236.  
  237. BEGIN (* FreqParm *)
  238.    FreqSet := '';
  239.    FOR Index := 1 TO N DO BEGIN
  240.       IF ODD(Index) THEN BEGIN               (* Chars 1&2, 3&4 etc...*)
  241.          VAL(COPY(LSDFreq,Index,2),BCDin,Result);
  242.          FreqSet := FreqSet + Translate(BCDin);
  243.          FreqParm := FreqSet;
  244.       END; (* IF ODD *)
  245.    END; (* FOR Index *)
  246. END; (* FreqParm *)
  247.  
  248. (*═══════════════════════════════════════════════════════════════════════*)
  249. FUNCTION Translate(BCDIn : BYTE) : CHAR;
  250. (* Translate BC Decimal numeric variable to BC Hex character *)
  251. (* Don't use Hex ABCDEF *)
  252.  
  253. VAR
  254.    FreqTrans : CHAR;
  255.  
  256. BEGIN (* Translate *)
  257.    IF (BCDIn >= 0) AND (BCDIn < 10)  THEN Translate := CHR(BCDIn);
  258.    IF (BCDIn >  9) AND (BCDIn < 20)  THEN Translate := CHR(BCDIn + 6);
  259.    IF (BCDIn > 19) AND (BCDIn < 30)  THEN Translate := CHR(BCDIn + 12);
  260.    IF (BCDIn > 29) AND (BCDIn < 40)  THEN Translate := CHR(BCDIn + 18);
  261.    IF (BCDIn > 39) AND (BCDIn < 50)  THEN Translate := CHR(BCDIn + 24);
  262.    IF (BCDIn > 49) AND (BCDIn < 60)  THEN Translate := CHR(BCDIn + 30);
  263.    IF (BCDIn > 59) AND (BCDIn < 70)  THEN Translate := CHR(BCDIn + 36);
  264.    IF (BCDIn > 69) AND (BCDIn < 80)  THEN Translate := CHR(BCDIn + 42);
  265.    IF (BCDIn > 79) AND (BCDIn < 90)  THEN Translate := CHR(BCDIn + 48);
  266.    IF (BCDIn > 89) AND (BCDIn < 100) THEN Translate := CHR(BCDIn + 54);
  267. END; (* Translate *)
  268.  
  269. (*═══════════════════════════════════════════════════════════════════════*)
  270. FUNCTION Bin2BCDHex(BinIn : BYTE) : INTEGER;
  271. (* Convert binary input byte to BCD hexadecimal digit *)
  272.  
  273. CONST
  274.    (* Use only first 10 Hex digits for BCD Hex conversion *)
  275.    HexDigits : ARRAY[0..9] OF CHAR = '0123456789';
  276.  
  277. VAR
  278.    Hi,Lo         : BYTE;
  279.    HexStr        : STRING[2];
  280.    BCD,Code      : INTEGER;
  281.  
  282. BEGIN (* Bin2BCDHex *)
  283.    Hi            := BinIn;                   (* Start with 8 bits *)
  284.    Lo            := Hi AND $0F;              (* Mask LS4 bits for Lo *)
  285.    Hi            := Hi SHR 4;                (* Process MS4 bits for Hi *)
  286.    HexStr        := HexDigits[Hi]
  287.                   + HexDigits[Lo];           (* Find Hex byte equiv *)
  288.    VAL(HexStr,BCD,Code);                     (* Convert to integer *)
  289.    Bin2BCDHex    := BCD;                     (* Return BCD Hex digit *)
  290. END; (* Bin2BCDHex *)
  291.  
  292. (*═══════════════════════════════════════════════════════════════════════*)
  293. FUNCTION Fifo(Lifo : String86) : String86;
  294. (* Inverts Update$ as received (LIFO) to FIFO *)
  295.  
  296. VAR
  297.    Temp : String86;
  298.  
  299. BEGIN
  300.    Temp := '';                               (* Initialize variable *)
  301.    FOR Index := LENGTH(Lifo) DOWNTO 1 DO     (* Reverse the string *)
  302.       Temp := Temp + COPY(Lifo,Index,1);     (* CAT sends last first *)
  303.    Fifo := Temp;                             (* Fifo is now upd stream *)
  304. END;
  305.  
  306. END. (* of UNIT CATYUTIL *)
  307.