Barcode 39 generator

[Galileo]

In Yabasic, of course.

Code: [Select]

//---------------------------------------------------------------------------------------
// Module    : ModuleBarcode
// DateTime  : 10/7/2002 19:37
// Author    : Joyprakash saikia
// Purpose   : this Module Consist of all functions required to
//              print a barCode 39.
// Fixes     : The Bar39 had a small bug in printing '*',
//             which is essential for Barcode Readers.
//
// Code 39
// Adapted to Yabasic by Galileo, 2017/12
//---------------------------------------------------------------------------------------

open window 320, 120

DrawBarcode("ABC123", 50, 25, 50, 2)

Sub DrawBarcode(bc_string$, xpos, ypos, hei, dw)

If bc_string$ = "" return
//define barcode patterns
Dim bc$(90)
bc$(1) = "1 1221"            //pre-amble
bc$(2) = "1 1221"            //post-amble
bc$(48) = "11 221"           //digits
bc$(49) = "21 112"
bc$(50) = "12 112"
bc$(51) = "22 111"
bc$(52) = "11 212"
bc$(53) = "21 211"
bc$(54) = "12 211"
bc$(55) = "11 122"
bc$(56) = "21 121"
bc$(57) = "12 121"
                            //capital letters
bc$(65) = "211 12"           //A
bc$(66) = "121 12"           //B
bc$(67) = "221 11"           //C
bc$(68) = "112 12"           //D
bc$(69) = "212 11"           //E
bc$(70) = "122 11"           //F
bc$(71) = "111 22"           //G
bc$(72) = "211 21"           //H
bc$(73) = "121 21"           //I
bc$(74) = "112 21"           //J
bc$(75) = "2111 2"           //K
bc$(76) = "1211 2"           //L
bc$(77) = "2211 1"           //M
bc$(78) = "1121 2"           //N
bc$(79) = "2121 1"           //O
bc$(80) = "1221 1"           //P
bc$(81) = "1112 2"           //Q
bc$(82) = "2112 1"           //R
bc$(83) = "1212 1"           //S
bc$(84) = "1122 1"           //T
bc$(85) = "2 1112"           //U
bc$(86) = "1 2112"           //V
bc$(87) = "2 2111"           //W
bc$(88) = "1 1212"           //X
bc$(89) = "2 1211"           //Y
bc$(90) = "1 2211"           //Z
                            //Misc
bc$(32) = "1 2121"           //space
bc$(35) = ""                 //# cannot do!
bc$(36) = "1 1 1 11"         //$
bc$(37) = "11 1 1 1"         //%
bc$(43) = "1 11 1 1"         //+
bc$(45) = "1 1122"           //-
bc$(47) = "1 1 11 1"         ///
bc$(46) = "2 1121"           //.
bc$(64) = ""                 //@ cannot do!
//A Fix made by changing 65 to 42.
bc$(42) = "1 1221"           //*

bc_string$ = upper$(bc_string$)

clear window
new_string$ = chr$(1) + bc_string$ + chr$(2)      //add pre-amble, post-amble
Y2 = ypos + hei
//draw each character in barcode string
For n = 1 To Len(new_string$)
    c = Asc(Mid$(new_string$, n, 1))
    If c > 90 c = 0
    bc_pattern$ = bc$(c)
   
    //draw each bar
    For i = 1 To Len(bc_pattern$)
        switch Mid$(bc_pattern$, i, 1)
            Case " ":
                //space
                color 255,255,255
                fill box xpos, ypos, xpos + 1 * dw, Y2
                xpos = xpos + dw
                break
            Case "1":
                //space
                color 255,255,255
                fill box xpos, ypos, xpos + 1 * dw, Y2
                xpos = xpos + dw
                //line
                color 0,0,0
                fill box xpos, ypos, xpos + 1 * dw, Y2
                xpos = xpos + dw
            break
            Case "2":
                //space
                color 255,255,255
                fill box xpos, ypos, xpos + 1 * dw, Y2
                xpos = xpos + dw
                //wide line
                color 0,0,0
                fill box xpos, ypos, xpos + 2 * dw, Y2
                xpos = xpos + 2 * dw
        End switch
    Next i
Next n

//1 more space
color 255,255,255
fill box xpos, ypos, xpos + 1 * dw, Y2
xpos = xpos + dw

xpos = xpos - (peek("fontheight") * len(bc_string$)) / 1.5
Y2 = Y2 + peek("fontheight") * 1.5
//final size and text
color 0,0,0
text xpos, Y2, bc_string$
End Sub



[ZXDunny]

Here's mine:

Code: [Select]

10 REM Code 39 Barcode generator
20 DIM a=265,73,328,25,280,88,13,268,76,28,259,67,322,19,274,82,7,262,70,22,385,193,448,145,400,208,52,289,97,352,49,304,112,37,292,100,196,133,168,42,388,162,138,148:
   a$="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 -$%./+*"
30 INPUT "Phrase: ";p$:
   x=0,p$="*"+UP$ p$+"*",l=LEN p$
40 FOR f=1 TO l:
      c=POS(p$(f),a$):
      IF c=0 THEN
         PRINT "Error in input": STOP
50    d=a(c):
      FOR g=9 TO 0:
         b=IIF(d & (1 SHL g)<>0,3,1):
         RECTANGLE INK 8*ODD g;x,0 TO x+b,22 FILL:
         x+=b+1:
      NEXT g:
      x+=2:
   NEXT f
60 PRINT MOVE (x-(l*16))/2,16;SCALE 2,2;p$

Did it for a BASIC challenge in a facebook group a while ago.

[Galileo]

Hello, ZXDunny.

What type of barcode does your program generate? It's not code 39.

[ZXDunny]

Hello, ZXDunny.

What type of barcode does your program generate? It's not code 39.

Yes it is.

Edit: One small error -

Line 50, change FOR G=9 TO 0 and the EVEN should be ODD. Then the characters will be correct.

[Galileo]

I'm sorry, but it still doesn't work well. By entering "ABC 123", I get as a result the wrong barcode shown below. Compare this with a specialised website.

This is your code adapted to Yabasic:

Code: [Select]

REM Code 39 Barcode generator, by ZXDunny

open window 500, 100

data 265,73,328,25,280,88,13,268,76,28,259,67,322,19,274,82,7,262,70,22,385,193,448,145,400,208,52,289,97,352,49,304,112,37,292,100,196,133,168,42,388,162,138,148
a$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 -$%./+*"
n = len(a$)
dim a(n)

for i = 1 to n
read a(i)
next i
x = 10
p$ = "ABC123"
//INPUT "Phrase: " p$
l = LEN(p$)
p$ = upper$(p$)
FOR f = 1 TO l
c = instr(a$, mid$(p$, f, 1))
IF c = 0 PRINT "Error in input" : end
d = a(c)
FOR g = 9 TO 0 step -1
if and(d, (shl(1, g))) then
b = 3
else
b = 1
end if
if mod(g, 2) = 1 then
color 0, 0, 0
else
color 255, 255, 255
end if
        fill RECTANGLE x, 10 TO x + b, 42
        x = x + b + 1
NEXT g
x = x + 2
NEXT f

sub shl(lhs, rhs)
return Int(lhs * 2 ^ rhs)
end sub

[ZXDunny]

I'm afraid that you've got the conversion from SpecBAS to yabasic wrong. Here's what I get in SpecBAS:



So your bit decoding is likely at fault. Also, that site is either wrong, or wikipedia is wrong - SpecBAS's bars are identical to the wikipedia article at

https://en.wikipedia.org/wiki/Code_39

In particular, this image:

https://upload.wikimedia.org/wikipedia/commons/f/fd/Free_3_of_9_%28Code_39_barcode%29.svg

Uses character bars that are identical to the ones SpecBAS has encoded. Which site is actually correct is left as an exercise for the reader.


Edit: Aha, there is indeed a small bug left in there - the gap between letters in SpecBAS is too large. So, remove the line "x+=2" as so:

Code: [Select]

10 REM Code 39 Barcode generator
20 DIM a=265,73,328,25,280,88,13,268,76,28,259,67,322,19,274,82,7,262,70,22,385,193,448,145,400,208,52,289,97,352,49,304,112,37,292,100,196,133,168,42,388,162,138,148:
   a$="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 -$%./+*"
30 INPUT "Phrase: ";p$:
   x=0,p$="*"+UP$ p$+"*",l=LEN p$
40 FOR f=1 TO l:
      c=POS(p$(f),a$):
      IF c=0 THEN
         PRINT "Error in input": STOP
50    d=a(c):
      FOR g=9 TO 0:
         b=IIF(d & (1 SHL g)<>0,3,1):
         RECTANGLE INK 8*ODD g;x,0 TO x+b,22 FILL:
         x+=b+1:
      NEXT g:
   NEXT f
60 PRINT MOVE (x-(l*16))/2,16;SCALE 2,2;p$

And we get this image:



Which matches your version pretty well indeed. Many thanks for that!

[Galileo]

I've gone over my code several times, but I can't see the error. However, certainly now the result obtained by your program is correct. Glad I could help.

[Galileo]

Well! A small modification and works perfectly.

Code: [Select]

REM Code 39 Barcode generator, by ZXDunny
// Adapted to Yabasic gy Galileo, 02/2018

open window 500, 100

data 265,73,328,25,280,88,13,268,76,28,259,67,322,19,274,82,7,262,70,22,385,193,448,145,400,208
data 52,289,97,352,49,304,112,37,292,100,196,133,168,42,388,162,138,148
a$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 -$%./+*"
n = len(a$)
dim a(n)

black$ = "0,0,0"
white$ = "255,255,255"

for i = 1 to n
read a(i)
next i

x = 10

INPUT "Phrase: " p$ // test "*ABC123*"

l = LEN(p$)
p$ = upper$(p$)
FOR f = 1 TO l
c$ = mid$(p$, f, 1)
c = instr(a$, c$ )
IF c = 0 PRINT "Error in input" : end
d = a(c)
b$ = right$("00000000" + bin$(d), 9)
FOR g = 1 to 9
if val(mid$(b$, g, 1)) then
b = 3
else
b = 1
end if
if mod(g, 2) then
color black$
else
color white$
end if
                fill RECTANGLE x, 10 TO x + b, 50
                x = x + b + 1
NEXT g
x = x + 2
NEXT f

color black$ : text 10, 70, p$


[Galileo]

Well, I finally got it to work with the technique used by ZXDunny.

Code: [Select]

REM Code 39 Barcode generator, by ZXDunny
// Adapted to Yabasic by Galileo, 02/2018, v2

open window 500, 100

data 265,73,328,25,280,88,13,268,76,28,259,67,322,19,274,82,7,262,70,22,385,193,448,145,400,208,52,289,97,352,49,304,112,37,292,100,196,133,168,42,388,162,138,148
a$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 -$%./+*"
n = len(a$)
dim a(n)

black$ = "0,0,0"
white$ = "255,255,255"

for i = 1 to n
read a(i)
next i
x = 10
INPUT "Phrase: " p$ // test "ABC123"
p$ = "*" + upper$(p$) + "*"
l = LEN(p$)
FOR f = 1 TO l
c$ = mid$(p$, f, 1)
c = instr(a$, c$ )
IF c = 0 PRINT "Error in input" : end
d = a(c)
FOR g = 8 to 0 step -1
if and(d, (shl(1, g))) then
b = 3
else
b = 1
end if
if mod(g, 2) then
color white$
else
color black$
end if
                fill RECTANGLE x, 10 TO x + b, 50
                x = x + b + 1
NEXT g
x = x + 2
NEXT f

color black$ : text 10, 70, p$

sub shl(lhs, rhs)
return Int(lhs * 2 ^ rhs)
end sub

[B+]

Well looks like an SB translation works: