home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PAS_0493.ZIP / QTXT2LET.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-15  |  9.8 KB  |  382 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 246 of 298
  3. From : David Solly                         1:163/215.0          12 Apr 93  10:56
  4. To   : Moshe Harel
  5. Subj : Q-Text to Letrix File 1/
  6. ────────────────────────────────────────────────────────────────────────────────
  7. From Israel Moshe Harel was heard to say to David Solly
  8.  
  9. Thank you for taking the time to answer my many questions.  I have to
  10. tell you, though, that I was lucky to have received your letter because
  11. it was addressed to David SALLY and not David SOLLY.
  12.  
  13. MH>David,
  14.  
  15. MH> DS>    Are you familiar with a Hebrew text processor program called QTEXT?
  16.   > DS> I have been able to obtain version 2.10 as public domain software but I
  17.   > DS> am wondering if there has been an update.  Have you ever heard of a
  18.  
  19. MH>Current version of QTEXT is 5.0 and it is commercial :-(
  20.   >It comes now with a full set of utilities, including FAX support.
  21.  
  22. Did you know that Q-Text version 2.10 was written in Turbo Pascal 3?  I
  23. wonder if Itschak Maynts (Isaac Mainz?) has continued to use it in his
  24. later versions.  Anyway, I would be interested in obtaining the latest
  25. version of Q-Text.  Can you give me the distributor's address and the
  26. approximate price?  Thank you.
  27.  
  28. MH>Most Israeli printers have a special ROM. You may use downloadable character
  29.   >sets or even graphic printing if needed. I once used LETTRIX for this purpos
  30.   >on a Hebrew-less printer, and it worked fine (but S L O W . . .).
  31.  
  32.  
  33. I have Letrix 3.6.  This was what I was trying to use to print the
  34. Q-Text files I was writing.  I wrote a program in Turbo Pascal to
  35. convert the Q-Text files into Letrix files.  The printing is slow but
  36. the results are favourable. Another advantage to Letrix Hebrew files is
  37. that they are written completely in low-ASCII and almost readable
  38. without transliteration if one is at all familiar with Hebrew. It is a
  39. good format for posting Hebrew text on the Multi-Lingual echo not only
  40. because it is low-ASCII but also because the method of transliteration
  41. is consistent.
  42.  
  43. Below is my Q-Text file to Letrix file conversion program.  I hope you
  44. will find it useful.
  45.  
  46. David Solly
  47.  
  48. ==================== Cut Here ============================== }
  49.  
  50.  
  51. Program QtextLetrix;
  52.  
  53. {$D-}
  54.  
  55. Uses CRT, DOS;
  56.  
  57.  
  58. VAR
  59.  
  60.   Infile, Transfile : Text;
  61.   Infilenm, Transfilenm : PathStr;
  62.   Letter, Ans : Char;
  63.   Printable, Hebrew, Niqud, Roman : Set of Char;
  64.   Nkdm, Rom : Boolean;
  65.  
  66.  
  67.  
  68. {
  69.    "UpItsCase" is a function that takes a sting of any length and
  70.    sets all of the characters in the string to upper case.  It is handy
  71.    for comparing strings.
  72. }
  73.  
  74. function UpItsCase (SourceStr : PathStr): PathStr;
  75. var
  76.   i  : integer;
  77.  
  78. begin
  79.   for i := 1 to length(SourceStr) do
  80.     SourceStr[i] := UpCase(SourceStr[i]);
  81.   UpItsCase := SourceStr
  82. end; {function UpItsCase}
  83.  
  84.  
  85. Function Exist(fname : PathStr) : Boolean;
  86.  
  87. Var f : File;
  88.  
  89. BEGIN
  90.  
  91. {$F-,I-}
  92.   Assign(f, fname);
  93.   Reset(f);
  94.   Close(f);
  95. {$I+}
  96.  
  97. Exist := (IOResult = 0) AND (fname <> '')
  98.  
  99. END; {Function exist}
  100.  
  101.  
  102. Procedure Help;
  103.  
  104. Begin
  105.   Writeln;
  106.   Writeln ('QTLT (Version 1.0)');
  107.   Writeln ('Hebrew Text File Conversion');
  108.   Writeln ('Q-Text 2.10 file to Letrix(R) 3.6 Hebrew file');
  109.   Writeln;
  110.   Writeln;
  111.   Writeln ('QTLT converts Q-Text files to Letrix Hebrew format files.');
  112.   Writeln;
  113.   Writeln ('QTLT expects two parameters on the command line.');
  114.   Writeln ('The first parameter is the name of the file to convert,');
  115.   Writeln ('the second is the name of the new file.');
  116.   Writeln;
  117.   Writeln ('Example:  QTLT  HKVTL.HEB HKVTL.TXT');
  118.   Writeln;
  119.   Writeln ('If no parameters are found, QTLT will display this message.');
  120.   Writeln;
  121.   Halt;
  122.  
  123. End; {Procedure Help}
  124.  
  125.  
  126. {
  127.   "ParseCommandLine" is a procedure that checks if any data was input
  128.   at the DOS command line.  If no data is there, then the "Help"
  129.   procedure is executed and the program is halted.  Otherwise, the
  130.   Mode strig variable is set equal to the text on the command line.
  131. }
  132.  
  133.  
  134. procedure ParseCommandLine;
  135. begin
  136.   if (ParamCount = 0) or (ParamCount <> 2)
  137.     then Help
  138.     else
  139.       begin
  140.         Infilenm := ParamStr(1);
  141.         Infilenm := UpItsCase(Infilenm);
  142.         Transfilenm := ParamStr(2);
  143.         Transfilenm := UpItsCase(Transfilenm);
  144.       end;
  145. end; {procedure ParseCommandLine}
  146.  
  147. Procedure OpenFiles;
  148.  
  149. BEGIN
  150.  
  151.   {Open input/output files}
  152.  
  153.   If not exist(Infilenm) then
  154.     Begin
  155.       Writeln;
  156.       Writeln (Infilenm, ' not found');
  157.       Halt;
  158.     End
  159.     Else
  160.       Begin
  161.         Assign (Infile, Infilenm);
  162.         Reset (Infile);
  163.       End;
  164.  
  165.   If exist (Transfilenm) then
  166.     Begin
  167.       Writeln;
  168.       Writeln (Transfilenm, ' already exists!');
  169.       Write ('Overwrite it?  (Y/N) > ');
  170.       Repeat
  171.         Ans := Readkey;
  172.         Ans := Upcase(Ans);
  173.         If Ans = 'N' then Halt;
  174.       Until Ans = 'Y';
  175.     End;
  176.  
  177.   Assign (Transfile, Transfilenm);
  178.   Rewrite (Transfile);
  179.   Writeln;
  180.  
  181. End; {Procedure OpenFiles}
  182.  
  183.  
  184.  
  185.  
  186.  
  187. Procedure UseOfRoman;
  188.  
  189. Begin
  190.  
  191.   Writeln ('QTLT has detected Roman letters in the source text.');
  192.   Writeln;
  193.   Writeln ('Letrix expects access to a Roman font to print these characters');
  194.   Writeln ('otherwise Letrix will report an error condition of fail to perform.');
  195.   Writeln;
  196.   Writeln ('Sample Letrix load instruction:  LX Hebrew Roman');
  197.   Writeln;
  198.   Writeln ('Be sure that these instances are enclosed within the proper');
  199.   Writeln ('Letrix font switch codes so they are not printed as Hebrew characters');
  200.   Writeln;
  201.  
  202. End; {Procedure UseOfRoman}
  203.  
  204.  
  205. Procedure Niqudim (VAR Letter : Char);
  206.  
  207.   {
  208.      Letrix uses some standard characters to represent niqudim
  209.      while Q-Text does not.
  210.  
  211.      This table ensures that certain characters do not become
  212.      niqudim when translated to Letrix by inserting the tokens
  213.      which instruct the Letrix program to use the alternate
  214.      alphabet -- which by default is number 2.
  215.   }
  216.  
  217.  
  218. BEGIN
  219.  
  220.   If Not Nkdm then
  221.     Begin
  222.       Writeln;
  223.       Writeln ('QTLT has detected Q-Text characters which Letrix normally uses and');
  224.       Writeln ('has transcribed them to print as normal characters.');
  225.       Writeln;
  226.       Writeln ('Letrix expects access a Roman font to print these characters');
  227.       Writeln ('otherwise Letrix will report an error condition of fail to perform.');
  228.       Writeln;
  229.       Writeln ('Sample Letrix load instruction:  LX Hebrew Roman');
  230.       Writeln;
  231.       Nkdm := True;
  232.     End; {if not Nkdm}
  233.  
  234.   CASE Letter of
  235.  
  236.     '!' : Write (Transfile, '\2!\1');
  237.     '@' : Write (Transfile, '\2@\1');
  238.     '#' : Write (Transfile, '\2#\1');
  239.     '$' : Write (Transfile, '\2$\1');
  240.     '%' : Write (Transfile, '\2%\1');
  241.     '^' : Write (Transfile, '\2^\1');
  242.     '&' : Write (Transfile, '\2&\1');
  243.     '*' : Write (Transfile, '\2*\1');
  244.     '(' : Write (Transfile, '\2(\1');
  245.     ')' : Write (Transfile, '\2)\1');
  246.     '+' : Write (Transfile, '\2+\1');
  247.     '=' : Write (Transfile, '\2=\1');
  248.  
  249.   End; {Case}
  250.  
  251. End; {Procedure Nikudim}
  252.  
  253.  
  254.  
  255.  
  256.  
  257. Procedure QT_Table (VAR Letter : Char);
  258.  
  259.   {
  260.     This section reviews each QText letter and matches it with a
  261.     Letrix equivalent where possible
  262.   }
  263.  
  264. BEGIN
  265.  
  266.   CASE Letter of
  267.  
  268.     #128 : Write (Transfile, 'a');  {Alef}
  269.     #129 : Write (Transfile, 'b');  {Bet }
  270.     #130 : Write (Transfile, 'g');  {Gimmel etc. }
  271.     #131 : Write (Transfile, 'd');
  272.     #132 : Write (Transfile, 'h');
  273.     #133 : Write (Transfile, 'w');
  274.     #134 : Write (Transfile, 'z');
  275.     #135 : Write (Transfile, 'H');
  276.     #136 : Write (Transfile, 'T');
  277.     #137 : Write (Transfile, 'y');
  278.     #138 : Write (Transfile, 'C');
  279.     #139 : Write (Transfile, 'c');
  280.     #140 : Write (Transfile, 'l');
  281.     #141 : Write (Transfile, 'M');
  282.     #142 : Write (Transfile, 'm');
  283.     #143 : Write (Transfile, 'N');
  284.     #144 : Write (Transfile, 'n');
  285.     #145 : Write (Transfile, 'S');
  286.     #146 : Write (Transfile, 'i');
  287.     #147 : Write (Transfile, 'F');
  288.     #148 : Write (Transfile, 'p');
  289.     #149 : Write (Transfile, 'X');
  290.     #150 : Write (Transfile, 'x');
  291.     #151 : Write (Transfile, 'k');
  292.     #152 : Write (Transfile, 'r');
  293.     #153 : Write (Transfile, 's');
  294.     #154 : Write (Transfile, 't');
  295.  
  296.   End; {Case of}
  297.  
  298. End; {Procedure QT_Table}
  299.  
  300.  
  301. Procedure DoIt;
  302.  
  303.  
  304.   {
  305.     Special commands requred by Letrix.
  306.     Proportional spacing off, line justification off,
  307.     double-strike on, pitch set to 12 characters per inch.
  308.   }
  309.  
  310. BEGIN
  311.  
  312.   Writeln(transfile,'\p\j\D\#12');
  313.  
  314.   {Transcription loop}
  315.  
  316.   While not eof(Infile) do
  317.  
  318.     Begin
  319.       Read(Infile, Letter);
  320.  
  321.       If (Letter in Printable) then
  322.         Write(Transfile, Letter);
  323.  
  324.       If (Letter in Niqud) then
  325.         Niqudim(Letter);
  326.  
  327.       If (Letter in Hebrew) then
  328.         QT_Table(Letter);
  329.  
  330.       If (Letter in Roman) and (Rom = False) then
  331.         Begin
  332.           UseOfRoman;
  333.           Rom := True;
  334.       End; {Roman Detection}
  335.   End; {while}
  336.  
  337. {Close files}
  338.  
  339. Close (Transfile);
  340. Close (Infile);
  341.  
  342. {Final message}
  343.  
  344. Writeln;
  345. Writeln;
  346. Writeln('QTLT (Version 1.0)');
  347. Writeln('Hebrew Text File Conversion');
  348. Writeln('Q-Text 2.10 files to Letrix(R) 3.6 Hebrew file');
  349. Writeln;
  350. Writeln ('Task Complete');
  351. Writeln;
  352. Writeln ('QTLT was written and released to the public domain by David Solly');
  353. Writeln ('Bibliotheca Sagittarii, Ottawa, Canada (2 December 1992).');
  354. Writeln;
  355.  
  356. End; {Procedure DoIt}
  357.  
  358.  
  359. BEGIN
  360.  
  361.   {Initialize Variables}
  362.   Printable := [#10,#12,#13,#32..#127];
  363.   Roman     := ['A'..'Z','a'..'z'];
  364.   Niqud     := ['!','@','#','$','%','^','&','*','(',')','+','='];
  365.   Printable := Printable - Niqud;
  366.   Hebrew    := [#128..#154];
  367.   Rom       := False;
  368.   Nkdm      := False;
  369.  
  370. ParseCommandLine;
  371. OpenFiles;
  372. DoIt;
  373.  
  374. End.
  375.  
  376.  
  377.  * QMPro 1.0 42-0714 * Bibliotheca Sagittarii, Ottawa, Canada
  378.  
  379. --- Maximus 2.01wb
  380.  * Origin: BitByters BBS, Rockland ON, 446-6234, HST, (1:163/215)
  381.  
  382.