Jump to content

Curl/Example 6

From Wikibooks, open books for an open world

Curl is a gentle slope language. Here I will put some code to draw a UPC bar code that shows how you can program it using two techniques. Note that in the code below I have used markup and some text procs too. This is to demonstrate how these things can all be done so seamlessly in Curl.

I have implemented the UPC bar code using two techniques. The first technique uses Rule objects to draw the bars of the bar code. The second technique is more efficient. It uses the rendering APIs to render the bars of the bar code.

|| ===== begin of program ========
{curl 5.0, 6.0 applet}
{curl-file-attributes character-encoding = "windows-latin-1"}

{center {bold font-size = 14pt, Universal Product Code}}

{center 
    {small 
      The documentation on Universal Product Code is taken from
      {link href = {url "http://www.wikipedia.com"}, Wikipedia}
    }
}

The Universal Product Code (UPC) is one of a wide varity of bar code
languages called symbologies.

The UPS code has 12 decimal digits as 

S{bold {underline L}LLLLL}M{bold RRRRR{underline R}}E

where S (start) E (end) are the bit pattern 101, M (middle) is the bit
pattern 01010 and each L (left) and R (Right) are digits, each one
represented by a seven-bit code.This is a total of 95 bits.

The UPC has only numerals, with no letters or other characters.

{italic (L) left code}:
{Table
    columns = 2,
    border-width = 1pt,
    vertical-line-width = 1pt,
    horizontal-line-width = 1pt,
    "0", "3-2-1-1",
    "1", "2-2-2-1",
    "2", "2-1-2-2",
    "3", "1-4-1-1",
    "4", "1-1-3-2",
    "5", "1-2-3-1",
    "6", "1-1-1-4",
    "7", "1-3-1-2",
    "8", "1-2-1-3",
    "9", "3-1-1-2"
}

The (R) right codes are one's complement of the corresponding left codes.

I have implemented this in two ways. The first approach uses a Rule
object to draw the bars of the UPC code and the second approach uses
the renderer calls to draw. The first one is easy to write and will
act as the prototype for the second case which is more efficient.

To represent a code we make a Code class that has the four sequences
of 0's and 1's. This code is shared by both the approaches. If you are
running under 6.0 you can make this class a value class. So instead of
"define-class" use "define-value-class".

{define-class public final Code
  field constant public first:int
  field constant public second:int
  field constant public third:int
  field constant public fourth:int

  {constructor public {default first:int, second:int, third:int, fourth:int}
    set self.first = first
    set self.second = second
    set self.third = third
    set self.fourth = fourth
  }
}

{bold Approach 1.}

In this approach we will use a Rule object to represent the bars.

|| Returns an array of UPC codes from 0 to 9 as defined by the table
|| for L codes.. We will use this same table for the R codes except
|| the bits that are one will be considered off and vice-versa.
{define-proc public {get-codes}:{Array-of Code}
    let constant codes:{Array-of Code} = 
        {{Array-of Code} efficient-size = 12}
    {codes.append {Code 3, 2, 1, 1}}
    {codes.append {Code 2, 2, 2, 1}}
    {codes.append {Code 2, 1, 2, 2}}
    {codes.append {Code 1, 4, 1, 1}}
    {codes.append {Code 1, 1, 3, 2}}
    {codes.append {Code 1, 2, 3, 1}}
    {codes.append {Code 1, 1, 1, 4}}
    {codes.append {Code 1, 3, 1, 2}}
    {codes.append {Code 1, 2, 1, 3}}
    {codes.append {Code 3, 1, 1, 2}}

    {return codes}
}

|| Returns a Graphic that represents the UPC code for the
|| "code-str". The code-str sting must represent a valid UPC code
|| number (All the characters in this string should be between '0' and
|| '9' inclusive of the end points, and the twelfth bit should
|| represent the valid checksum for the previous 11 bits.
|| "strip-width" represents number of pixels each bit of the UPC code
|| should be wide. By default it is 2.
{define-proc public {make-upc-graphic 
                        code-str:String,
                        strip-width:int = 2 }:Graphic 
    {validate-code-str code-str} 
    {assert strip-width > 0}
    
    let constant hbox:HBox = 
        {HBox height = 1cm, vstretch? = true, framelike-stretch? = true}
    
    let constant codes:{Array-of Code} = {get-codes}
    let constant black:FillPattern = FillPattern.black
    let constant white:FillPattern = FillPattern.white
    let constant unit:PixelDistance = (strip-width * 1px)

    || Add start code (101)
    {hbox.add {Rule width = unit, color = black}}
    {hbox.add {Rule width = unit, color = white}}
    {hbox.add {Rule width = unit, color = black}}

    || Add L bits.
    {for i = 0 below 6 do
        let constant code:Code = codes[code-str[i] - '0']
        {hbox.add {Rule width = code.first * unit, color = white}}
        {hbox.add {Rule width = code.second * unit, color = black}}
        {hbox.add {Rule width = code.third * unit, color = white}}
        {hbox.add {Rule width = code.fourth * unit, color = black}}
    }

    || Add middle code (01010)
    {hbox.add {Rule width = unit, color = white}}
    {hbox.add {Rule width = unit, color = black}}
    {hbox.add {Rule width = unit, color = white}}
    {hbox.add {Rule width = unit, color = black}}
    {hbox.add {Rule width = unit, color = white}}

    || Add R bits.
    {for i = 6 below 12 do
        let constant code:Code = codes[code-str[i] - '0']
        {hbox.add {Rule width = code.first, color = black}}
        {hbox.add {Rule width = code.second * unit, color = white}}
        {hbox.add {Rule width = code.third * unit, color = black}}
        {hbox.add {Rule width = code.fourth * unit, color = white}}
    }

    || Add end code (101)
    {hbox.add {Rule width = unit, color = black}}
    {hbox.add {Rule width = unit, color = white}}
    {hbox.add {Rule width = unit, color = black}}

    {return hbox}
}

|| Validate the code-str according to the rules of UPC codes.
{define-proc package {validate-code-str code-str:String}:void
    {assert code-str.size == 12}
    let checksum:int
    let count:int = 0
    {for ch in code-str do
        {inc count}
        {if ch < '0' or ch > '9' then
            {error "Invalid Universal Product Code: " & code-str}
        }
        {if count < 12 then
            {if (count mod 2) == 1 then
                set checksum = checksum + 3 * (ch - '0')
             else
                set checksum = checksum + (ch - '0')
            }
         else
            set checksum = 10 - (checksum mod 10)
            {if checksum != ch - '0' then
            {error "Invalid Checksum in Universal Product Code: " & code-str}}
        }
    }
}

This is the result of calling "make-upc-graphic" proc to make a UPC
bars for the UPC code "036000291452".

{make-upc-graphic "036000291452", strip-width = 2}

{bold Approach 2}

Once you become an advanced Curl programmer, you may want to use the
Renderer directly to draw the UPC code bars instead of adding a
Graphical object to represent them.

We make a UPCGraphic class that is a subclass of Graphic. We override
the {italic get-width-preference} and {italic get-height-preference} to
make the default width of this Graphic a multiple of strip-width times
pixel-size and the default height of 1cm. We also override the {italic
draw} method of this Graphic to draw the UPC code bars.

{define-class public UPCGraphic {inherits Graphic}
  || There are total of 95 strips in a UPC code bar.
  let private number-of-strips:int = 95
  || The UPC codes.
  let private codes:#{Array-of Code}

  || The UPC code that this UPCGraphic represents.
  field constant public code-str:String
  
  || This determines the default width of this Graphic object. The
  || default width is strip-width times the pixel size.
  field constant  public strip-width:int

  || Returns the UPC codes. Note that this is a class proc and it
  || initializes the UPCGraphic.codes class variable.
 {define-proc public {get-codes}:{Array-of Code}
    {return
        {if-non-null codes = UPCGraphic.codes then
            codes
         else
            let constant codes:{Array-of Code} = {{Array-of Code}}
            {codes.append {Code 3, 2, 1, 1}}
            {codes.append {Code 2, 2, 2, 1}}
            {codes.append {Code 2, 1, 2, 2}}
            {codes.append {Code 1, 4, 1, 1}}
            {codes.append {Code 1, 1, 3, 2}}
            {codes.append {Code 1, 2, 3, 1}}
            {codes.append {Code 1, 1, 1, 4}}
            {codes.append {Code 1, 3, 1, 2}}
            {codes.append {Code 1, 2, 1, 3}}
            {codes.append {Code 3, 1, 1, 2}}
            set UPCGraphic.codes = codes
            codes
        }
    }
  }
  
  || Class proc to validate the UPC code string.
  {define-proc private {validate-code-str code-str:String}:void
    {assert code-str.size == 12}
    let checksum:int
    let count:int = 0
    {for ch in code-str do
        {inc count}
        {if ch < '0' or ch > '9' then
            {error "Invalid Universal Product Code: " & code-str}
        }
        {if count < 12 then
            {if (count mod 2) == 1 then
                set checksum = checksum + 3 * (ch - '0')
             else
                set checksum = checksum + (ch - '0')
            }
         else
            set checksum = 10 - (checksum mod 10)
            {if checksum != ch - '0' then
            {error "Invalid Checksum in Universal Product Code: " & code-str}}
        }
    }
  }

  || The constructor for the UPCGraphic object. You must pass a
  || code-str that represents a valid UPC code.
  {constructor public {default
                          code-str:String,
                          strip-width:int = 2,
                          ...
                      }
    {UPCGraphic.validate-code-str code-str}
    {assert strip-width > 0}
    set self.code-str = code-str
    set self.strip-width = strip-width
    
    {construct-super ...}
  }

  {method public open {get-width-preference lc:LayoutContext}:Dimension
    let constant psize:Distance = lc.layout-display-context.pixel-size
    {return psize * self.strip-width * UPCGraphic.number-of-strips}
  }

  {method public open {get-height-preference lc:LayoutContext}:Dimension
    {return 1cm}
  }

  {method public open {constrain-height
                          lc:LayoutContext,
                          ascent:Distance,
                          descent:Distance
                      }:Dimension
    let constant psize:Distance = lc.layout-display-context.pixel-size
    {return psize * self.strip-width * UPCGraphic.number-of-strips}
  }

  {method public open {constrain-width
                          lc:LayoutContext,
                          lextent:Distance,
                          rextent:Distance
                      }:Dimension
    {return 1cm}
  }

  {method public open {draw renderer2d:Renderer2d}:void
    {super.draw renderer2d}
    
    let constant psize:Distance = renderer2d.pixel-size
    let constant bounds:GRect = {self.layout.get-bounds}
    
    let x:Distance = -bounds.lextent
    let constant y:Distance = -bounds.ascent
    let constant height:Distance = bounds.height
    let constant unit-size:Distance = 
        {self.quantize-width bounds.width / UPCGraphic.number-of-strips}
    let constant white:FillPattern = FillPattern.white
    let constant black:FillPattern = FillPattern.black
    let constant codes:{Array-of Code} = {UPCGraphic.get-codes}
    let constant code-str:String = self.code-str

    || Draw Start bits (1, 0, 1)
    {renderer2d.render-rectangle
        x, y, unit-size, height, fill-pattern = black
    }
    set x = x + unit-size
    {renderer2d.render-rectangle
        x, y, unit-size, height, fill-pattern = white
    }
    set x = x + unit-size
    {renderer2d.render-rectangle
        x, y, unit-size, height, fill-pattern = black
    }
    set x = x + unit-size

    {for i = 0 below 6 do
        let constant code:Code = codes[code-str[i] - '0']

        {renderer2d.render-rectangle
            x, y, unit-size * code.first, height, fill-pattern = white
        }
        set x = x + unit-size * code.first
        {renderer2d.render-rectangle
            x, y, unit-size * code.second, height, fill-pattern = black
        }
        set x = x + unit-size * code.second
        {renderer2d.render-rectangle
            x, y, unit-size * code.third, height, fill-pattern = white
        }
        set x = x + unit-size * code.third
        {renderer2d.render-rectangle
            x, y, unit-size * code.fourth, height, fill-pattern = black
        }
        set x = x + unit-size * code.fourth
    }

    || Draw Middle Bits bits (0, 1, 0, 1, 0)
    {renderer2d.render-rectangle
        x, y, unit-size, height, fill-pattern = white
    }
    set x = x + unit-size
    {renderer2d.render-rectangle
        x, y, unit-size, height, fill-pattern = black
    }
    set x = x + unit-size
    {renderer2d.render-rectangle
        x, y, unit-size, height, fill-pattern = white
    }
    set x = x + unit-size
    {renderer2d.render-rectangle
        x, y, unit-size, height, fill-pattern = black
    }
    set x = x + unit-size
    {renderer2d.render-rectangle
        x, y, unit-size, height, fill-pattern = FillPattern.white
    }
    set x = x + unit-size
    {for i = 6 below 12 do
        let constant code:Code = codes[code-str[i] - '0']

        {renderer2d.render-rectangle
            x, y, unit-size * code.first, height, fill-pattern = black
        }
        set x = x + unit-size * code.first
        {renderer2d.render-rectangle
            x, y, unit-size * code.second, height, fill-pattern = white
        }
        set x = x + unit-size * code.second
        {renderer2d.render-rectangle
            x, y, unit-size * code.third, height, fill-pattern = black
        }
        set x = x + unit-size * code.third
        {renderer2d.render-rectangle
            x, y, unit-size * code.fourth, height, fill-pattern = white
        }
        set x = x + unit-size * code.fourth
    }
    || Draw End Bits bits (1, 0, 1)
    {renderer2d.render-rectangle
        x, y, unit-size, height, fill-pattern = black
    }
    set x = x + unit-size
    {renderer2d.render-rectangle
        x, y, unit-size, height, fill-pattern = white
    }
    set x = x + unit-size
    {renderer2d.render-rectangle
        x, y, unit-size, height, fill-pattern = black
    }
  }
}

This is the result of calling UPCGraphic and passing "036000291452".

{UPCGraphic "036000291452"}

 || ======end of program ========