home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / MISC / JAICNV / JAICNV.OPL < prev    next >
Encoding:
Text File  |  1994-08-13  |  18.0 KB  |  781 lines
  1. rem ********************************************************
  2. rem * JAICNV - Program to convert almost any unit
  3. rem *
  4. rem * Copyright (C) 1994  M.D. Nijdam
  5. rem ********************************************************
  6. rem * This program is free software; you can redistribute it and/or modify
  7. rem * it under the terms of the GNU General Public License as published by
  8. rem * the Free Software Foundation; either version 1, or (at your option)
  9. rem * any later version.
  10. rem *
  11. rem * This program is distributed in the hope that it will be useful,
  12. rem * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. rem * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. rem * GNU General Public License for more details.
  15. rem *
  16. rem * You should have received a copy of the GNU General Public License
  17. rem * along with this program; if not, write to the Free Software
  18. rem * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19. rem ********************************************************
  20. rem *
  21. APP jaicnv
  22.     type $1000
  23.     path "\dat"
  24.     ext "dbf"
  25.     icon "\pic\jaicnv.pic"
  26. ENDA
  27.  
  28. PROC convert:
  29. global pname$(8), version$(5)
  30. global fform1$(255),tform1$(255)
  31. global fform2$(255),tform2$(255)
  32. global cdatafn$(128)
  33. global chelpfn$(128)
  34. local r%, valcat$(128)
  35. REM * globals for dialog
  36. global v1g$(128), v2g$(128), fnvalid%
  37. global vprecis&, vwidth&, notat%, decsign$(1)
  38. global memnr%
  39. global catlist$(255), catnr%,  prevcnr%
  40. global funtlst$(255), funtnr%, prevfnr%
  41. global tuntlst$(255), tuntnr%, prevtnr%
  42. global catunit$(100), catdesc$(100)
  43. global fdesc$(100),tdesc$(100)
  44.  
  45.     pname$="Jaicnv"
  46.     version$="v1.0"
  47.     cdatafn$=dir$("\dat\jaicnv*.dbf")
  48.     if cdatafn$ <> ""
  49.         fnvalid%=opendat%:
  50.     else
  51.         cdatafn$="\dat\jaicnven.dbf"
  52.         fnvalid%=0
  53.         setdef:
  54.         openhlp:
  55.     endif
  56.     disclaim:
  57.     r%=0
  58.     do
  59.         r%=showopn%:
  60.         if r%=0 :break :endif
  61.         do
  62.             if not fnvalid%
  63.                 fnvalid%=opendat%:
  64.             endif
  65.             if fnvalid% and prevcnr% <> catnr% and catnr% > 0
  66.                 readUnt:
  67.                 prevcnr%=catnr%
  68.                 prevfnr%=0
  69.                 prevtnr%=0
  70.             endif
  71.             if prevfnr% <> funtnr% or prevtnr% <> tuntnr%
  72.                 if funtnr% > 0 and tuntnr% > 0
  73.                     readFrm:
  74.                     prevfnr%=funtnr%
  75.                     prevtnr%=tuntnr%
  76.                 endif
  77.             endif
  78.             if funtnr% > 0 and tuntnr% > 0
  79.                 if r%=2
  80.                     valcat$=compute$:(fform1$, v1g$)
  81.                     if valcat$ <> ""
  82.                         valcat$=compute$:(fform2$, valcat$)
  83.                         if valcat$ <> "" :v2g$=valcat$ :endif
  84.                     endif
  85.                 endif
  86.                 if r%=3
  87.                     valcat$=compute$:(tform1$, v2g$)
  88.                     if valcat$ <> ""
  89.                         valcat$=compute$:(tform2$, valcat$)
  90.                         if valcat$ <> "" :v1g$=valcat$ :endif
  91.                     endif
  92.                 endif
  93.             endif
  94.             r%=cnvDlg%:
  95.             if r%=0 :break :endif
  96.             if r%>=4 :v1g$="0" :v2g$="0" :endif
  97.             if r%=6 :funtnr%=0 :tuntnr%=0 :endif
  98.             if r%=7 OR r%=8
  99.                 fnvalid%=0
  100.             endif
  101.         until 0
  102.     until 0
  103. ENDP
  104.  
  105. rem ********************************************************
  106. rem * Show disclaimer
  107. rem *
  108. PROC disclaim:
  109.     use B
  110.     dINIT findstr$:("Disclaimer")
  111.     first
  112.     findfield("help: disclaimer",1,1,$01)
  113.     if eof
  114.         showerr:("NoDisclaim")
  115.         stop
  116.     else
  117.         if B.msg$ <> "" :dText "", B.msg$ :endif
  118.         if B.l1$ <> ""  :dText "", B.l1$  :endif
  119.         if B.l2$ <> ""  :dText "", B.l2$  :endif
  120.         if B.l3$ <> ""  :dText "", B.l3$  :endif
  121.         if B.l4$ <> ""  :dText "", B.l4$  :endif
  122.         if B.l5$ <> ""  :dText "", B.l5$  :endif
  123.         if B.l6$ <> ""  :dText "", B.l6$  :endif
  124.         if B.l7$ <> ""  :dText "", B.l7$  :endif
  125.         dialog
  126.     endif
  127. ENDP
  128.  
  129. rem ********************************************************
  130. rem * Show opening window for convert
  131. rem * Also handle keypresses on it and
  132. rem * showing menu
  133. rem *
  134. PROC showopn%:
  135. local k%       rem keycode
  136. local h$(9)    rem list of valid keys
  137. local a$(5)    rem procedure name to call
  138.  
  139.     Font 10,2
  140.     At 4,3 :Print pname$+" "+version$
  141.     Style 0
  142.     findmsg:("panel: fatal", "Opening")
  143.     At 3,5 :Print " "+B.msg$
  144.     At 3,6 :Print " "+B.l1$
  145.     At 3,7 :Print " "+B.l2$
  146.     At 3,8 :Print " "+B.l3$
  147.     At 3,9 :Print " "+B.l4$
  148.     At 3,10 :Print " "+B.l5$
  149.     if fnvalid%
  150.         At 3,11 :Print " "+strsub$:(B.l6$, "%s1", cdatafn$)
  151.     else
  152.         At 3,11 :Print " "+B.l7$
  153.     endif
  154.     h$="ftmqsx"
  155.     while 1
  156.         k%=get
  157.         if k%=$123        rem Help key
  158.             dohelp:
  159.             continue
  160.         elseif k%=13      rem Enter key
  161.             break
  162.         elseif k%=$122    rem Menu key
  163.             mInit
  164.             findmnu$:("Memory")
  165.             mCard B.msg$,"M"+num$(memnr%,1)+B.l1$,%f,"M"+num$(memnr%,1)+B.l2$,%t,B.l3$,%m
  166.             findmnu$:("Special")
  167.             mCard B.msg$,B.l1$,%q,B.l2$,%s,B.l3$,%x
  168.             k%=Menu
  169.         elseif k% AND $200
  170.             k%=k%-$200
  171.         endif
  172.         if k% AND (loc(h$,chr$(k%))<>0)
  173.             a$="proc"+chr$(k%)
  174.             @(a$):
  175.         endif
  176.     endwh
  177.     return k%
  178. ENDP
  179.  
  180. rem ********************************************************
  181. rem * Show help information on screen.
  182. rem * Loads help from database.
  183. rem *
  184. PROC dohelp:
  185. local cnt%, r%
  186. local title$(20)
  187.  
  188.     use B
  189.     while 1
  190.         cnt%=0
  191.         title$=findstr$:("HelpTitle")
  192.         dINIT title$+": "+pname$+" "+version$
  193.         first
  194.         while findfield("help:*",1,1,$01) AND cnt% < 8
  195.             dText "", B.name$, $400
  196.             cnt%=cnt%+1
  197.             next
  198.         endwh
  199.         if cnt%=0 :break :endif     rem No help.
  200.         r%=dialog
  201.         if r%=0 :break :endif       rem Nothing selected
  202.         cnt%=2
  203.         first
  204.         while findfield("help:*",1,1,$01) AND cnt% < r%
  205.             cnt%=cnt%+1
  206.             next
  207.         endwh
  208.         dINIT title$+": "+B.name$
  209.         if B.msg$ <> "" :dText "", B.msg$ :endif
  210.         if B.l1$ <> ""  :dText "", B.l1$  :endif
  211.         if B.l2$ <> ""  :dText "", B.l2$  :endif
  212.         if B.l3$ <> ""  :dText "", B.l3$  :endif
  213.         if B.l4$ <> ""  :dText "", B.l4$  :endif
  214.         if B.l5$ <> ""  :dText "", B.l5$  :endif
  215.         if B.l6$ <> ""  :dText "", B.l6$  :endif
  216.         if B.l7$ <> ""  :dText "", B.l7$  :endif
  217.         dialog
  218.     endwh
  219. ENDP
  220.  
  221. rem ********************************************************
  222. rem * Procedure to stop program
  223. PROC procx:
  224.     stop
  225. ENDP
  226.  
  227. rem ********************************************************
  228. rem * Procedure to handle preferences
  229. rem *
  230. PROC procq:
  231.     findmsg:("panel: fatal", "Preferences")
  232.     dInit B.msg$
  233.     dChoice notat%,left$(B.l1$, loc(B.l1$,":")),right$(B.l1$,len(B.l1$)-loc(B.l1$,":"))
  234.     dLong vprecis&,B.l2$,0,100
  235.     dLong vwidth&,B.l3$,5,100
  236.     dialog
  237. ENDP
  238.  
  239. rem ********************************************************
  240. rem * Procedure to save preferences as defaults in the
  241. rem * database.
  242. rem *
  243. PROC procs:
  244.     if not fnvalid%
  245.         GIPrint findstr$:("DBNotOpen")
  246.     else
  247.         putdef:("Notation", num$(notat%,2))
  248.         putdef:("ValPrecision", num$(vprecis&,3))
  249.         putdef:("ValWidth", num$(vwidth&,3))
  250.         putdef:("MemoryNr", num$(memnr%,1))
  251.         GIPrint findstr$:("PrefSaved")
  252.     endif
  253. ENDP
  254.  
  255. rem ********************************************************
  256. rem * Procedure to store From value in current memory
  257. rem *
  258. PROC procf:
  259.     stomem:(v1g$)
  260. ENDP
  261.  
  262. rem ********************************************************
  263. rem * Procedure to store To value in current memory
  264. rem *
  265. PROC proct:
  266.     stomem:(v2g$)
  267. ENDP
  268.  
  269. rem ********************************************************
  270. rem * Procedure to store value in current memory
  271. rem *
  272. PROC stomem:(v$)
  273. local v
  274.     onerr errnoval
  275.     v=eval(v$)
  276.     if memnr%=0 :m0=v :endif
  277.     if memnr%=1 :m1=v :endif
  278.     if memnr%=2 :m2=v :endif
  279.     if memnr%=3 :m3=v :endif
  280.     if memnr%=4 :m4=v :endif
  281.     if memnr%=5 :m5=v :endif
  282.     if memnr%=6 :m6=v :endif
  283.     if memnr%=7 :m7=v :endif
  284.     if memnr%=8 :m8=v :endif
  285.     if memnr%=9 :m9=v :endif
  286.     GIPrint findstr$:("MemStored")
  287.     return
  288. errnoval::
  289.     onerr off
  290.     showerr:("IllFormula")
  291. ENDP
  292.  
  293. rem ********************************************************
  294. rem * Procedure to change Calc memory name
  295. rem *
  296. PROC procm:
  297.     findmsg:("panel: fatal", "Memory")
  298.     dInit B.msg$
  299.     memnr%=memnr%+1
  300.     dChoice memnr%,B.l1$, "M0,M1,M2,M3,M4,M5,M6,M7,M8,M9"
  301.     dialog
  302.     memnr%=memnr%-1
  303. ENDP
  304.  
  305. rem ********************************************************
  306. rem * Show main dialog window for convert
  307. rem * Returns exit code of dialog command.
  308. rem *
  309. PROC cnvDlg%:
  310. local r%
  311.  
  312.     findmsg:("panel: fatal", "Main")
  313.     dInit B.msg$
  314.     if funtnr% > 0 and tuntnr% > 0
  315.         if fform1$ <> "" AND fform2$ <> ""
  316.             dEdit v1g$, fdesc$
  317.         else
  318.             dText fdesc$, v1g$
  319.         endif
  320.         if tform1$ <> "" AND tform2$ <> ""
  321.             dEdit v2g$, tdesc$
  322.         else
  323.             dText tdesc$, v2g$
  324.         endif
  325.     else
  326.         dText B.l1$, "0"
  327.         dText B.l2$, "0"
  328.     endif
  329.     if catnr% > 0
  330.         dChoice funtnr%, B.l3$, funtlst$
  331.     else
  332.         dText B.l3$, " "
  333.     endif
  334.     if catnr% > 0
  335.         dChoice tuntnr%, B.l4$, tuntlst$
  336.     else
  337.         dText B.l4$, " "
  338.     endif
  339.     if fnvalid%
  340.         dChoice catnr%, B.l5$, catlist$
  341.     else
  342.         dText B.l5$, " "
  343.     endif
  344.     dFile cdatafn$, B.l6$, 0
  345.     r%=dialog
  346.     return r%
  347. ENDP
  348.  
  349. rem ********************************************************
  350. rem * Compute result of formula, after filling in v
  351. rem * as value in the formula where it contains 'xx'.
  352. PROC compute$:(f$, v$)
  353. local r, curdec$(1), formula$(255)
  354.  
  355.     formula$=f$
  356.     curdec$=finddec$:
  357.     if curdec$ <> decsign$
  358.         if curdec$ = ","
  359.             while loc(formula$, ",") > 0
  360.                 formula$=strsub$:(formula$, ",", ";")
  361.             endwh
  362.         endif
  363.         while loc(formula$, decsign$) > 0
  364.             formula$=strsub$:(formula$, decsign$, curdec$)
  365.         endwh
  366.         if curdec$ = "."
  367.             while loc(formula$, ";") > 0
  368.                 formula$=strsub$:(formula$, ";", ",")
  369.             endwh
  370.         endif
  371.     endif
  372.     onerr errIll
  373.     if loc(v$, "xx") :raise 1 :endif
  374.     while loc(formula$, "xx") > 0
  375.         formula$=strsub$:(formula$, "xx", v$)
  376.     endwh
  377.     r=eval(formula$)
  378.     if notat% = 1 :return sci$(r,vprecis&,vwidth&) :endif
  379.     if notat% = 2 :return fix$(r,vprecis&,vwidth&) :endif
  380.     return gen$(r,vwidth&)
  381. errIll::
  382.     onerr off
  383.     showerr:("IllFormula")
  384.     return ""
  385. ENDP
  386.  
  387. rem ********************************************************
  388. rem * Find out what the current decimal character is.
  389. rem * HACK: determines current sign by trying eval
  390. rem *       with ",". If error is generated, "." is assumed.
  391. rem *
  392. PROC finddec$:
  393.     onerr usedot
  394.     eval("1,2")
  395.     return ","
  396. usedot::
  397.     return "."
  398. ENDP
  399.     
  400. rem ********************************************************
  401. rem * Read categories from database
  402. rem * Return comma separated string of categories
  403. rem *
  404. PROC readCat:
  405.     use A
  406.     catlist$=""
  407.     first
  408.     while findfield("*category:*",1,1,$01)
  409.         if catlist$ <> ""
  410.             catlist$=catlist$+","
  411.         endif
  412.         catlist$=catlist$+A.fdesc$
  413.         next
  414.     endwh
  415.     if catlist$ = ""
  416.         fnvalid%=0
  417.         shower1:("DBNoCat", cdatafn$)
  418.     endif
  419. ENDP
  420.  
  421. rem ********************************************************
  422. rem * Read units for selected category from database.
  423. rem * Build 2 comma separated strings of units
  424. rem * (from and to list)
  425. rem *
  426. PROC readUnt:
  427. local cnt%
  428.  
  429.     use A
  430.     cnt%=1
  431.     first
  432.     while findfield("*category:*",1,1,$01)
  433.         if cnt% >= catnr% :break :endif
  434.         cnt%=cnt%+1
  435.         next
  436.     endwh
  437.     catunit$=A.tunit$
  438.     catdesc$=A.tdesc$
  439.     funtlst$=catunit$
  440.     tuntlst$=catunit$
  441.     first
  442.     while findfield(catunit$,1,2,$01)
  443.         if loc(A.funit$, "category") = 0
  444.             if A.funit$ <> catunit$
  445.                 if len(funtlst$)+len(A.funit$) > 254
  446.                     goto errlst
  447.                 endif
  448.                 funtlst$=funtlst$+","
  449.                 funtlst$=funtlst$+A.funit$
  450.                 if A.fact$ <> ""
  451.                     if len(tuntlst$)+len(A.funit$) > 254
  452.                         goto errlst
  453.                     endif
  454.                     tuntlst$=tuntlst$+","
  455.                     tuntlst$=tuntlst$+A.funit$
  456.                 endif
  457.             endif
  458.             if A.tunit$ <> catunit$
  459.                 if len(tuntlst$)+len(A.tunit$) > 254
  460.                     goto errlst
  461.                 endif
  462.                 tuntlst$=tuntlst$+","
  463.                 tuntlst$=tuntlst$+A.tunit$
  464.                 if A.fact$ <> ""
  465.                     if len(funtlst$)+len(A.tunit$) > 254
  466.                         goto errlst
  467.                     endif
  468.                     funtlst$=funtlst$+","
  469.                     funtlst$=funtlst$+A.tunit$
  470.                 endif
  471.             endif
  472.         endif
  473.         next
  474.     endwh
  475.     return
  476. errlst::
  477.     shower2:("ulistOverflow", A.funit$, A.tunit$)
  478.     return
  479. ENDP
  480.  
  481. rem ********************************************************
  482. rem * Read factor or formula from database
  483. rem * for selected units
  484. rem * Builds 2 formula strings (from to to
  485. rem * and to to from). Also sets descriptions
  486. rem *
  487. PROC readFrm:
  488. global fformX$(255), tformX$(255)
  489. local sel$(100)
  490.  
  491.     sel$=listent$:(funtlst$, funtnr%)
  492.     if sel$ = ""
  493.         funtnr%=0
  494.     else
  495.         fdesc$=findunt$:(sel$)
  496.         fform1$=fformX$
  497.         tform2$=tformX$
  498.     endif
  499.     sel$=listent$:(tuntlst$, tuntnr%)
  500.     if sel$ = ""
  501.         tuntnr%=0
  502.     else
  503.         tdesc$=findunt$:(sel$)
  504.         fform2$=tformX$
  505.         tform1$=fformX$
  506.     endif
  507. ENDP
  508.  
  509. rem ********************************************************
  510. rem * Get the entnr%-th entry from the
  511. rem * comma separated list$
  512. rem * Returns empty string if not existing
  513. rem *
  514. PROC listent$:(list$, entnr%)
  515. local t$(255), sel$(100), cnt%
  516.  
  517.     cnt%=1
  518.     t$=list$
  519.     while cnt% < entnr% and loc(t$,",") > 0
  520.         t$=right$(t$,len(t$)-loc(t$,","))
  521.         cnt%=cnt%+1
  522.     endwh
  523.     if cnt% < entnr%
  524.         sel$=""
  525.     elseif loc(t$,",") = 0
  526.         sel$=t$
  527.     else
  528.         sel$=left$(t$,loc(t$,",")-1)
  529.     endif
  530.     return sel$
  531. ENDP
  532.  
  533. rem ********************************************************
  534. rem * Look in database for conversion from
  535. rem * unit$ to catunit$ or vice versa.
  536. rem * Return description of unit$
  537. rem * Sets global variables fformX$ and
  538. rem * tformX with formulas to go from
  539. rem * unit$ to catunit$ and vice versa.
  540. PROC findunt$:(unit$)
  541. local desc$(100)
  542.  
  543.     use A
  544.     if unit$ = catunit$
  545.         desc$=catdesc$
  546.         fformX$="xx"
  547.         tformX$="xx"
  548.     else
  549.         fformX$ = ""
  550.         tformX$ = ""
  551.         first
  552.         while findfield(unit$,1,2,$01)
  553.             rem Search all occurrences.
  554.             rem with formulas more than one
  555.             rem is possible.
  556.             if A.funit$ = catunit$
  557.                 desc$ = A.tdesc$
  558.                 if A.fact$ = ""
  559.                     tformX$ = A.form$
  560.                 else
  561.                     fformX$ = "(xx/"+A.fact$+")"
  562.                     tformX$ = "(xx*"+A.fact$+")"
  563.                 endif
  564.             elseif A.tunit$ = catunit$
  565.                 desc$ = A.fdesc$
  566.                 if A.fact$ = ""
  567.                     fformX$ = A.form$
  568.                 else
  569.                     fformX$ = "(xx*"+A.fact$+")"
  570.                     tformX$ = "(xx/"+A.fact$+")"
  571.                 endif
  572.             endif
  573.             next
  574.         endwh
  575.     endif
  576.     return desc$
  577. ENDP
  578.  
  579. rem ********************************************************
  580. rem * Set default values. Tries to read them from database.
  581. rem *
  582.  
  583. PROC setdef:
  584.     chelpfn$=getdef$:("HelpFile", "\dat\jaicnven.hlp")
  585.     notat%=val(getdef$:("Notation", "3"))
  586.     vprecis&=val(getdef$:("ValPrecision", "5"))
  587.     vwidth&=val(getdef$:("ValWidth", "20"))
  588.     decsign$=left$(getdef$:("DecimalSign", "."), 1)
  589.     memnr%=val(getdef$:("MemoryNr", "0"))
  590. ENDP
  591.  
  592. rem ********************************************************
  593. rem * Open Data file
  594. rem * Also read defaults,opens help fife,
  595. rem * initializes global variables that
  596. rem * indicate a selected item, and reads
  597. rem * the categories.
  598. rem *
  599. PROC opendat%:
  600.     if not exist(cdatafn$)
  601.         shower1:("FileNotFound",cdatafn$)
  602.         fnvalid%=0
  603.     else
  604.         trap use B
  605.         trap close
  606.         trap use A
  607.         trap close
  608.         open cdatafn$,A,funit$,tunit$,fact$,form$,fdesc$,tdesc$
  609.         fnvalid%=-1
  610.         setdef:
  611.         openhlp:
  612.         if fnvalid%
  613.             catnr%=0  :prevcnr%=0
  614.             funtnr%=0 :prevfnr%=0
  615.             tuntnr%=0 :prevtnr%=0
  616.             readCat:
  617.         endif
  618.     endif
  619.     return fnvalid%
  620. ENDP
  621.  
  622. rem ********************************************************
  623. rem * Open help and error message file
  624. rem *
  625. PROC openhlp:
  626.     if not exist(chelpfn$)
  627.         alert("Internal error: helpfile not found", chelpfn$)
  628.         stop
  629.     else
  630.         open chelpfn$,B,type$,name$,msg$,l1$,l2$,l3$,l4$,l5$,l6$,l7$,l8$
  631.     endif
  632. ENDP
  633.  
  634. rem ********************************************************
  635. rem * Show error message named errname$.
  636. rem * The message string is retrieved from a
  637. rem * database using errname$ as index.
  638. rem * Expect to replace at most two arguments in
  639. rem * message string with arg1$ and arg2$
  640. rem * args in string look like "%s1" and "%s2"
  641. rem *
  642. PROC shower2:(errname$, arg1$, arg2$)
  643. local str1$(100), str2$(100)
  644.     findmsg:("error:", errname$)
  645.     str1$=strsub$:(B.msg$, "%s1", arg1$)
  646.     str1$=strsub$:(str1$, "%s2", arg2$)
  647.     str2$=strsub$:(B.l1$, "%s1", arg1$)
  648.     str2$=strsub$:(str2$, "%s2", arg2$)
  649.     alert(str1$, str2$)
  650.     if loc(B.type$, "fatal") <> 0
  651.         stop
  652.     endif
  653. ENDP
  654.  
  655. rem ********************************************************
  656. rem * Wrapper functions for errors with 0 and 1 arg.
  657. rem *
  658. PROC showerr:(errname$)
  659.     shower2:(errname$, "%s1", "%s2")
  660. ENDP
  661.  
  662. PROC shower1:(errname$, arg$)
  663.     shower2:(errname$, arg$, "%s2")
  664. ENDP
  665.  
  666. rem ********************************************************
  667. rem * Find string in database
  668. rem *
  669. PROC findstr$:(name$)
  670.     findmsg:("string:", name$)
  671.     if eof
  672.         alert("Internal error, string "+name$+" not found", "database incomplete")
  673.         stop
  674.     endif
  675.     return B.msg$
  676. ENDP
  677.  
  678. rem ********************************************************
  679. rem * Find menu in database
  680. rem *
  681. PROC findmnu$:(name$)
  682.     findmsg:("menu:", name$)
  683.     if eof
  684.         alert("Internal error, menu "+name$+" not found", "database incomplete")
  685.         stop
  686.     endif
  687.     return B.msg$
  688. ENDP
  689.  
  690. rem ********************************************************
  691. rem * Gets default value from database.
  692. rem * If database not open or name$ not found, return def$
  693. rem * else return value from database field fdesc$
  694. rem *
  695. PROC getdef$:(name$, def$)
  696.     if not fnvalid%
  697.         return def$
  698.     else
  699.         use A
  700.         first
  701.         while findfield(name$,2,1,$01)
  702.             if loc(A.funit$, "default:") <> 0
  703.                 break
  704.             endif
  705.             next
  706.         endwh
  707.     endif
  708.     if eof
  709.         return def$
  710.     else
  711.         return A.fdesc$
  712.     endif
  713. ENDP
  714.  
  715. rem ********************************************************
  716. rem * Puts default value in database.
  717. rem * If database not open, nothing happens.
  718. rem * If name$ not found, a new record is created for it.
  719. rem *
  720. PROC putdef:(name$, val$)
  721.     if fnvalid%
  722.         use A
  723.         first
  724.         while findfield(name$,2,1,$01)
  725.             if loc(A.funit$, "default:") <> 0
  726.                 break
  727.             endif
  728.             next
  729.         endwh
  730.         if eof
  731.             A.funit$="default:"
  732.             A.tunit$=name$
  733.             A.fdesc$=val$
  734.             Append
  735.         else
  736.             A.fdesc$=val$
  737.             Update
  738.         endif
  739.     endif
  740. ENDP
  741.  
  742. rem ********************************************************
  743. rem * Find a record for a message in help file
  744. rem * Sets current record.
  745. rem * Stops program if not found
  746. rem *
  747. PROC findmsg:(type$, name$)
  748.     use B
  749.     first
  750.     while findfield(name$,2,1,$01)
  751.         if loc(B.type$, type$) <> 0
  752.             break
  753.         endif
  754.         next
  755.     endwh
  756.     if eof AND loc(type$, "fatal") <> 0
  757.         alert("Internal error, "+type$+" msg not found:", name$)
  758.         stop
  759.     endif
  760. ENDP
  761.  
  762. rem ********************************************************
  763. rem * Substitute string org$ by repl$ in str$.
  764. rem * Return resulting string.
  765. rem * If org$ does not exist in str$, str$ is returned.
  766. rem *
  767. PROC strsub$:(str$, org$, repl$)
  768. local l%, f$(255)
  769.     l%=loc(str$, org$)
  770.     if l%>0
  771.         f$=left$(str$,l%-1)
  772.         f$=f$+repl$
  773.         l%=l%+len(org$)-1
  774.     endif
  775.     if l%<len(str$)
  776.         f$=f$+right$(str$,len(str$)-l%)
  777.     endif
  778.     return f$
  779. ENDP
  780.  
  781.