home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROGS.ZIP / HEBENG.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  9.3 KB  |  285 lines
  1. ############################################################################
  2. #
  3. #    File:     hebeng.icn
  4. #
  5. #    Subject:  Program to print mixed Hebrew and English text
  6. #
  7. #    Author:   Alan D. Corre
  8. #
  9. #    Date:     February 12, 1992
  10. #
  11. ###########################################################################
  12. #
  13. #  Requires:  ProIcon
  14. #
  15. ############################################################################
  16. #
  17. #  This program is written in ProIcon for the Macintosh computer. Alan D. Corre
  18. #  August 1991. It takes input in a transcription of Hebrew which represents
  19. #  current pronunciation adequately but mimics the peculiarities of Hebrew
  20. #  spelling. Here are some sentences from the beginning of Agnon's story 
  21. #  "Friendship": marat qliyngel 'i$ah mefursemet haytah umenahelet beyt sefer
  22. #  haytah qowdem liymowt hamilHamah. mi$eni$tanu sidrey ha`owlam,neHtexah
  23. #  migdulatah..wexol miy $eyac'u low mowniyTiyn ba`owlam haytah mitqarevet
  24. #  'eclow weyowce't wenixneset leveytow" The letter sin is represented by the
  25. #  German ess-zed which is alt-s on the Mac and cannot be represented here.
  26. #  The tilde (~)toggles between English and Hebrew, so the word "bar" will be
  27. #  the English word "bar" or the Hebrew beyt-rey$ according to the current
  28. #  mode of the program. Finals are inserted automatically. Justification
  29. #  both ways occurs unless the program detects a blank or empty line, in
  30. #  which case the previous line is not justified.
  31. #  Since I took out non-ASCII chars, and have not rechecked that this
  32. #  works with the corresponding octal chars, there could be some slips in
  33. #  this text.
  34. ############################################################################
  35.  
  36. global outfilename, outvar, outwin,hebrew_string_flag, hebrew_text_flag,
  37.     screenwidth,screenheight,markers
  38.  
  39. procedure main()
  40. #message() creates a standard Mac message box
  41.     if message("Do you wish to create a new text or print an old one?","New",
  42.         "Old") then newtext() else
  43.         oldtext()
  44. #Empty and hide the interactive window
  45.     wset(0,5)
  46.     wset(0,0)
  47. end
  48.  
  49.  
  50. procedure newtext()
  51.     set_markers()
  52.     get_info()
  53.     get_screensize()
  54.     create_file()
  55.     go()
  56. end
  57.  
  58. procedure oldtext()
  59. #getfile() allows selection of a file already available
  60.     outfilename := getfile("Please select file.",,)
  61. #attempt to open a window with the name of the file
  62.     if not (outwin := wopen(outfilename,"f")) then stop()
  63. #put a font in this window which has Hebrew letters in high ASCII numbers
  64.     wfont(outwin,"Ivrit")
  65. #use 12-point
  66.     wfontsize(outwin,12)
  67. #show the window. The user wishing to edit must make the window active
  68. #and use the appropriate alt keys to edit the Hebrew text. This is not
  69. #necessary when using the transcription initially
  70.     wset(outwin,1)
  71.     if message("Do you wish to edit? (Press return when through editing.)","Yes","No") then
  72.             read()
  73.     if message("Do you wish to print?","Yes","No") then
  74. #send the window to the printer if the user desires
  75.             wprint(outwin,1,1)
  76. end
  77.  
  78. procedure set_markers()
  79. #five letters preceding these characters take a special final shape
  80.     markers := ' ,.;:-\324\"?)]}'
  81. end
  82.  
  83.  
  84. procedure get_info()
  85. local dimlist
  86.     outfilename := gettext("What is the name of your output file?",,"Cancel")
  87.     if /outfilename then stop()
  88. #the program has to know what is the principal language in order to leave
  89. #blanks at paragraph endings properly. When the text flag is set, then the
  90. #program overall is operating in Hebrew mode. When the string flag is set
  91. #the current string is Hebrew
  92.     if message("What is the principal language of the text?","Hebrew","English") then
  93.         hebrew_string_flag := hebrew_text_flag := 1
  94.     if \hebrew_text_flag then {
  95.         if not message("The principal language used is Hebrew.","Okay","Cancel") then
  96.         stop()} else
  97.     if not message("The principal language used is English.","Okay","Cancel") then
  98.         stop()
  99. end
  100.  
  101. procedure get_screensize()
  102. local dimlist
  103. #&screen is a list. Work with the old standard mac screen
  104.     dimlist := &screen
  105.     screenheight := dimlist[3]
  106.     screenwidth := dimlist[4]
  107.     if screenwidth > 470 then screenwidth := 470
  108. end
  109.  
  110.  
  111. procedure create_file()
  112. #arrange the various fonts and sizes
  113.     outwin := wopen(outfilename,"n")
  114.     outvar := open(outfilename,"w")
  115.     wsize(0,screenwidth,(screenheight / 2 - 40))
  116.     wsize(outwin,screenwidth,(screenheight / 2 - 40))
  117.     wfont(outwin,"Ivrit")
  118.     wfontsize(outwin,12) 
  119.     wfont(0,"Geneva")
  120.     wfontsize(0,12)
  121. #position windows
  122.     wmove(0,0,40)
  123.     wmove(outwin,0,screenheight / 2 + 20)
  124.     wset(outwin,1) #show the output window
  125. end
  126.     
  127. procedure process(l)
  128. local cursor,substring,newline
  129. if *l = 0 then return " "
  130.     cursor := 1
  131.     newline := ""
  132. #look for a tilde, and piece together a new line accordingly
  133.     l ? while substring := tab(upto('~')) do {
  134.     move(1)
  135.     if \hebrew_string_flag then substring := hebraize(substring)
  136.     if /hebrew_text_flag then newline ||:= substring else
  137.         newline := (substring || newline)
  138. #string flag toggle
  139.     (/hebrew_string_flag := 1) | (hebrew_string_flag := &null)
  140.     cursor := &pos}
  141.     substring := l[cursor:0]
  142.     if \hebrew_string_flag then substring := hebraize(substring) 
  143.     if /hebrew_text_flag then newline ||:= substring else
  144.         newline := (substring || newline)
  145. return newline
  146. end
  147.  
  148. procedure justify(l)
  149. #doesnt give perfect right justification, but its good enough
  150. local stringlength,counter,n,increment,newline
  151.     stringlength := wtextwidth(outwin,l)
  152.     newline := l
  153.     increment := 1
  154.     while stringlength < screenwidth do {
  155.         counter := 0
  156.         l ? every n := upto(' ') do {
  157.                     newline[n + (counter * increment)] := "  "
  158.                     counter +:= 1
  159.                     stringlength +:= 4
  160.                     if stringlength >= screenwidth then break}
  161.         increment +:= 1}
  162. return newline
  163. end
  164.  
  165. procedure go()
  166. #the appearence of the Hebrew/English window lags one line behind the
  167. #input window
  168. local line,line2,counter,mess
  169.     counter := 0
  170.     line := read()    
  171. #octal 263 is option-period.
  172.     if line == "\263" then stop()
  173.     while (line2 := read()) ~== "\263" do {
  174.         counter +:= 1
  175.         if ((not match(" ",line2)) & (*line2 ~= 0)) then
  176.         line := justify(process(line)) else 
  177.           if /hebrew_text_flag then line := process(line) else
  178.                 line := rt(process(line))
  179.         if (wtextwidth(outwin,line) - screenwidth) > 10 then {
  180.             mess := "Warning. Line " || counter || " is " || (wtextwidth(outwin,line) -
  181.             screenwidth) || " pixels too long."
  182.             message(mess,"Okay","")}
  183.         write(outvar,line)
  184.         line := line2}
  185.     if /hebrew_text_flag then line := process(line) else
  186.         line := rt(process(line))
  187.             if (wtextwidth(outwin,line) - screenwidth) > 10 then {
  188.             mess := "Warning. Last Line is " || (wtextwidth(outwin,line) -
  189.             screenwidth) || " pixels too long."
  190.             message(mess,"Okay","")}
  191.     write(outvar,line)
  192.     if message("Do you wish to print?","Yes","No") then wprint(outwin,1,1)
  193.     close(outvar)
  194.     wclose(outwin,"")
  195. end
  196.  
  197. procedure hebraize(l)
  198. static s2,s3
  199. #' is used for aleph. For the abreviation sign use either alt-] which gives
  200. #an appropriate sign, or alt-' which is easier to remember but gives a funny
  201. #looking digraph on the screen
  202.     initial{ s2 := "u\'\276\324bvgdhwzHTykKlmMnNs`pfFcCqr$\247tx\261\335(){}[]X"
  203.                      s3 := "\267\324\'\'\272\272\355\266\372\267\275\305\303\264\373\373\302\265_
  204.                                      \265\176\176\247\322\304\304\304\215\215\317\250\246\244\240_
  205.                                     \373+$)(}{][\373"}
  206. #the following (1) inserts initial aleph in case the student has forgotten it
  207. #(2) takes care of final x with vowel (all other finals are vowelless in
  208. #modern Hebrew (3) takes out vowels except u which is usually represented in
  209. #modern Hebrew (4) takes care of other finals (5) converts to Hebrew letters
  210. #(6) reverses to Hebrew direction
  211.     l := reverse(map(finals(devowel(xa(aleph(l)))),s2,s3))
  212. return l
  213. end
  214.  
  215. procedure aleph(l)
  216. #inserts an aleph in words beginning with vowels only
  217. #this alters the duplicate line; compare procedure devowel which rebuilds
  218. #the line from scratch
  219. local newl,offset
  220.     newl := l
  221.     offset := 0
  222.     if upto('aeiou',l[1]) then {
  223.         offset +:= 1
  224.         newl[1] := ("\'" || l[1])}
  225.         l ?  while tab(upto(' ')) do {
  226.                         tab(many(' '))
  227.                         if upto('aeiou',l[&pos]) then {
  228.                             newl[&pos + offset] := ("\'" || l[&pos])
  229.                             offset +:= 1}}
  230. return newl
  231. end
  232.  
  233. procedure xa(s)
  234. #takes care of the special case of final xa
  235. local substr,newstr
  236.     newstr := ""
  237.     s ||:= " "
  238.     s ? {while substr := tab(find("xa")) || move(2) || tab(any(markers)) do {
  239.                     substr[-3] := char(170)
  240.                     newstr ||:= substr}
  241.                 newstr ||:= s[&pos:-1]}
  242. return newstr
  243. end
  244.  
  245.  
  246. procedure finals(l)
  247. #arranges the final letters
  248. static finals,corresp
  249. local newline
  250. initial {finals := 'xmncf'
  251.                      corresp := table("")
  252.                      corresp["x"] := "\301"
  253.                      corresp["m"] := "\243"
  254.                      corresp["n"] := "\242"
  255.                      corresp["f"] := "\354"
  256.                      corresp["c"] := "\260"}
  257.     newline := l
  258.     l ? while tab(upto(finals)) do {
  259.                 move(1)
  260.                 if (any(markers)) | (&pos = *l + 1) then
  261.                     newline[&pos - 1] := corresp[l[&pos - 1]]
  262.                                                                     }
  263. return newline
  264. end
  265.  
  266. procedure rt(l)
  267. #for right justification; chars are of different size
  268. local stringlength,newline
  269.     stringlength := wtextwidth(outwin,l)
  270.     newline := l
  271.     if (screenwidth-stringlength) > 0 then
  272.     newline := (repl(" ",(screenwidth-stringlength +2) / 4) || l)
  273. return newline
  274. end
  275.  
  276. procedure devowel(l)
  277. local newline,substring
  278.     newline := ""
  279.     l ? {while substring := tab(upto('aeio')) do {
  280.         newline ||:= substring
  281.         move(1)}
  282.         newline ||:= l[&pos:0]}
  283. return newline
  284. end
  285.