home *** CD-ROM | disk | FTP | other *** search
/ DTP Toolbox / DTPToolbox.iso / propage4.0 / arexx / barcodesean.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1995-03-26  |  22.9 KB  |  755 lines
  1. /* This program covers the related formats UPC, EAN and ISBN and forms part of the ProDraw barcoding program. It is called by BarCodes.pdrx.
  2. Written by Don Cox. Copyright. Not Public Domain. */
  3.  
  4. /* $VER: BarCodesEAN.rexx Jan 95 */
  5. /*call open("STDERR","ram:traceEAN","W")
  6. trace r*/
  7.  
  8. parse arg chosen, box, colour1, colour2, numberprompt, oldunits
  9. cr = "0a"x
  10.  
  11. EANtype = 13
  12. if pos("ISBN",chosen)~=0 then EANtype = 10
  13. if pos("8",chosen)~=0 then EANtype = 8
  14. if pos("UPC-A",chosen)~=0 then EANtype = 12
  15. if pos("UPC-E",chosen)~=0 then EANtype = 7
  16.  
  17. identity = 1 /* count objects */
  18. curves. = ""
  19. parse var box cornerX cornerY cornerX2 cornerY2
  20.  
  21.  
  22. call numberdata.rexx() /* External program sets up data for numbers */
  23.  
  24. /* get values from last run from clips or supply defaults */
  25.  
  26. suppprompt = getclip(pdussupp)
  27. magfactor = getclip(pdusmagfactor)
  28. if magfactor = "" then magfactor = 1
  29. artscale = getclip(pdusartscale)
  30. if artscale = "" then artscale = 1
  31. cornermarks = getclip(pduscornermarks)
  32. if cornermarks = "" then cornermarks = "Y"
  33. trunc = getclip(pdustrunc)
  34. if trunc = "" then trunc = 0
  35. bookcode = getclip(pdusbookcode)
  36. if bookcode = "" then bookcode = 978
  37.  
  38. numbertext = "Code Numbers:"
  39. if pos("ISBN",chosen)~=0 then numbertext = "ISBN number:"
  40.  
  41. prompt = numbertext||numberprompt ||cr|| "Ink Spread(mm):0.000" ||cr|| "Mag. factor:"magfactor ||cr|| "Artwork scale:"artscale ||cr|| "Select colours?(Y/N):N" ||cr|| "Corner Marks?(Y/N):"cornermarks ||cr|| "Truncation (mm):"trunc 
  42.  
  43. if pos("plus",chosen)~=0 then prompt = prompt||cr|| "Supplement Code:"suppprompt 
  44. if pos("ISBN",chosen)~=0 then prompt = prompt||cr|| "Book code (977-9):"bookcode
  45.  
  46. form = pdm_GetForm("Enter numbers",17,prompt)
  47. parse var form numbers "0a"x inkspread "0a"x magfactor "0a"x artscale "0a"x colorset "0a"x cornermarks "0a"x trunc "0a"x options
  48.  
  49. if pos("plus",chosen)=0 then bookcode = options
  50. if pos("ISBN",chosen)=0 then supplement = options
  51. else if pos("ISBNplus",chosen)~=0 then parse var options supplement "0a"x bookcode
  52.  
  53. if supplement = "" then chosen = compress(chosen,"plus25")
  54. inkspread = inkspread/10   /* convert to cm */
  55.  
  56. if numbers = "" then exit_msg("User aborted genie")
  57. numbers = space(numbers,0)  /* strip out all spaces */
  58. numlength = length(numbers)
  59. call setclip(pdusnumbers, numbers)
  60.  
  61. oklength = EANtype-1
  62.  
  63. if numlength<oklength then exit_msg("Should be "oklength" digits")
  64. numbers = left(numbers,oklength)
  65. numlength = oklength
  66.  
  67. numbers = clearos(numbers)  /* replace any letter Os with zeros */
  68. call setclip(pdusnumbers, numbers)
  69. ver = verify(numbers,"0123456789")
  70. if ver~= 0 then exit_msg("Letter "substr(numbers,ver,1)" among numbers")
  71. numbers = checksum(numbers) /* calculate checksum */
  72.  
  73. if upper(numberfont)~="N" then numberfont = pdm_GetFontList
  74.  
  75. if upper(colorset)~="N" then do
  76.     colourpair = setcolors()
  77.     parse var colourpair colour1 "0a"x colour2
  78.     end
  79.  
  80. if EANtype = 10 then do /* ISBN codes */
  81.     bookcode = space(bookcode,0)  /* strip out all spaces */
  82.     bookcode = clearos(bookcode)
  83.     if length(bookcode)<3 then exit_msg("Book code needs 3 figures")
  84.     bookcode = left(bookcode,3)
  85.     call setclip(pdusbookcode,bookcode)
  86.     ver =verify(bookcode,"0123456789")
  87.     if ver~=0 then exit_msg("Letter "substr(bookcode,ver,1)" in bookcode")
  88.  
  89.     num1 = substr(numbers,1,1)
  90.     num2 = substr(numbers,2,4)
  91.     num3 = substr(numbers,6,4)
  92.     num4 = substr(numbers,10,1)
  93.     ISBNstring = "ISBN "num1"-"num2"-"num3"-"num4
  94.     if bookcode = 977 then ISBNstring = "ISSN "num1"-"num2"-"num3"-"num4
  95.     numbers = bookcode||num1||num2||num3
  96.     numbers = checksum(numbers)
  97.     end
  98.  
  99. numbers2 = numbers /* string for drawing numerals */
  100. numlength = length(numbers)
  101.  
  102. if ~datatype(magfactor,n) then magfactor = 1
  103. if magfactor<0.82 then magfactor = 0.82
  104. if magfactor>2 then magfactor = 2
  105.  
  106. if ~datatype(artscale,n) then artscale = 1
  107. if upper(cornermarks)~="Y" then cornermarks = "N"
  108.  
  109. if ~datatype(trunc,n) then trunc = 0
  110. if magfactor<1 then trunc = 0
  111. maxtrunc = ((8*(magfactor-1))+3.8)*artscale
  112. if trunc> maxtrunc then trunc = maxtrunc
  113.  
  114. call setclip(pdusmagfactor, magfactor)
  115. call setclip(pdusartscale, artscale)
  116. call setclip(pduscornermarks, cornermarks)
  117. call setclip(pdustrunc, trunc)
  118.  
  119. if pos("plus",chosen)~=0 then do
  120.     supplement = space(supplement,0)  /* strip out all spaces */
  121.     supplement = clearos(supplement)
  122.     suppoklength = right(chosen,1)
  123.     supplement = left(supplement,suppoklength)
  124.     call setclip(pdussupp,supplement)
  125.     supplength = length(supplement)
  126.     if supplength~=suppoklength then exit_msg("Wrong supplement: "supplement)
  127.     ver =verify(supplement,"0123456789")
  128.     if ver~=0 then exit_msg("Letter "substr(supplement,ver,1)" in supplement")
  129.     end
  130.  
  131. scaler = magfactor*artscale*0.1 /* 0.1 to convert mm to cm */
  132. unitwidth = 0.330*scaler
  133.  
  134.  
  135. /* Set up dimensions for various formats. If truncated, top positions are left unchanged and bottoms brought up. */
  136. select
  137.     when EANtype = 8 then do /* EAN 8 code */
  138.         guardbottom = cornerY+((0.33+19.8-trunc)*scaler)
  139.         codebottom = cornerY+ ((0.33+18.23-trunc)*scaler)
  140.         bartop = cornerY+(0.33*scaler)
  141.         supptop = cornerY+(5*scaler)
  142.         barleft = cornerX + (2.31*scaler)
  143.         numberleft = barleft+(5*unitwidth)
  144.         numbertop = cornerY+ ((0.33+18.56-trunc)*scaler)
  145.         boxwidth = 26.73*scaler
  146.         boxheight = (21.64-trunc)*scaler
  147.         end
  148.  
  149.     when EANtype = 7 then do  /* UPC E code */
  150.         guardbottom = cornerY+((1.59+24.37)*scaler) /* 1.59 top margin */
  151.         codebottom = cornerY+ ((1.59+22.05)*scaler)
  152.         bartop = cornerY+(1.59*scaler)
  153.         supptop = cornerY+(5*scaler)
  154.         barleft = cornerX + (2.97*scaler)
  155.         numberleft = barleft+(5*unitwidth)
  156.         numbertop = cornerY+ ((1.59+22.34)*scaler)
  157.         boxwidth = 22.11*scaler
  158.         boxheight = (1.59+24.99)*scaler
  159.         end
  160.  
  161.     when EANtype = 10 then do  /* ISBN code */
  162.         cornerY2 = cornerY+(4*scaler) /* top strip for ISBN number */
  163.         ISBNtop = cornerY+(0.8*scaler)
  164.         guardbottom = cornerY2+((0.33+24.5-trunc)*scaler)
  165.         codebottom = cornerY2+ ((0.33+22.85-trunc)*scaler)
  166.         bartop = cornerY2+(0.33*scaler)
  167.         supptop = cornerY2+(5*scaler)
  168.         barleft = cornerX + (3.63*scaler)
  169.         ISBNleft = barleft
  170.         numberleft = cornerX + (0.33*scaler)
  171.         numbertop = cornerY2+ ((0.33+23.18-trunc)*scaler)
  172.         boxwidth = 37.29*scaler
  173.         boxheight = (30.26-trunc)*scaler
  174.         end
  175.  
  176.     when EANtype = 13 then do  /* EAN 13 code */
  177.         ISBNtop = cornerY+(0.5*scaler)
  178.         guardbottom = cornerY+((0.33+24.5-trunc)*scaler)
  179.         codebottom = cornerY+ ((0.33+22.85-trunc)*scaler)
  180.         bartop = cornerY+(0.33*scaler)
  181.         supptop = cornerY+(5*scaler)
  182.         barleft = cornerX + (3.63*scaler)
  183.         numberleft = cornerX + (0.33*scaler)
  184.         numbertop = cornerY + ((0.33+23.18-trunc)*scaler)
  185.         boxwidth = 37.29*scaler
  186.         boxheight = (26.26-trunc)*scaler
  187.         end
  188.  
  189.     when EANtype = 12 then do  /* UPC A code */
  190.         guardbottom = cornerY+((1.59+24.37)*scaler) /* 1.59 top margin */
  191.         codebottom = cornerY+ ((1.59+22.05)*scaler)
  192.         bartop = cornerY+(1.59*scaler)
  193.         supptop = cornerY+(5*scaler)
  194.         barleft = cornerX + (2.97*scaler)
  195.         numberleft = cornerX - (0.1*scaler)
  196.         numbertop = cornerY+ ((1.59+22.34)*scaler)
  197.         smalltop = cornerY+ ((1.59+23.3)*scaler) /* top of small numerals */
  198.         boxwidth = 37.29*scaler
  199.         boxheight = (1.59+24.99)*scaler
  200.         end
  201.  
  202.     otherwise NOP
  203.     end
  204.  
  205. if pos("plus2",chosen)~=0 then boxwidth = boxwidth+(unitwidth*30)
  206. if pos("plus5",chosen)~=0 then boxwidth = boxwidth+(unitwidth*60)
  207.  
  208.  
  209. charwidth = unitwidth*7 /* size of numerals */
  210.  
  211. call drawrectangle
  212.  
  213. /* draw corner marks */
  214. if cornermarks = "Y" then do
  215.     cornerstring = "0 1 0 0 0 0, 1 1 0 0 0 0, 1 0 0 0 0 0"
  216.     marksize = 4 * unitwidth  /* arbitrary */
  217.     markleft = cornerX-marksize
  218.     marktop = cornerY-marksize
  219.     call pdm_InitPlot(markleft, marktop, marksize, marksize, 0)
  220.     call pdm_PlotBezier(cornerstring)
  221.     obj = pdm_EndPlot()
  222.     curves.identity = obj
  223.     call pdm_SetLineJoin(obj,0)
  224.     if pos("UPC",chosen)=0 then call pdm_SetLineWeight(obj, 1.00)
  225.     call pdm_SetFillPattern(obj,0, colour2)
  226.     if pos("UPC",chosen)~=0 then call pdm_SetFillPattern(obj,1, colour2)
  227.     identity = identity+1
  228.  
  229.     markleft = boxright+marksize
  230.     marktop = cornerY-marksize
  231.     call pdm_InitPlot(markleft, marktop, marksize, marksize, 270)
  232.     call pdm_PlotBezier(cornerstring)
  233.     curves.identity = pdm_EndPlot()
  234.     identity = identity+1
  235.  
  236.     markleft = boxright+marksize
  237.     marktop = boxbottom+marksize
  238.     call pdm_InitPlot(markleft, marktop, marksize, marksize, 180)
  239.     call pdm_PlotBezier(cornerstring)
  240.     curves.identity = pdm_EndPlot()
  241.     identity = identity+1
  242.  
  243.     markleft = cornerX-marksize
  244.     marktop = boxbottom+marksize
  245.     call pdm_InitPlot(markleft, marktop, marksize, marksize, 90)
  246.     call pdm_PlotBezier(cornerstring)
  247.     curves.identity = pdm_EndPlot()
  248. /*    if pos("UPC",chosen)=0 then call pdm_SetLineWeight(obj, 1.00)
  249.     if pos("UPC",chosen)~=0 then call pdm_SetFillPattern(obj,1, colour2)*/
  250.     identity = identity+1
  251.     end
  252.  
  253.  
  254. /* The numbers here represent the widths of the bars in the character patterns. The printed width of a unit-width bar should be 0.013 inch. */
  255. LAstring = "3211 2221 2122 1411 1132 1231 1114 1312 1213 3112"
  256. LBstring = "1123 1222 2212 1141 2311 1321 4111 2131 3121 2113"
  257. Rstring  = "3211 2221 2122 1411 1132 1231 1114 1312 1213 3112"
  258. thstring = "AAAAAA AABABB AABBAB AABBBA ABAABB ABBAAB ABBBAA ABABAB ABABBA ABBABA"
  259.  
  260. /* The left & right blocks of numbers */
  261. EANtype2 = EANtype
  262. if EANtype2 = 10 then EANtype2 = 13 /* ISBN same as EAN 13 */
  263. leftstart = 1
  264. leftend = EANtype2 %2 /* half the number of digits, ignoring remainder */
  265. rightstart = leftend+1
  266. rightend = EANtype2-(EANtype2 //2)
  267.  
  268. ABpattern="AAAAAA" /* for EAN8 and UPC-A */
  269. if EANtype2 = 7 then ABpattern = "BBBBBBB"
  270.  
  271. if EANtype2 = 13  then do  /* for EAN13 & ISBN */
  272.     firstnumber = left(numbers,1)
  273.     ABpattern = word(thstring,firstnumber+1)
  274.     numbers = substr(numbers,2)
  275.     end
  276.  
  277. call pdm_ShowStatus("  Drawing Bars..")
  278.  
  279. currentfill = colour1
  280.  
  281. /* Guard bars */
  282. barbottom = guardbottom
  283. do j = 1 to 3
  284.     barwidth = 1
  285.     barright = barleft + unitwidth
  286.     if currentfill = colour1 then call drawbar
  287.     else currentfill = colour1
  288.     barleft = barright
  289.     end
  290.  
  291. /* First block of number bars */
  292.  
  293. do i= leftstart to leftend
  294.     barbottom = codebottom
  295.     if EANtype2 = 12 then if i=leftstart then barbottom = guardbottom
  296.     thisnumber = substr(numbers, i,1)
  297.     if thisnumber = "" then break
  298.     AorB = substr(ABpattern,i,1)
  299.     call doleftpattern
  300.     end
  301.  
  302. /* Centre guard bars */
  303. if EANtype2~=7 then do
  304.     barbottom = guardbottom
  305.     do j = 1 to 5
  306.         barwidth = 1
  307.         barright = barleft + unitwidth
  308.         if currentfill = colour1 then call drawbar
  309.         else currentfill = colour1
  310.         barleft = barright
  311.         end
  312.     end
  313.  
  314. /* second block of number bars */
  315. barbottom = codebottom
  316. do i=rightstart to rightend
  317.     if EANtype2 = 12 then if i=rightend then barbottom = guardbottom
  318.     thisnumber = substr(numbers, i,1)
  319.     if thisnumber = "" then break
  320.     barpattern = word(Rstring, thisnumber+1)
  321.     do j = 1 to 4
  322.         barwidth = substr(barpattern,j,1)
  323.         barright = barleft + (barwidth * unitwidth)
  324.         if currentfill = colour1 then call drawbar
  325.         else currentfill = colour1
  326.         barleft = barright
  327.         end
  328.     end
  329.  
  330. /* Guard bars */
  331. barbottom = guardbottom
  332. n = 3
  333. if EANtype2 = 7 then n=6
  334. do j = 1 to n
  335.     barwidth = 1
  336.     barright = barleft + unitwidth
  337.     if currentfill = colour1 then call drawbar
  338.     else currentfill = colour1
  339.     barleft = barright
  340.     end
  341.  
  342.  
  343. /* Do supplementary bars */
  344. if pos("plus",chosen) ~=0 then do
  345.     barbottom = guardbottom
  346.     mainbartop = bartop
  347.     bartop = supptop
  348.     barleft = barleft+(10*unitwidth)  /* Guard bars */
  349.     suppleft = barleft+(unitwidth*4) /* left position for supplement numerals */
  350.     barwidth = 1
  351.     barright = barleft + unitwidth
  352.     call drawbar
  353.     barleft = barright+unitwidth
  354.  
  355.     barright = barleft + (2*unitwidth)
  356.     call drawbar
  357.     barleft = barright
  358.  
  359.     end
  360.  
  361.  
  362. /* Two digit supplement */
  363. if pos("2",chosen)~=0 then do
  364.     supplement = left(supplement,2)
  365.     if ~datatype(supplement,"N") then exit_msg(supplement||" not a number")
  366.     thisnumber = left(supplement,1)
  367.     digpar = supplement//4  /* parity code */
  368.     AorB = "B"
  369.     if digpar = 0 | digpar = 1 then AorB = "A"
  370.     call doleftpattern
  371.  
  372.     /* delineator is 01 */
  373.     barleft = barright+unitwidth
  374.     barright = barleft + unitwidth
  375.     call drawbar
  376.     barleft = barright
  377.  
  378.     thisnumber = right(supplement,1)
  379.     AorB = "B"
  380.     if digpar = 0 | digpar = 2 then AorB = "A"
  381.     call doleftpattern
  382.     end
  383.  
  384.  
  385. /* Five digit supplement */
  386. if pos("5",chosen)~=0 then do
  387.     supplement = left(supplement,5)
  388.     if ~datatype(supplement,"N") then exit_msg(supplement||" not a number")
  389.     ch=checksum5(supplement)
  390.     ch = ch+1
  391.     fivestring = "BBAAA BABAA BAABA BAAAB ABBAA AABBA AAABB ABABA ABAAB AABAB"
  392.     ABpattern = word(fivestring,ch)
  393.  
  394.     thisnumber = substr(supplement,1,1)
  395.     if thisnumber = "" then break
  396.     if thisnumber = "O"| thisnumber = "o" then thisnumber = 0
  397.     AorB = substr(ABpattern,1,1)
  398.     call doleftpattern
  399.  
  400.     /* delineator is 1 */
  401.     barleft = barright+unitwidth
  402.     barright = barleft + unitwidth
  403.     call drawbar
  404.     barleft = barright
  405.  
  406.     thisnumber = substr(supplement,2,1)
  407.     if thisnumber = "" then break
  408.     if thisnumber = "O"| thisnumber = "o" then thisnumber = 0
  409.     AorB = substr(ABpattern,2,1)
  410.     call doleftpattern
  411.  
  412.     /* delineator is 01 */
  413.     barleft = barright+unitwidth
  414.     barright = barleft + unitwidth
  415.     currentfill = colour2
  416.     obj = pdm_DrawRectangle(barleft, supptop, barright, guardbottom)
  417.     call pdm_SetLineWeight(obj, 0.00)
  418.     call pdm_SetFillPattern(obj,1, currentfill)
  419.     curves.identity = obj
  420.     identity = identity+1
  421.     barleft = barright
  422.  
  423.     thisnumber = substr(supplement,3,1)
  424.     if thisnumber = "" then break
  425.     if thisnumber = "O"| thisnumber = "o" then thisnumber = 0
  426.     AorB = substr(ABpattern,3,1)
  427.     call doleftpattern
  428.  
  429.     /* delineator is 1 */
  430.     barleft = barright+unitwidth
  431.     barright = barleft + unitwidth
  432.     call drawbar
  433.     barleft = barright
  434.  
  435.     thisnumber = substr(supplement,4,1)
  436.     if thisnumber = "" then break
  437.     if thisnumber = "O"| thisnumber = "o" then thisnumber = 0
  438.     AorB = substr(ABpattern,4,1)
  439.     call doleftpattern
  440.  
  441.     /* delineator is 01 */
  442.     barleft = barright+unitwidth
  443.     barright = barleft + unitwidth
  444.     call drawbar
  445.     barleft = barright
  446.  
  447.     thisnumber = substr(supplement,5,1)
  448.     if thisnumber = "" then break
  449.     if thisnumber = "O"| thisnumber = "o" then thisnumber = 0
  450.     AorB = substr(ABpattern,5,1)
  451.     call doleftpattern
  452.  
  453.     end
  454.  
  455.  
  456.  
  457. call pdm_ShowStatus("  Drawing Numerals..")
  458.  
  459. scaleX = charwidth/4.5 /* this arbitrary number depends on the size of characters in the data strings */
  460. scaleY = scaleX   /* keep proportions - ignore box height */
  461.  
  462. do i = 1 to numlength
  463.     thisnumber = substr(numbers2, i,1)
  464.  
  465.     if EANtype = 12 then do
  466.         if i=1 then do
  467.             scaleX = scaleX*0.6 /* small first character for UPC-A */
  468.             scaleY=scaleX
  469.             normaltop = numbertop
  470.             numbertop=smalltop
  471.             end
  472.         if i=12 then do
  473.             scaleX = scaleX*0.6
  474.             scaleY=scaleX
  475.             numbertop = smalltop
  476.             end
  477.         end
  478.  
  479.     call drawnumber
  480.  
  481.     numberleft = numberleft + charwidth /* move to next position*/
  482.     if EANtype = 12 then do
  483.         if i=1 then do
  484.             numberleft = numberleft + (charwidth*2) /* extra for first */
  485.             scaleX = charwidth/4.5 /* back to standard size */
  486.             scaleY = scaleX
  487.             numbertop=normaltop
  488.             end
  489.         if i=11 then numberleft = numberleft + (charwidth*2) /* extra for last */
  490.         if i= 6 then numberleft = numberleft +(4*unitwidth) /* extra to skip centre guard bars */
  491.         end
  492.  
  493.     if (EANtype = 13 | EANtype = 10) then do
  494.         if i=1 then numberleft = numberleft + charwidth /* extra for first */
  495.         if i= rightstart then numberleft = numberleft +(4*unitwidth) /* extra to skip centre guard bars */
  496.         end
  497.  
  498.     if EANtype = 8 then if i = leftend then numberleft = numberleft+(4*unitwidth)
  499.  
  500.     if EANtype = 7 then if i = rightend then numberleft = numberleft + (6*unitwidth)
  501.     end
  502.  
  503. if pos("plus",chosen)=0 then do
  504.     numberleft = numberleft+ (4*unitwidth)
  505.     thisnumber = ">"
  506.     call drawnumber
  507.     end
  508.  
  509. if EANtype = 8 then do
  510.     numberleft = cornerX
  511.     thisnumber = "<"
  512.     call drawnumber
  513.     end
  514.  
  515.  
  516. if pos("plus",chosen)~=0 then do /* numerals for supplement */
  517.     scaleX = charwidth/4.5 /* this arbitrary number depends on the size of characters in the data strings */
  518.     scaleY = scaleX   /* keep proportions - ignore box height */
  519.     numberleft = suppleft
  520.     numbertop = mainbartop
  521.     numlength = right(chosen,1) /* 2 or 5 */
  522.     if numlength = 2 then do
  523.         numlength = 3
  524.         supplement = supplement||">"
  525.         end
  526.     do i = 1 to numlength
  527.         thisnumber = substr(supplement, i,1)
  528.         call drawnumber
  529.         numberleft = numberleft + charwidth +(unitwidth*2)/* move to next position*/
  530.         end
  531.     end
  532.  
  533.  
  534. if pos("ISBN",chosen)~=0 then do /* ISBN code at top */
  535.     scaleX = scaleX*0.8
  536.     scaleY = scaleX
  537.     numberleft = ISBNleft
  538.     numbertop = ISBNtop
  539.     numlength = 18
  540.     do i = 1 to numlength
  541.         thisnumber = substr(ISBNstring, i,1)
  542.         if thisnumber~=" " then call drawnumber
  543.         numberleft = numberleft + (charwidth*0.75)  /* move to next position*/
  544.         end
  545.     end
  546.  
  547. identity = identity-1
  548. call pdm_SelectObj(curves.1,curves.identity)
  549. call pdm_GroupObj()
  550.  
  551.  
  552. return 1 /* end of EAN section */
  553.  
  554. /* +++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++++ */
  555.  
  556. doleftpattern:
  557.     if AorB = "A" then barpattern = word(LAstring, thisnumber+1)
  558.     else barpattern = word(LBstring, thisnumber+1)
  559.     do j = 1 to 4
  560.         barwidth = substr(barpattern,j,1)
  561.         barright = barleft + (barwidth * unitwidth)
  562.         if currentfill = colour1 then call drawbar
  563.         else currentfill = colour1
  564.         barleft = barright
  565.         end
  566. return
  567.  
  568. /* ++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++++ */
  569.  
  570. drawbar:
  571.  
  572. currentfill = colour2
  573. barleft2 = barleft+inkspread
  574. barright2 = barright-inkspread
  575. obj = pdm_DrawRectangle(barleft2, bartop, barright2, barbottom)
  576. call pdm_SetLineWeight(obj, 0.00)
  577. call pdm_SetFillPattern(obj,1, currentfill)
  578. curves.identity = obj
  579. identity = identity+1
  580.  
  581. return
  582.  
  583. /* ++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++ */
  584.  
  585. drawnumber:
  586.  
  587. thisclip = "pdusnumdata"||thisnumber
  588. thisdata = getclip(thisclip) 
  589. parse var thisdata boxsizeX "0a"x boxsizeY "0a"x numstring1 "0a"x numstring2 "0a"x numstring3
  590.  
  591.     call pdm_initplot(numberleft, numbertop, scaleX, scaleY, 0)
  592.     call pdm_PlotBezier(numstring1)
  593.     obj = pdm_ClosePlot()
  594.     curves.identity = obj
  595.     call pdm_SetLineWeight(obj, 0.00)
  596.     call pdm_SetFillPattern(obj,1, colour2)
  597.     identity = identity+1
  598.     
  599.     if numstring2 ~="" then do /* holes in numerals - use solid fills, not compound objects */
  600.         call pdm_initplot(numberleft, numbertop, scaleX, scaleY, 0)
  601.         call pdm_PlotBezier(numstring2)
  602.         obj = pdm_ClosePlot()
  603.         curves.identity = obj
  604.         call pdm_SetLineWeight(obj, 0.00)
  605.         call pdm_SetFillPattern(obj,1, colour1)
  606.         identity = identity+1
  607.         end
  608.     if numstring3 ~="" then do /* some have 2 holes */
  609.         call pdm_initplot(numberleft, numbertop, scaleX, scaleY, 0)
  610.         call pdm_PlotBezier(numstring3)
  611.         obj = pdm_ClosePlot()
  612.         curves.identity = obj
  613.         call pdm_SetLineWeight(obj, 0.00)
  614.         call pdm_SetFillPattern(obj,1, colour1)
  615.         identity = identity+1
  616.         end
  617. return
  618.  
  619. /* +++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++ */
  620.  
  621. /* draw background rectangle */
  622. drawrectangle:
  623. currentfill = colour1
  624. boxright = cornerX + boxwidth
  625. boxbottom = cornerY + boxheight
  626. obj = pdm_DrawRectangle(cornerX, cornerY, boxright, boxbottom)
  627. call pdm_SetLineWeight(obj, 0.00)
  628. call pdm_SetFillPattern(obj,1, currentfill)
  629. curves.identity = obj
  630. identity = identity+1
  631. return
  632.  
  633. /* +++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++ */
  634.  
  635. setcolors:
  636.  
  637. colorlist   = pdm_GetColorList()
  638. colorlist2 = space(colorlist,0)/* remove spaces from names */
  639. colorlist2 = translate(colorlist2,,"0a"x)/* replace crs by spaces */
  640. listlength = words(colorlist2)
  641. if listlength>24 then listlength = 24
  642. colour1   =  pdm_SelectFromList("Select Background Color..", 20, listlength, 0, colorlist)
  643. if colour1 = '' then colour1 = "WHITE"
  644. colour2  =  pdm_SelectFromList("Select Bar Color..", 20, listlength, 0, colorlist)
  645. if colour2 = '' then colour2 = "BLACK"
  646.  
  647. colour1 = strip(colour1) /* remove any spaces */
  648. colour2 = strip(colour2)
  649. call setclip(pduscolour1,colour1)
  650. call setclip(pduscolour2,colour2)
  651.  
  652. if words(colour1)+words(colour2)= 2 then do /* GetColourData only works on 1-word names */
  653.     colour1data = pdm_GetColorData(colour1)
  654.     colour2data = pdm_GetColorData(colour2)
  655.     parse var colour1data red1 others
  656.     parse var colour2data red2 others
  657.     if abs(red1-red2)<5 then exit_msg("Not enough red contrast")
  658.     end
  659. colourpair = colour1||"0a"x||colour2
  660.  
  661. return colourpair
  662.  
  663. /* ++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++ */
  664.  
  665. checksum: procedure
  666. parse arg numstring
  667.  
  668. pos = length(numstring)
  669. total = 0
  670. do until pos<1
  671.     total = total+substr(numstring,pos,1)
  672.     pos=pos-2
  673.     end
  674. total = total*3
  675. pos= length(numstring)-1
  676. total2 = 0
  677. do until pos<1
  678.     total2 = total2+substr(numstring,pos,1)
  679.     pos=pos-2
  680.     end
  681. total=total+total2
  682. ch=10-(total//10)
  683. if ch=10 then ch = 0
  684.  
  685. numstring = numstring||ch
  686. return numstring
  687.  
  688. /* +++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++ */
  689.  
  690. checksum5: procedure
  691. parse arg numstring
  692.  
  693. pos = length(numstring)
  694. total = 0
  695. do until pos<1
  696.     total = total+substr(numstring,pos,1)
  697.     pos=pos-2
  698.     end
  699. total = total*3
  700. pos= length(numstring)-1
  701. total2 = 0
  702. do until pos<1
  703.     total2 = total2+substr(numstring,pos,1)
  704.     pos=pos-2
  705.     end
  706. total2 = total2*9
  707. total=total+total2
  708. ch=right(total,1)
  709.  
  710. return ch
  711.  
  712. /* +++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++ */
  713.  
  714. clearos: procedure
  715.  
  716. parse arg numbers
  717. position = 0 /* now replace O's with zeros */
  718. do forever
  719.     position = pos("O", numbers,position+1)
  720.     if position = 0 then break
  721.     numbers = delstr(numbers,position,1)
  722.     numbers = insert("0",numbers,position-1)
  723.     end
  724. position = 0 /* now replace o's with zeros */
  725. do forever
  726.     position = pos("o", numbers,position+1)
  727.     if position = 0 then break
  728.     numbers = delstr(numbers,position,1)
  729.     numbers = insert("0",numbers,position-1)
  730.     end
  731. position = 0 /* now remove hyphens */
  732. do forever
  733.     position = pos("-", numbers,position+1)
  734.     if position = 0 then break
  735.     numbers = delstr(numbers,position,1)
  736.     end
  737.  
  738. return numbers
  739.  
  740. /* +++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++ */
  741.  
  742.  
  743. exit_msg: procedure expose oldunits
  744. do
  745.     parse arg message
  746.  
  747.     if message ~= '' then call pdm_Inform(1,message,)
  748.     call pdm_ClearStatus()
  749.     call pdm_SetUnits(oldunits)
  750.     call pdm_UpdateScreen(0)
  751.     call pdm_AutoUpdate(1)
  752.     exit
  753. end
  754.  
  755.