#
# The Rosetta Code lexical analyzer in Icon with co-expressions. Based
# upon the ATS implementation.
#
# Usage: lex [INPUTFILE [OUTPUTFILE]]
#   If INPUTFILE or OUTPUTFILE is "-" or missing, then standard input
#   or standard output is used, respectively. *)
#

$define EOF -1

$define TOKEN_ELSE          0
$define TOKEN_IF            1
$define TOKEN_PRINT         2
$define TOKEN_PUTC          3
$define TOKEN_WHILE         4
$define TOKEN_MULTIPLY      5
$define TOKEN_DIVIDE        6
$define TOKEN_MOD           7
$define TOKEN_ADD           8
$define TOKEN_SUBTRACT      9
$define TOKEN_NEGATE       10
$define TOKEN_LESS         11
$define TOKEN_LESSEQUAL    12
$define TOKEN_GREATER      13
$define TOKEN_GREATEREQUAL 14
$define TOKEN_EQUAL        15
$define TOKEN_NOTEQUAL     16
$define TOKEN_NOT          17
$define TOKEN_ASSIGN       18
$define TOKEN_AND          19
$define TOKEN_OR           20
$define TOKEN_LEFTPAREN    21
$define TOKEN_RIGHTPAREN   22
$define TOKEN_LEFTBRACE    23
$define TOKEN_RIGHTBRACE   24
$define TOKEN_SEMICOLON    25
$define TOKEN_COMMA        26
$define TOKEN_IDENTIFIER   27
$define TOKEN_INTEGER      28
$define TOKEN_STRING       29
$define TOKEN_END_OF_INPUT 30

global whitespace
global ident_start
global ident_continuation

procedure main(args)
  local inpf, outf
  local pushback_buffer, inp, pushback

  initial {
    whitespace := ' \t\v\f\r\n'
    ident_start := '_' ++ &letters
    ident_continuation := ident_start ++ &digits
  }

  inpf := &input
  outf := &output
  if 1 <= *args & args[1] ~== "-" then {
    inpf := open(args[1], "rt") |
        stop("cannot open ", args[1], " for input")
  }
  if 2 <= *args & args[2] ~== "-" then {
    outf := open(args[2], "wt") |
        stop("cannot open ", args[2], " for output")
  }

  pushback_buffer := []
  inp := create inputter(inpf, pushback_buffer)
  pushback := create repeat push(pushback_buffer, \@&source)
  @pushback                     #  The first invocation does nothing.

  scan_text(outf, inp, pushback)
end

procedure scan_text(outf, inp, pushback)
  local ch

  while /ch | ch[1] ~=== EOF do {
    skip_spaces_and_comments(inp, pushback)
    ch := @inp
    if ch[1] === EOF then {
      print_token(outf, [TOKEN_END_OF_INPUT, "", ch[2], ch[3]])
    } else {
      ch @pushback
      print_token(outf, get_next_token(inp, pushback))
    }
  }
end

procedure get_next_token(inp, pushback)
  local ch, ch1
  local ln, cn

  skip_spaces_and_comments(inp, pushback)
  ch := @inp
  ln := ch[2]                   # line number
  cn := ch[3]                   # column number
  case ch[1] of {
    "," : return [TOKEN_COMMA, ",", ln, cn]
    ";" : return [TOKEN_SEMICOLON, ";", ln, cn]
    "(" : return [TOKEN_LEFTPAREN, "(", ln, cn]
    ")" : return [TOKEN_RIGHTPAREN, ")", ln, cn]
    "{" : return [TOKEN_LEFTBRACE, "{", ln, cn]
    "}" : return [TOKEN_RIGHTBRACE, "}", ln, cn]
    "*" : return [TOKEN_MULTIPLY, "*", ln, cn]
    "/" : return [TOKEN_DIVIDE, "/", ln, cn]
    "%" : return [TOKEN_MOD, "%", ln, cn]
    "+" : return [TOKEN_ADD, "+", ln, cn]
    "-" : return [TOKEN_SUBTRACT, "-", ln, cn]
    "<" : {
      ch1 := @inp
      if ch1[1] === "=" then {
        return [TOKEN_LESSEQUAL, "<=", ln, cn]
      } else {
        ch1 @pushback
        return [TOKEN_LESS, "<", ln, cn]
      }
    }
    ">" : {
      ch1 := @inp
      if ch1[1] === "=" then {
        return [TOKEN_GREATEREQUAL, ">=", ln, cn]
      } else {
        ch1 @pushback
        return [TOKEN_GREATER, ">", ln, cn]
      }
    }
    "=" : {
      ch1 := @inp
      if ch1[1] === "=" then {
        return [TOKEN_EQUAL, "==", ln, cn]
      } else {
        ch1 @pushback
        return [TOKEN_ASSIGN, "=", ln, cn]
      }
    }
    "!" : {
      ch1 := @inp
      if ch1[1] === "=" then {
        return [TOKEN_NOTEQUAL, "!=", ln, cn]
      } else {
        ch1 @pushback
        return [TOKEN_NOT, "!", ln, cn]
      }
    }
    "&" : {
      ch1 := @inp
      if ch1[1] === "&" then {
        return [TOKEN_AND, "&&", ln, cn]
      } else {
        unexpected_character(ln, cn, ch)
      }
    }
    "|" : {
      ch1 := @inp
      if ch1[1] === "|" then {
        return [TOKEN_OR, "||", ln, cn]
      } else {
        unexpected_character(ln, cn, ch)
      }
    }
    "\"" : {
      ch @pushback
      return scan_string_literal(inp)
    }
    "'" : {
      ch @pushback
      return scan_character_literal(inp, pushback)
    }
    default : {
      if any(&digits, ch[1]) then {
        ch @pushback
        return scan_integer_literal(inp, pushback)
      } else if any(ident_start, ch[1]) then {
        ch @pushback
        return scan_identifier_or_reserved_word (inp, pushback)
      } else {
        unexpected_character(ln, cn, ch)
      }
    }
  }
end

procedure scan_identifier_or_reserved_word(inp, pushback)
  local ch
  local s
  local line_no, column_no

  s := ""
  ch := @inp
  line_no := ch[2]
  column_no := ch[3]
  while EOF ~=== ch[1] & any(ident_continuation, ch[1]) do {
    s ||:= ch[1]
    ch := @inp
  }
  ch @pushback
  return reserved_word_lookup (s, line_no, column_no)
end

procedure scan_integer_literal(inp, pushback)
  local ch
  local s
  local line_no, column_no

  s := ""
  ch := @inp
  line_no := ch[2]
  column_no := ch[3]
  while EOF ~=== ch[1] & any(ident_continuation, ch[1]) do {
    s ||:= ch[1]
    ch := @inp
  }
  ch @pushback
  not upto(~&digits, s) | invalid_integer_literal(line_no, column_no, s)
  return [TOKEN_INTEGER, s, line_no, column_no]
end

procedure scan_character_literal(inp, pushback)
  local ch, ch1
  local close_quote
  local toktup
  local line_no, column_no

  ch := @inp                    # The opening quote.
  close_quote := ch[1]          # Same as the opening quote.
  ch @pushback

  line_no := ch[2]
  column_no := ch[3]

  toktup := scan_character_literal_without_checking_end(inp)
  ch1 := @inp
  if ch1[1] ~=== close_quote then {
    repeat {
      case ch1[1] of {
        EOF : unterminated_character_literal(line_no, column_no)
        close_quote : multicharacter_literal(line_no, column_no)
        default : ch1 := @inp
      }
    }
  }
  return toktup
end

procedure scan_character_literal_without_checking_end(inp)
  local ch, ch1, ch2

  ch := @inp                    # The opening quote.
  ch1 := @inp
  EOF ~=== ch1[1] | unterminated_character_literal(ch[2], ch[3])
  if ch1[1] == "\\" then {
    ch2 := @inp
    EOF ~=== ch2[1] | unterminated_character_literal(ch[2], ch[3])
    case ch2[1] of {
      "n" : return [TOKEN_INTEGER, string(ord("\n")), ch[2], ch[3]]
      "\\" : return [TOKEN_INTEGER, string(ord("\\")), ch[2], ch[3]]
      default : unsupported_escape(ch1[2], ch1[3], ch2)
    }
  } else {
    return [TOKEN_INTEGER, string(ord(ch1[1])), ch[2], ch[3]]
  }
end

procedure scan_string_literal(inp)
  local ch, ch1, ch2
  local line_no, column_no
  local close_quote
  local s
  local retval

  ch := @inp                    # The opening quote
  close_quote := ch[1]          # Same as the opening quote.
  line_no := ch[2]
  column_no := ch[3]

  s := ch[1]
  until \retval do {
    ch1 := @inp
    ch1[1] ~=== EOF |
        unterminated_string_literal (line_no, column_no,
                                     "end of input")
    ch1[1] ~== "\n" |
        unterminated_string_literal (line_no, column_no,
                                     "end of line")
    if ch1[1] == close_quote then {
      retval := [TOKEN_STRING, s || close_quote, line_no, column_no]
    } else if ch1[1] ~== "\\" then {
      s ||:= ch1[1]
    } else {
      ch2 := @inp
      EOF ~=== ch2[1] | unsupported_escape(line_no, column_no, ch2)
      case ch2[1] of {
        "n" : s ||:= "\\n"
        "\\" : s ||:= "\\\\"
        default : unsupported_escape(line_no, column_no, ch2)
      }
    }
  }
  return retval
end

procedure skip_spaces_and_comments(inp, pushback)
  local ch, ch1

  repeat {
    ch := @inp
    (EOF === ch[1]) & { ch @pushback; return }
    if not any(whitespace, ch[1]) then {
      (ch[1] == "/") | { ch @pushback; return }
      (ch1 := @inp) | { ch @pushback; return }
      (ch1[1] == "*") | { ch1 @pushback; ch @pushback; return }
      scan_comment(inp, ch[2], ch[3])
    }
  }
end

procedure scan_comment(inp, line_no, column_no)
  local ch, ch1

  until (\ch)[1] == "*" & (\ch1)[1] == "/" do {
    ch := @inp
    (EOF === ch[1]) & unterminated_comment(line_no, column_no)
    if ch[1] == "*" then {
      ch1 := @inp
      (EOF === ch1[1]) & unterminated_comment(line_no, column_no)
    }
  }
  return
end

procedure reserved_word_lookup(s, line_no, column_no)

  # Lookup is by an extremely simple perfect hash.

  static reserved_words
  static reserved_word_tokens
  local hashval, token, toktup

  initial {
    reserved_words := ["if", "print", "else",
                       "", "putc", "",
                       "", "while", ""]
    reserved_word_tokens :=
        [TOKEN_IF, TOKEN_PRINT, TOKEN_ELSE,
         TOKEN_IDENTIFIER, TOKEN_PUTC, TOKEN_IDENTIFIER,
         TOKEN_IDENTIFIER, TOKEN_WHILE, TOKEN_IDENTIFIER]
  }

  if *s < 2 then {
    toktup := [TOKEN_IDENTIFIER, s, line_no, column_no]
  } else {
    hashval := ((ord(s[1]) + ord(s[2])) % (*reserved_words)) + 1
    token := reserved_word_tokens[hashval]
    if token = TOKEN_IDENTIFIER | s ~== reserved_words[hashval] then {
      toktup := [TOKEN_IDENTIFIER, s, line_no, column_no]
    } else {
      toktup := [token, s, line_no, column_no]
    }
  }
  return toktup
end

procedure print_token(outf, toktup)
  static token_names
  local s_line, s_column

  initial {
    token_names := ["Keyword_else",
                    "Keyword_if",
                    "Keyword_print",
                    "Keyword_putc",
                    "Keyword_while",
                    "Op_multiply",
                    "Op_divide",
                    "Op_mod",
                    "Op_add",
                    "Op_subtract",
                    "Op_negate",
                    "Op_less",
                    "Op_lessequal",
                    "Op_greater",
                    "Op_greaterequal",
                    "Op_equal",
                    "Op_notequal",
                    "Op_not",
                    "Op_assign",
                    "Op_and",
                    "Op_or",
                    "LeftParen",
                    "RightParen",
                    "LeftBrace",
                    "RightBrace",
                    "Semicolon",
                    "Comma",
                    "Identifier",
                    "Integer",
                    "String",
                    "End_of_input"]
  }

  /outf := &output
  s_line := string(toktup[3])
  s_column := string(toktup[4])
  writes(outf, right (s_line, max(5, *s_line)))
  writes(outf, " ")
  writes(outf, right (s_column, max(5, *s_column)))
  writes(outf, "  ")
  writes(outf, token_names[toktup[1] + 1])
  case toktup[1] of {
    TOKEN_IDENTIFIER : writes(outf, "     ", toktup[2])
    TOKEN_INTEGER : writes(outf, "        ", toktup[2])
    TOKEN_STRING : writes(outf, "         ", toktup[2])
  }
  write(outf)
  return
end

procedure inputter(inpf, pushback_buffer)
  local buffer
  local line_no, column_no
  local c

  buffer := ""
  line_no := 1
  column_no := 1

  repeat {
      buffer? {
        until *pushback_buffer = 0 & pos(0) do {
          if *pushback_buffer ~= 0 then {
            suspend pop(pushback_buffer)
          } else {
            c := move(1)
            suspend [c, line_no, column_no]
            if c == "\n" then {
              line_no +:= 1
              column_no := 1
            } else {
              column_no +:= 1
            }
          }
        }
      }
      (buffer := reads(inpf, 2048)) |
          suspend [EOF, line_no, column_no]
    }
end

procedure unterminated_comment(line_no, column_no)
  error("unterminated comment starting at ",
        line_no, ":", column_no)
end

procedure unexpected_character(line_no, column_no, ch)
  error("unexpected character '", ch[1], "' starting at ",
        line_no, ":", column_no)
end

procedure unterminated_string_literal (line_no, column_no, cause)
  error("unterminated string literal (", cause, ") starting at ",
        line_no, ":", column_no)
end

procedure unsupported_escape (line_no, column_no, ch)
  if ch[1] === EOF then {
    error("unexpected \\ at end of input",
          " starting at ", line_no, ":", column_no)
  } else {
    error("unsupported escape \\", ch[1],
          " starting at ", line_no, ":", column_no)
  }
end

procedure invalid_integer_literal(line_no, column_no, s)
  error("invalid integer literal ", s,
        " starting at ", line_no, ":", column_no)
end

procedure unterminated_character_literal(line_no, column_no)
  error("unterminated character literal starting at ",
        line_no, ":", column_no)
end

procedure multicharacter_literal(line_no, column_no)
  error("unsupported multicharacter literal starting at ",
        line_no, ":", column_no)
end

procedure error(args[])
  write!([&errout] ||| args)
  exit(1)
end

procedure max(x, y)
  return (if x < y then y else x)
end


use strict;
use warnings;

use Imager;

my $img = Imager->new;
$img->read(file => 'frog.png');
my $img16 = $img->to_paletted({ max_colors => 16});
$img16->write(file => "frog-16.png")


-- demo\rosetta\Color_quantization.exw
include pGUI.e

function makeCluster(sequence pixels)
    sequence rs = vslice(pixels,1),
             gs = vslice(pixels,2),
             bs = vslice(pixels,3)
    integer n = length(pixels),
            rd = max(rs)-min(rs),
            gd = max(gs)-min(gs),
            bd = max(bs)-min(bs)
    atom score = n*rd*gd*bd
--  atom score = n*(rd+gd+bd)  -- (this is how/where to experiment)
    sequence centroid = sq_round({sum(rs)/n,sum(gs)/n,sum(bs)/n}),
             ranges = {rd,gd,bd}
    return {score,centroid,ranges,pixels}
end function

function colorQuant(imImage img, integer n)
integer width = im_width(img),
        height = im_width(img)
    -- Extract the original pixels from the image
    sequence original = {}
    integer dx = 1
    for y=height-1 to 0 by -1 do
        for x=0 to width-1 do
            original = append(original,im_pixel(img, x, y)&dx)
            dx += 1
        end for
    end for
    -- Divide pixels into clusters
    sequence cs = {makeCluster(original)}, unsplittable={}, centroid, volume, pixels
    while length(cs)<n do
        cs = sort(cs)
--      cs = reverse(sort(cs)) -- (to deliberately show a much worse result)
        {?,centroid,volume,pixels} = cs[$]
        integer {vr,vg,vb} = volume
        integer pdx = iff(vr>vg and vr>vb?1:iff(vg>vb?2:3)),
                c = centroid[pdx] -- (ie r=1, g=2, b=3)
        sequence p1 = {}, p2 = {}
        for i=1 to length(pixels) do
            sequence p = pixels[i]
            if p[pdx]<c then p1 = append(p1,p) else p2 = append(p2,p) end if
        end for
        if length(p1) and length(p2) then
            cs[$] = makeCluster(p1)
            cs = append(cs,makeCluster(p2))
        else
            ?"unsplittable"
            unsplittable = append(unsplittable,cs[$])
            cs = cs[1..$-1]
            n -= 1
        end if
    end while
    cs &= unsplittable
    -- substitute all pixels with the centroid (aka cluster average)
    for i=1 to length(cs) do
        {?,centroid,?,pixels} = cs[i]
        for p=1 to length(pixels) do
            dx = pixels[p][4]
            original[dx] = centroid
        end for
    end for
    original = flatten(original) -- (needed for IupImageRGB)
    Ihandle new_img = IupImageRGB(width, height, original)
    return new_img
end function

IupOpen()

atom pError = allocate(machine_word())
imImage im1 = imFileImageLoadBitmap("Quantum_frog.png",0,pError)
if im1=NULL then ?"error opening Quantum_frog.png" abort(0) end if
-- stolen from simple_paint (else im_pixel crashed):
-- we are going to support only RGB images with no alpha
imImageRemoveAlpha(im1)
if im_color_space(im1)!=IM_RGB then
    imImage new_image = imImageCreateBased(im1, -1, -1, IM_RGB, -1)
    imConvertColorSpace(im1, new_image)
    im1 = imImageDestroy(im1)
    im1 = new_image
end if

Ihandln image1 = IupImageFromImImage(im1),
        image2 = colorQuant(im1,16),
        label1 = IupLabel(),
        label2 = IupLabel()
IupSetAttributeHandle(label1, "IMAGE", image1)
IupSetAttributeHandle(label2, "IMAGE", image2)

Ihandle dlg = IupDialog(IupHbox({label1, label2}))
IupSetAttribute(dlg, "TITLE", "Color quantization")
IupShow(dlg)

IupMainLoop()
IupClose()


; ColorQuantization.pb

Structure bestA_ ; table for our histogram
nn.i ; 16,32,...
rc.i ; red   count within (0,1,...,255)/(number of colors)
gc.i ; green count within (0,1,...,255)/(number of colors)
bc.i ; blue  count within (0,1,...,255)/(number of colors)
EndStructure

; these two functions appear to be rather self-explanatory
UsePNGImageDecoder()
UsePNGImageEncoder()

Procedure.i ColorQuantization(Filename$,ncol)
Protected x,y,c

; load our original image or leave the procedure
If not LoadImage(0,Filename$)      :ProcedureReturn 0:endif

; we are not going to actually draw on the original image...
; but we need to use the drawing library to load up
; the pixel information into our arrays...
; if we can't do that, what's the point of going any further?
; so then we would be wise to just leave the procedure [happy fred?]
If not StartDrawing(ImageOutput(0)):ProcedureReturn 0:endif

iw=ImageWidth(0)
ih=ImageHeight(0)

dim cA(iw,ih) ; color array to hold at a given (x,y)
dim rA(iw,ih) ; red   array to hold at a given (x,y)
dim gA(iw,ih) ; green array to hold at a given (x,y)
dim bA(iw,ih) ; blue  array to hold at a given (x,y)
dim tA(iw,ih) ; temp  array to hold at a given (x,y)

; map each pixel from the original image to our arrays
; don't overrun the ranges ie. use {ih-1,iw-1}
for y=0 to ih-1
  for x=0 to iw-1
  c = Point(x,y)
  cA(x,y)=c
  rA(x,y)=Red(c)
  gA(x,y)=Green(c)
  bA(x,y)=Blue(c)
  next
next

StopDrawing() ; don't forget to... StopDrawing()

N=ih*iw
; N is the total number if pixels
if not N:ProcedureReturn 0:endif ; to avoid a division by zero

; stuctured array ie. a table to hold the frequency distribution
dim bestA.bestA_(ncol)

; the "best" red,green,blue based upon frequency
dim rbestA(ncol/3)
dim gbestA(ncol/3)
dim bbestA(ncol/3)

; split the (0..255) range up
xoff=256/ncol   ;256/16=16
xrng=xoff       ;xrng=16

; store these values in our table: bestA(i)\nn= 16,32,...
for i=1 to ncol
xrng+xoff
bestA(i)\nn=xrng
next

; scan by row [y]
for y=0 to ih-1
; scan by col [x]
for x=0 to iw-1

; retrieve the rgb values from each pixel
r=rA(x,y)
g=gA(x,y)
b=bA(x,y)

; sum up the numbers that fall within our subdivisions of (0..255)
for i=1 to ncol
if r>=bestA(i)\nn and r<bestA(i+1)\nn:bestA(i)\rc+1:endif
if g>=bestA(i)\nn and g<bestA(i+1)\nn:bestA(i)\gc+1:endif
if b>=bestA(i)\nn and b<bestA(i+1)\nn:bestA(i)\bc+1:endif
next
next
next

; option and type to: Sort our Structured Array
opt=#PB_Sort_Descending
typ=#PB_Sort_Integer

; sort to get most frequent reds
off=OffsetOf(bestA_\rc)
SortStructuredArray(bestA(),opt, off, typ,1, ncol)

; save the best [ for number of colors =16 this is int(16/3)=5 ] reds
for i=1 to ncol/3
rbestA(i)=bestA(i)\nn
next

; sort to get most frequent greens
off=OffsetOf(bestA_\gc)
SortStructuredArray(bestA(),opt, off, typ,1, ncol)

; save the best [ for number of colors =16 this is int(16/3)=5 ] greens
for i=1 to ncol/3
gbestA(i)=bestA(i)\nn
next

; sort to get most frequent blues
off=OffsetOf(bestA_\bc)
SortStructuredArray(bestA(),opt, off, typ,1, ncol)

; save the best [ for number of colors =16 this is int(16/3)=5 ] blues
for i=1 to ncol/3
bbestA(i)=bestA(i)\nn
next

; reset the best low value to 15 and high value to 240
; this helps to ensure there is some contrast when the statistics bunch up
; ie. when a single color tends to predominate... such as perhaps green?
rbestA(1)=15:rbestA(ncol/3)=240
gbestA(1)=15:gbestA(ncol/3)=240
bbestA(1)=15:bbestA(ncol/3)=240

; make a copy of our original image or leave the procedure
If not CopyImage(0,1)              :ProcedureReturn 0:endif

; draw on that copy of our original image or leave the procedure
If not StartDrawing(ImageOutput(1)):ProcedureReturn 0:endif

for y=0 to ih-1
for x=0 to iw-1
c = Point(x,y)

; get the rgb value from our arrays
rt=rA(x,y)
gt=gA(x,y)
bt=bA(x,y)

; given a particular red value say 123 at point x,y
; which of our rbestA(i's) is closest?
; then for green and blue?
; ==============================
r=255
for i=1 to ncol/3
rdiff=abs(rbestA(i)-rt)
if rdiff<=r:ri=i:r=rdiff:endif
next

g=255
for i=1 to ncol/3
gdiff=abs(gbestA(i)-gt)
if gdiff<=g:gi=i:g=gdiff:endif
next

b=255
for i=1 to ncol/3
bdiff=abs(bbestA(i)-bt)
if bdiff<=b:bi=i:b=bdiff:endif
next
; ==============================

; get the color value so we can plot it at that pixel
Color=RGB(rbestA(ri),gbestA(gi),bbestA(bi))

; plot it at that pixel
Plot(x,y,Color)

; save that info to tA(x,y) for our comparison image
tA(x,y)=Color

next
next
StopDrawing() ; don't forget to... StopDrawing()

; create a comparison image of our original vs 16-color or leave the procedure
If not CreateImage(2,iw*2,ih)      :ProcedureReturn 0:endif
; draw on that image both our original image and our 16-color image or leave the procedure
If not StartDrawing(ImageOutput(2)):ProcedureReturn 0:endif

; plot original image
; 0,0 .... 511,0
; .
; .
; 511,0 .. 511,511
for y=0 to ih-1
  for x=0 to iw-1
  c = cA(x,y)
  Plot(x,y,c)
  next
  next

; plot 16-color image to the right of original image
; 512,0 .... 1023,0
; .
; .
; 512,511 .. 1023,511
for y=0 to ih-1
  for x=0 to iw-1
  c = tA(x,y)
  Plot(x+iw,y,c)
  next
  next

StopDrawing() ; don't forget to... StopDrawing()

; save the single 16-color image
SaveImage(1, "_single_"+str(ncol)+"_"+Filename$,#PB_ImagePlugin_PNG )

; save the comparison image
SaveImage(2, "_compare_"+str(ncol)+"_"+Filename$,#PB_ImagePlugin_PNG )
ProcedureReturn 1
EndProcedure

ColorQuantization("Quantum_frog.png",16)


symbols=:256#0
ch=: {{1 0+x[symbols=: x (a.i.y)} symbols}}
'T0 token'  =: 0 ch '%+-!(){};,<>=!|&'
'L0 letter' =: 1 ch '_',,u:65 97+/i.26
'D0 digit'  =: 2 ch u:48+i.10
'S0 space'  =: 3 ch ' ',LF
'C0 commen' =: 4 ch '/'
'C1 comment'=: 5 ch '*'
'q0 quote'  =: 6 ch ''''
'Q0 dquote' =: 7 ch '"'

width=: 1+>./symbols
default=: ,:(1+i.width),every 2
states=:((1+i.width),every 1),width#default
extend=: {{
  if.y>#states do.states=: y{.states,y#default
  end.states
}}
pad=: {{if. 0=#y do.y=.#states end.y}}
function=: {{ NB. x: before, m: op, n: symbol, y: after
  y[states=: (y,m) (<x,n)} extend 1+x>.y=.pad y
}}
{{for_op.y do.(op)=: op_index function end.0}};:'nop init start'
all=: {{y=.pad y
  for_symbol.i.width do.
    x symbol nop y
  end.y
}}
any=: {{y=.pad y
  for_symbol.i.width do.
    x symbol start y
  end.y
}}

NB. identifiers and keywords
     L0  letter nop L0
     L0   digit nop L0

NB. numbers
     D0   digit nop D0
     D0  letter nop D0

NB. white space
     S0   space nop S0

NB. comments
C1=: C0 comment nop ''
C2=: C1         all ''
     C2         all C2
C3=: C2  commen nop ''
C4=: C3 comment nop ''

NB. quoted characters
q1=: q0         any ''

NB. strings
Q1=: Q0         all ''
     Q1         all Q1
Q2=: Q1  dquote nop ''
     Q0  dquote nop Q2

tokenize=:{{
  tok=. (0;states;symbols);:y
  for_fix.cut'<= >= == != && ||'do.
    M=.;:;fix
    for_k.|.I.M E.tok do.
      tok=.(fix,<'') (0 1+k)} tok
    end.
  end.tok-.a:
}}

(tknames=:;: {{)n
 Op_multiply Op_divide Op_mod Op_add Op_subtract Op_less Op_lessequal
 Op_greater Op_greaterequal Op_equal Op_notequal Op_not Op_and Op_or
 Op_assign LeftParen RightParen Keyword_if LeftBrace Keyword_else
 RightBrace Keyword_while Semicolon Keyword_print Comma Keyword_putc
}}-.LF)=: tkref=: tokenize '*/%+-<<=>>===!=!&&||=()if{else}while;print,putc'
NB. the reference tokens here were arranged to avoid whitespace tokens
NB. also, we reserve multiple token instances where a literal string
NB. appears in different syntactic productions. Here, we only use the initial
NB. instances -- the others will be used in the syntax analyzer which
NB. uses the same tkref and tknames,

shift=: |.!.0
numvals=: {{
  ndx=. I.(0<#@>y)**/@> y e.L:0 '0123456789'
  ({{".y,'x'}}each ndx{y) ndx} y
}}
chrvals=: {{
  q=. y=<,''''
  s=. y=<,'\'
  j=. I.(-.s)*(1&shift * _1&shift)q
  k=. I.(y e.;:'\n')*(1 shift q)*(_2 shift q)*_1 shift s
  jvals=. a.i.L:0 j{y      NB. not escaped
  kvals=. (k{s){<"0 a.i.LF,'\' NB. escaped
  (,a:,jvals,:a:) (,_1 0 1+/j)} (,a:,a:,kvals,:a:) (,_2 _1 0 1+/k)} y
}}

validstring=: ((1<#)*('"'={.)*('"'={:)*('\'=])-:'\n'&E.(+._1&shift)@+.'\\'&E.) every

validid=: ((<,'\')~:_1&|.) * (e.&tkref) < (e.&(u:I.symbols=letter)@{. * */@(e.&(u:I.symbols e.letter,digit))@}.) every

lex=: {{
  lineref=.I.y=LF
  tokens=.(tokenize y),<,'_'
  offsets=.0,}:#@;\tokens
  lines=. lineref I.offsets
  columns=. offsets-lines{0,lineref
  keep=. -.({[email protected]> tokens)e.u:I.space=symbols
  names=. (<'End_of_input') _1} (tkref i.tokens) {(_3}.tknames),4#<'Error'
  unknown=. names=<'Error'
  values=. a: _1} unknown#inv  numvals chrvals unknown#tokens
  names=. (<'Integer') (I.(values~:a:)*tokens~:values)} names
  names=. (<'String') (I.validstring tokens)} names
  names=. (<'Identifier') (I.validid tokens)} names
  names=. (<'End_of_input') _1} names
  comments=. '*/'&-:@(_2&{.)@> tokens
  whitespace=. (values=tokens) * e.&(' ',LF)@{[email protected]> tokens
  keep=. (tokens~:<,'''')*-.comments+.whitespace+.unknown*a:=values
  keep&#each ((1+lines),.columns);<names,.values
}}


from PIL import Image

if __name__=="__main__":
	im = Image.open("frog.png")
	im2 = im.quantize(16)
	im2.show()


#lang racket/base
(require racket/class
         racket/draw)

;; This is an implementation of the Octree Quantization algorithm.  This implementation
;; follows the sketch in:
;;
;; Dean Clark.  Color Quantization using Octrees.  Dr. Dobbs Portal, January 1, 1996.
;; http://www.ddj.com/184409805
;;
;; This code is adapted from the color quantizer in the implementation of Racket's
;; file/gif standard library.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; To view an example of the quantizer, run the following test submodule
;; in DrRacket:
(module+ test
  (require racket/block net/url)

  (define frog
    (block
      (define url (string->url "http://rosettacode.org/mw/images/3/3f/Quantum_frog.png"))
      (define frog-ip (get-pure-port url))
      (define bitmap (make-object bitmap% frog-ip))
      (close-input-port frog-ip)
      bitmap))

  ;; Display the original:
  (print frog)
  ;; And the quantized version (16 colors):
  (print (quantize-bitmap frog 16)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; quantize-bitmap: bitmap positive-number -> bitmap
;; Given a bitmap, returns a new bitmap quantized to, at most, n colors.
(define (quantize-bitmap bm n)
  (let* ([width (send bm get-width)]
         [height (send bm get-height)]
         [len (* width height 4)]
         [source-buffer (make-bytes len)]
         [_ (send bm get-argb-pixels 0 0 width height source-buffer)]
         [an-octree (make-octree-from-argb source-buffer n)]
         [dest-buffer (make-bytes len)])
    (let quantize-bitmap-loop ([i 0])
      (when (< i len)
        (let* ([i+1 (+ i 1)]
               [i+2 (+ i 2)]
               [i+3 (+ i 3)]
               [a (bytes-ref source-buffer i)]
               [r (bytes-ref source-buffer i+1)]
               [g (bytes-ref source-buffer i+2)]
               [b (bytes-ref source-buffer i+3)])
          (cond
            [(alpha-opaque? a)
             (let-values ([(new-r new-g new-b)
                           (octree-lookup an-octree r g b)])
               (bytes-set! dest-buffer i 255)
               (bytes-set! dest-buffer i+1 new-r)
               (bytes-set! dest-buffer i+2 new-g)
               (bytes-set! dest-buffer i+3 new-b))]
            [else
             (bytes-set! dest-buffer i 0)
             (bytes-set! dest-buffer i+1 0)
             (bytes-set! dest-buffer i+2 0)
             (bytes-set! dest-buffer i+3 0)]))
        (quantize-bitmap-loop (+ i 4))))
    (let* ([new-bm (make-object bitmap% width height)]
           [dc (make-object bitmap-dc% new-bm)])
      (send dc set-argb-pixels 0 0 width height dest-buffer)
      (send dc set-bitmap #f)
      new-bm)))

;; make-octree-from-argb: bytes positive-number -> octree
;; Constructs an octree ready to quantize the colors from an-argb.
(define (make-octree-from-argb an-argb n)
  (unless (> n 0)
    (raise-type-error 'make-octree-from-argb "positive number" n))
  (let ([an-octree (new-octree)]
        [len (bytes-length an-argb)])
    (let make-octree-loop ([i 0])
      (when (< i len)
        (let ([a (bytes-ref an-argb i)]
              [r (bytes-ref an-argb (+ i 1))]
              [g (bytes-ref an-argb (+ i 2))]
              [b (bytes-ref an-argb (+ i 3))])
          (when (alpha-opaque? a)
            (octree-insert-color! an-octree r g b)
            (let reduction-loop ()
              (when (> (octree-leaf-count an-octree) n)
                (octree-reduce! an-octree)
                (reduction-loop)))))
        (make-octree-loop (+ i 4))))
    (octree-finalize! an-octree)
    an-octree))

;; alpha-opaque? byte -> boolean
;; Returns true if the alpha value is considered opaque.
(define (alpha-opaque? a)
  (>= a 128))

;; The maximum level height of an octree.
(define MAX-LEVEL 7)

;; A color is a (vector byte byte byte)

;; An octree is a:
(define-struct octree (root            ; node
                       leaf-count      ; number
                       reduction-heads ; (vectorof (or/c node #f))
                       palette)        ; (vectorof (or/c color #f))
  #:mutable)
;; reduction-heads is used to accelerate the search for a reduction candidate.

;; A subtree node is a:
(define-struct node (leaf?          ; bool
                     npixels        ; number  -- number of pixels this subtree node represents
                     redsum         ; number
                     greensum       ; number
                     bluesum        ; number
                     children       ; (vectorof (or/c #f node))
                     next           ; (or/c #f node)
                     palette-index) ; (or/c #f byte?)
  #:mutable)
;; node-next is used to accelerate the search for a reduction candidate.

;; new-octree: -> octree
(define (new-octree)
  (let* ([root-node (make-node #f ;; not a leaf
                               0  ;; no pixels under us yet
                               0  ;; red sum
                               0  ;; green sum
                               0  ;; blue sum
                               (make-vector 8 #f) ;; no children so far
                               #f ;; next
                               #f ;; palette-index
                               )]
         [an-octree
          (make-octree root-node
                       0 ; no leaves so far
                       (make-vector (add1 MAX-LEVEL) #f) ; no reductions so far
                       (make-vector 256 #(0 0 0)))])        ; the palette
    ;; Although we'll almost never reduce to this level, initialize the first
    ;; reducible node to the root, for completeness sake.
    (vector-set! (octree-reduction-heads an-octree) 0 root-node)
    an-octree))

;; rgb->index: natural-number byte byte byte -> octet
;; Given a level and an (r,g,b) triplet, returns an octet that can be used
;; as an index into our octree structure.
(define (rgb->index level r g b)
  (bitwise-ior (bitwise-and 4 (arithmetic-shift r (- level 5)))
               (bitwise-and 2 (arithmetic-shift g (- level 6)))
               (bitwise-and 1 (arithmetic-shift b (- level 7)))))

;; octree-insert-color!: octree byte byte byte -> void
;; Accumulates a new r,g,b triplet into the octree.
(define (octree-insert-color! an-octree r g b)
  (node-insert-color! (octree-root an-octree) an-octree r g b 0))

;; node-insert-color!: node octree byte byte byte natural-number -> void
;; Adds a color to the node subtree.  While we hit #f, we create new nodes.
;; If we hit an existing leaf, we accumulate our color into it.
(define (node-insert-color! a-node an-octree r g b level)
  (let insert-color-loop ([a-node a-node]
                          [level level])
    (cond [(node-leaf? a-node)
           ;; update the leaf with the new color
           (set-node-npixels! a-node (add1 (node-npixels a-node)))
           (set-node-redsum! a-node (+ (node-redsum a-node) r))
           (set-node-greensum! a-node (+ (node-greensum a-node) g))
           (set-node-bluesum! a-node (+ (node-bluesum a-node) b))]
          [else
           ;; create the child node if necessary
           (let ([index (rgb->index level r g b)])
             (unless (vector-ref (node-children a-node) index)
               (let ([new-node (make-node (= level MAX-LEVEL) ; leaf?
                                          0  ; npixels
                                          0  ; redsum
                                          0  ; greensum
                                          0  ; bluesum
                                          (make-vector 8 #f) ; no children yet
                                          #f ; and no next node yet
                                          #f ; or palette index
                                          )])
                 (vector-set! (node-children a-node) index new-node)
                 (cond
                   [(= level MAX-LEVEL)
                    ;; If we added a leaf, mark it in the octree.
                    (set-octree-leaf-count! an-octree
                                            (add1 (octree-leaf-count an-octree)))]
                   [else
                    ;; Attach the node as a reducible node if it's interior.
                    (set-node-next!
                     new-node (vector-ref (octree-reduction-heads an-octree)
                                          (add1 level)))
                    (vector-set! (octree-reduction-heads an-octree)
                                 (add1 level)
                                 new-node)])))
             ;; and recur on the child node.
             (insert-color-loop (vector-ref (node-children a-node) index)
                                (add1 level)))])))

;; octree-reduce!: octree -> void
;; Reduces one of the subtrees, collapsing the children into a single node.
(define (octree-reduce! an-octree)
  (node-reduce! (pop-reduction-candidate! an-octree) an-octree))

;; node-reduce!: node octree -> void
;; Reduces the interior node.
(define (node-reduce! a-node an-octree)
  (for ([child (in-vector (node-children a-node))]
        #:when child)
    (set-node-npixels! a-node (+ (node-npixels a-node)
                                 (node-npixels child)))
    (set-node-redsum! a-node (+ (node-redsum a-node)
                                (node-redsum child)))
    (set-node-greensum! a-node (+ (node-greensum a-node)
                                  (node-greensum child)))
    (set-node-bluesum! a-node (+ (node-bluesum a-node)
                                 (node-bluesum child)))
    (set-octree-leaf-count! an-octree (sub1 (octree-leaf-count an-octree))))
  (set-node-leaf?! a-node #t)
  (set-octree-leaf-count! an-octree (add1 (octree-leaf-count an-octree))))

;; find-reduction-candidate!: octree -> node
;; Returns a bottom-level interior node for reduction.  Also takes the
;; candidate out of the conceptual queue of reduction candidates.
(define (pop-reduction-candidate! an-octree)
  (let loop ([i MAX-LEVEL])
    (cond
      [(vector-ref (octree-reduction-heads an-octree) i)
       =>
       (lambda (candidate-node)
         (when (> i 0)
           (vector-set! (octree-reduction-heads an-octree) i
                        (node-next candidate-node)))
         candidate-node)]
      [else
       (loop (sub1 i))])))

;; octree-finalize!: octree -> void
;; Finalization does a few things:
;; * Walks through the octree and reduces any interior nodes with just one leaf child.
;;   Optimizes future lookups.
;; * Fills in the palette of the octree and the palette indexes of the leaf nodes.
;; * Note: palette index 0 is always reserved for the transparent color.
(define (octree-finalize! an-octree)
  ;; Collapse one-leaf interior nodes.
  (let loop ([a-node (octree-root an-octree)])
    (for ([child (in-vector (node-children a-node))]
          #:when (and child (not (node-leaf? child))))
      (loop child)
      (when (interior-node-one-leaf-child? a-node)
        (node-reduce! a-node an-octree))))

  ;; Attach palette entries.
  (let ([current-palette-index 1])
    (let loop ([a-node (octree-root an-octree)])
      (cond [(node-leaf? a-node)
             (let ([n (node-npixels a-node)])
               (vector-set! (octree-palette an-octree) current-palette-index
                            (vector (quotient (node-redsum a-node) n)
                                    (quotient (node-greensum a-node) n)
                                    (quotient (node-bluesum a-node) n)))
               (set-node-palette-index! a-node current-palette-index)
               (set! current-palette-index (add1 current-palette-index)))]
            [else
             (for ([child (in-vector (node-children a-node))]
                   #:when child)
               (loop child))]))))

;; interior-node-one-leaf-child?: node -> boolean
(define (interior-node-one-leaf-child? a-node)
  (let ([child-list (filter values (vector->list (node-children a-node)))])
    (and (= (length child-list) 1)
         (node-leaf? (car child-list)))))

;; octree-lookup: octree byte byte byte -> (values byte byte byte)
;; Returns the palettized color.
(define (octree-lookup an-octree r g b)
  (let* ([index (node-lookup-index (octree-root an-octree) an-octree r g b 0)]
         [vec (vector-ref (octree-palette an-octree) index)])
    (values (vector-ref vec 0)
            (vector-ref vec 1)
            (vector-ref vec 2))))

;; node-lookup-index: node byte byte byte natural-number -> byte
;; Returns the palettized color index.
(define (node-lookup-index a-node an-octree r g b level)
  (let loop ([a-node a-node]
             [level level])
    (if (node-leaf? a-node)
      (node-palette-index a-node)
      (let ([child (vector-ref (node-children a-node) (rgb->index level r g b))])
        (unless child
          (error 'node-lookup-index
                 "color (~a, ~a, ~a) not previously inserted"
                 r g b))
        (loop child (add1 level))))))


use MagickWand;
use MagickWand::Enums;

my $frog = MagickWand.new;
$frog.read("./Quantum_frog.png");
$frog.quantize(16, RGBColorspace, 0, True, False);
$frog.write('./Quantum-frog-16-perl6.png');


// Translated from python source

import java.io.File;
import java.io.FileNotFoundException;
import java.util.HashMap;
import java.util.Map;
import java.util.Scanner;

public class Lexer {
    private int line;
    private int pos;
    private int position;
    private char chr;
    private String s;

    Map<String, TokenType> keywords = new HashMap<>();

    static class Token {
        public TokenType tokentype;
        public String value;
        public int line;
        public int pos;
        Token(TokenType token, String value, int line, int pos) {
            this.tokentype = token; this.value = value; this.line = line; this.pos = pos;
        }
        @Override
        public String toString() {
            String result = String.format("%5d  %5d %-15s", this.line, this.pos, this.tokentype);
            switch (this.tokentype) {
                case Integer:
                    result += String.format("  %4s", value);
                    break;
                case Identifier:
                    result += String.format(" %s", value);
                    break;
                case String:
                    result += String.format(" \"%s\"", value);
                    break;
            }
            return result;
        }
    }

    static enum TokenType {
        End_of_input, Op_multiply,  Op_divide, Op_mod, Op_add, Op_subtract,
        Op_negate, Op_not, Op_less, Op_lessequal, Op_greater, Op_greaterequal,
        Op_equal, Op_notequal, Op_assign, Op_and, Op_or, Keyword_if,
        Keyword_else, Keyword_while, Keyword_print, Keyword_putc, LeftParen, RightParen,
        LeftBrace, RightBrace, Semicolon, Comma, Identifier, Integer, String
    }

    static void error(int line, int pos, String msg) {
        if (line > 0 && pos > 0) {
            System.out.printf("%s in line %d, pos %d\n", msg, line, pos);
        } else {
            System.out.println(msg);
        }
        System.exit(1);
    }

    Lexer(String source) {
        this.line = 1;
        this.pos = 0;
        this.position = 0;
        this.s = source;
        this.chr = this.s.charAt(0);
        this.keywords.put("if", TokenType.Keyword_if);
        this.keywords.put("else", TokenType.Keyword_else);
        this.keywords.put("print", TokenType.Keyword_print);
        this.keywords.put("putc", TokenType.Keyword_putc);
        this.keywords.put("while", TokenType.Keyword_while);

    }
    Token follow(char expect, TokenType ifyes, TokenType ifno, int line, int pos) {
        if (getNextChar() == expect) {
            getNextChar();
            return new Token(ifyes, "", line, pos);
        }
        if (ifno == TokenType.End_of_input) {
            error(line, pos, String.format("follow: unrecognized character: (%d) '%c'", (int)this.chr, this.chr));
        }
        return new Token(ifno, "", line, pos);
    }
    Token char_lit(int line, int pos) {
        char c = getNextChar(); // skip opening quote
        int n = (int)c;
        if (c == '\'') {
            error(line, pos, "empty character constant");
        } else if (c == '\\') {
            c = getNextChar();
            if (c == 'n') {
                n = 10;
            } else if (c == '\\') {
                n = '\\';
            } else {
                error(line, pos, String.format("unknown escape sequence \\%c", c));
            }
        }
        if (getNextChar() != '\'') {
            error(line, pos, "multi-character constant");
        }
        getNextChar();
        return new Token(TokenType.Integer, "" + n, line, pos);
    }
    Token string_lit(char start, int line, int pos) {
        String result = "";
        while (getNextChar() != start) {
            if (this.chr == '\u0000') {
                error(line, pos, "EOF while scanning string literal");
            }
            if (this.chr == '\n') {
                error(line, pos, "EOL while scanning string literal");
            }
            result += this.chr;
        }
        getNextChar();
        return new Token(TokenType.String, result, line, pos);
    }
    Token div_or_comment(int line, int pos) {
        if (getNextChar() != '*') {
            return new Token(TokenType.Op_divide, "", line, pos);
        }
        getNextChar();
        while (true) {
            if (this.chr == '\u0000') {
                error(line, pos, "EOF in comment");
            } else if (this.chr == '*') {
                if (getNextChar() == '/') {
                    getNextChar();
                    return getToken();
                }
            } else {
                getNextChar();
            }
        }
    }
    Token identifier_or_integer(int line, int pos) {
        boolean is_number = true;
        String text = "";

        while (Character.isAlphabetic(this.chr) || Character.isDigit(this.chr) || this.chr == '_') {
            text += this.chr;
            if (!Character.isDigit(this.chr)) {
                is_number = false;
            }
            getNextChar();
        }

        if (text.equals("")) {
            error(line, pos, String.format("identifer_or_integer unrecognized character: (%d) %c", (int)this.chr, this.chr));
        }

        if (Character.isDigit(text.charAt(0))) {
            if (!is_number) {
                error(line, pos, String.format("invalid number: %s", text));
            }
            return new Token(TokenType.Integer, text, line, pos);
        }

        if (this.keywords.containsKey(text)) {
            return new Token(this.keywords.get(text), "", line, pos);
        }
        return new Token(TokenType.Identifier, text, line, pos);
    }
    Token getToken() {
        int line, pos;
        while (Character.isWhitespace(this.chr)) {
            getNextChar();
        }
        line = this.line;
        pos = this.pos;

        switch (this.chr) {
            case '\u0000': return new Token(TokenType.End_of_input, "", this.line, this.pos);
            case '/': return div_or_comment(line, pos);
            case '\'': return char_lit(line, pos);
            case '<': return follow('=', TokenType.Op_lessequal, TokenType.Op_less, line, pos);
            case '>': return follow('=', TokenType.Op_greaterequal, TokenType.Op_greater, line, pos);
            case '=': return follow('=', TokenType.Op_equal, TokenType.Op_assign, line, pos);
            case '!': return follow('=', TokenType.Op_notequal, TokenType.Op_not, line, pos);
            case '&': return follow('&', TokenType.Op_and, TokenType.End_of_input, line, pos);
            case '|': return follow('|', TokenType.Op_or, TokenType.End_of_input, line, pos);
            case '"': return string_lit(this.chr, line, pos);
            case '{': getNextChar(); return new Token(TokenType.LeftBrace, "", line, pos);
            case '}': getNextChar(); return new Token(TokenType.RightBrace, "", line, pos);
            case '(': getNextChar(); return new Token(TokenType.LeftParen, "", line, pos);
            case ')': getNextChar(); return new Token(TokenType.RightParen, "", line, pos);
            case '+': getNextChar(); return new Token(TokenType.Op_add, "", line, pos);
            case '-': getNextChar(); return new Token(TokenType.Op_subtract, "", line, pos);
            case '*': getNextChar(); return new Token(TokenType.Op_multiply, "", line, pos);
            case '%': getNextChar(); return new Token(TokenType.Op_mod, "", line, pos);
            case ';': getNextChar(); return new Token(TokenType.Semicolon, "", line, pos);
            case ',': getNextChar(); return new Token(TokenType.Comma, "", line, pos);

            default: return identifier_or_integer(line, pos);
        }
    }

    char getNextChar() {
        this.pos++;
        this.position++;
        if (this.position >= this.s.length()) {
            this.chr = '\u0000';
            return this.chr;
        }
        this.chr = this.s.charAt(this.position);
        if (this.chr == '\n') {
            this.line++;
            this.pos = 0;
        }
        return this.chr;
    }

    void printTokens() {
        Token t;
        while ((t = getToken()).tokentype != TokenType.End_of_input) {
            System.out.println(t);
        }
        System.out.println(t);
    }
    public static void main(String[] args) {
        if (args.length > 0) {
            try {

                File f = new File(args[0]);
                Scanner s = new Scanner(f);
                String source = " ";
                while (s.hasNext()) {
                    source += s.nextLine() + "\n";
                }
                Lexer l = new Lexer(source);
                l.printTokens();
            } catch(FileNotFoundException e) {
                error(-1, -1, "Exception: " + e.getMessage());
            }
        } else {
            error(-1, -1, "No args");
        }
    }
}


require('Image::Magick')

func quantize_image(n = 16, input, output='output.png') {
    var im = %O<Image::Magick>.new
    im.Read(input)
    im.Quantize(colors => n, dither => 1)    # 1 = None
    im.Write(output)
}

quantize_image(input: 'Quantum_frog.png')


package require Tcl 8.6
package require Tk

proc makeCluster {pixels} {
    set rmin [set rmax [lindex $pixels 0 0]]
    set gmin [set gmax [lindex $pixels 0 1]]
    set bmin [set bmax [lindex $pixels 0 2]]
    set rsum [set gsum [set bsum 0]]
    foreach p $pixels {
	lassign $p r g b
	if {$r<$rmin} {set rmin $r} elseif {$r>$rmax} {set rmax $r}
	if {$g<$gmin} {set gmin $g} elseif {$g>$gmax} {set gmax $g}
	if {$b<$bmin} {set bmin $b} elseif {$b>$bmax} {set bmax $b}
	incr rsum $r
	incr gsum $g
	incr bsum $b
    }
    set n [llength $pixels]
    list [expr {double($n)*($rmax-$rmin)*($gmax-$gmin)*($bmax-$bmin)}] \
	[list [expr {$rsum/$n}] [expr {$gsum/$n}] [expr {$bsum/$n}]] \
	[list [expr {$rmax-$rmin}] [expr {$gmax-$gmin}] [expr {$bmax-$bmin}]] \
	$pixels
}

proc colorQuant {img n} {
    set width  [image width  $img]
    set height [image height $img]
    # Extract the pixels from the image
    for {set x 0} {$x < $width} {incr x} {
	for {set y 0} {$y < $height} {incr y} {
	    lappend pixels [$img get $x $y]
	}
    }
    # Divide pixels into clusters
    for {set cs [list [makeCluster $pixels]]} {[llength $cs] < $n} {} {
	set cs [lsort -real -index 0 $cs]
	lassign [lindex $cs end] score centroid volume pixels
	lassign $centroid cr cg cb
	lassign $volume vr vg vb
	while 1 {
	    set p1 [set p2 {}]
	    if {$vr>$vg && $vr>$vb} {
		foreach p $pixels {
		    if {[lindex $p 0]<$cr} {lappend p1 $p} {lappend p2 $p}
		}
	    } elseif {$vg>$vb} {
		foreach p $pixels {
		    if {[lindex $p 1]<$cg} {lappend p1 $p} {lappend p2 $p}
		}
	    } else {
		foreach p $pixels {
		    if {[lindex $p 2]<$cb} {lappend p1 $p} {lappend p2 $p}
		}
	    }
	    if {[llength $p1] && [llength $p2]} break
	    # Partition failed! Perturb partition point away from the centroid and try again
	    set cr [expr {$cr + 20*rand() - 10}]
	    set cg [expr {$cg + 20*rand() - 10}]
	    set cb [expr {$cb + 20*rand() - 10}]
	}
	set cs [lreplace $cs end end [makeCluster $p1] [makeCluster $p2]]
    }
    # Produce map from pixel values to quantized values
    foreach c $cs {
	set centroid [format "#%02x%02x%02x" {*}[lindex $c 1]]
	foreach p [lindex $c end] {
	    set map($p) $centroid
	}
    }
    # Remap the source image
    set newimg [image create photo -width $width -height $height]
    for {set x 0} {$x < $width} {incr x} {
	for {set y 0} {$y < $height} {incr y} {
	    $newimg put $map([$img get $x $y]) -to $x $y
	}
    }
    return $newimg
}


/*
    Token: type, value, line, pos
*/

const TokenType = {
    Keyword_if: 1, Keyword_else: 2, Keyword_print: 3, Keyword_putc: 4, Keyword_while: 5,
    Op_add: 6, Op_and: 7, Op_assign: 8, Op_divide: 9, Op_equal: 10, Op_greater: 11,
    Op_greaterequal: 12, Op_less: 13, Op_Lessequal: 14, Op_mod: 15, Op_multiply: 16, Op_not: 17,
    Op_notequal: 18, Op_or: 19, Op_subtract: 20,
    Integer: 21, String: 22, Identifier: 23,
    Semicolon: 24, Comma: 25,
    LeftBrace: 26, RightBrace: 27,
    LeftParen: 28, RightParen: 29,
    End_of_input: 99
}

class Lexer {
    constructor(source) {
        this.source = source
        this.pos = 1        // position in line
        this.position = 0   // position in source
        this.line = 1
        this.chr = this.source.charAt(0)
        this.keywords = {
            "if": TokenType.Keyword_if,
            "else": TokenType.Keyword_else,
            "print": TokenType.Keyword_print,
            "putc": TokenType.Keyword_putc,
            "while": TokenType.Keyword_while
        }
    }
    getNextChar() {
        this.pos++
        this.position++

        if (this.position >= this.source.length) {
            this.chr = undefined
            return this.chr
        }
        this.chr = this.source.charAt(this.position)
        if (this.chr === '\n') {
            this.line++
            this.pos = 0
        }
        return this.chr
    }
    error(line, pos, message) {
        if (line > 0 && pos > 0) {
            console.log(message + " in line " + line + ", pos " + pos + "\n")
        } else {
            console.log(message)
        }
        process.exit(1)
    }
    follow(expect, ifyes, ifno, line, pos) {
        if (this.getNextChar() === expect) {
            this.getNextChar()
            return { type: ifyes, value: "", line, pos }
        }
        if (ifno === TokenType.End_of_input) {
            this.error(line, pos, "follow: unrecognized character: (" + this.chr.charCodeAt(0) + ") '" + this.chr + "'")
        }
        return { type: ifno, value: "", line, pos }
    }
    div_or_comment(line, pos) {
        if (this.getNextChar() !== '*') {
            return { type: TokenType.Op_divide, value: "/", line, pos }
        }
        this.getNextChar()
        while (true) {
            if (this.chr === '\u0000') {
                this.error(line, pos, "EOF in comment")
            } else if (this.chr === '*') {
                if (this.getNextChar() === '/') {
                    this.getNextChar()
                    return this.getToken()
                }
            } else {
                this.getNextChar()
            }
        }
    }
    char_lit(line, pos) {
        let c = this.getNextChar() // skip opening quote
        let n = c.charCodeAt(0)
        if (c === "\'") {
            this.error(line, pos, "empty character constant")
        } else if (c === "\\") {
            c = this.getNextChar()
            if (c == "n") {
                n = 10
            } else if (c === "\\") {
                n = 92
            } else {
                this.error(line, pos, "unknown escape sequence \\" + c)
            }
        }
        if (this.getNextChar() !== "\'") {
            this.error(line, pos, "multi-character constant")
        }
        this.getNextChar()
        return { type: TokenType.Integer, value: n, line, pos }
    }
    string_lit(start, line, pos) {
        let value = ""
        while (this.getNextChar() !== start) {
            if (this.chr === undefined) {
                this.error(line, pos, "EOF while scanning string literal")
            }
            if (this.chr === "\n") {
                this.error(line, pos, "EOL while scanning string literal")
            }
            value += this.chr
        }
        this.getNextChar()
        return { type: TokenType.String, value, line, pos }
    }
    identifier_or_integer(line, pos) {
        let is_number = true
        let text = ""

        while (/\w/.test(this.chr) || this.chr === '_') {
            text += this.chr
            if (!/\d/.test(this.chr)) {
                is_number = false
            }
            this.getNextChar()
        }
        if (text === "") {
            this.error(line, pos, "identifer_or_integer unrecopgnized character: follow: unrecognized character: (" + this.chr.charCodeAt(0) + ") '" + this.chr + "'")
        }

        if (/\d/.test(text.charAt(0))) {
            if (!is_number) {
                this.error(line, pos, "invaslid number: " + text)
            }
            return { type: TokenType.Integer, value: text, line, pos }
        }

        if (text in this.keywords) {
            return { type: this.keywords[text], value: "", line, pos }
        }
        return { type: TokenType.Identifier, value: text, line, pos }
    }
    getToken() {
        let pos, line
        // Ignore whitespaces
        while (/\s/.test(this.chr)) { this.getNextChar() }
        line = this.line; pos = this.pos
        switch (this.chr) {
            case undefined: return { type: TokenType.End_of_input, value: "", line: this.line, pos: this.pos }
            case "/":       return this.div_or_comment(line, pos)
            case "\'":      return this.char_lit(line, pos)
            case "\"":      return this.string_lit(this.chr, line, pos)

            case "<":       return this.follow("=", TokenType.Op_lessequal, TokenType.Op_less, line, pos)
            case ">":       return this.follow("=", TokenType.Op_greaterequal, TokenType.Op_greater, line, pos)
            case "=":       return this.follow("=", TokenType.Op_equal, TokenType.Op_assign, line, pos)
            case "!":       return this.follow("=", TokenType.Op_notequal, TokenType.Op_not, line, pos)
            case "&":       return this.follow("&", TokenType.Op_and, TokenType.End_of_input, line, pos)
            case "|":       return this.follow("|", TokenType.Op_or, TokenType.End_of_input, line, pos)

            case "{":       this.getNextChar(); return { type: TokenType.LeftBrace, value: "{", line, pos }
            case "}":       this.getNextChar(); return { type: TokenType.RightBrace, value: "}", line, pos }
            case "(":       this.getNextChar(); return { type: TokenType.LeftParen, value: "(", line, pos }
            case ")":       this.getNextChar(); return { type: TokenType.RightParen, value: ")", line, pos }
            case "+":       this.getNextChar(); return { type: TokenType.Op_add, value: "+", line, pos }
            case "-":       this.getNextChar(); return { type: TokenType.Op_subtract, value: "-", line, pos }
            case "*":       this.getNextChar(); return { type: TokenType.Op_multiply, value: "*", line, pos }
            case "%":       this.getNextChar(); return { type: TokenType.Op_mod, value: "%", line, pos }
            case ";":       this.getNextChar(); return { type: TokenType.Semicolon, value: ";", line, pos }
            case ",":       this.getNextChar(); return { type: TokenType.Comma, value: ",", line, pos }

            default:        return this.identifier_or_integer(line, pos)
        }
    }
    /*
    https://stackoverflow.com/questions/9907419/how-to-get-a-key-in-a-javascript-object-by-its-value
    */
    getTokenType(value) {
        return Object.keys(TokenType).find(key => TokenType[key] === value)
    }
    printToken(t) {
        let result = ("     " + t.line).substr(t.line.toString().length)
        result += ("       " + t.pos).substr(t.pos.toString().length)
        result += (" " + this.getTokenType(t.type) + "           ").substr(0, 16)
        switch (t.type) {
            case TokenType.Integer:
                result += "  " + t.value
                break;
            case TokenType.Identifier:
                result += " " + t.value
                break;
            case TokenType.String:
                result += " \""+ t.value + "\""
                break;
        }
        console.log(result)
    }
    printTokens() {
        let t
        while ((t = this.getToken()).type !== TokenType.End_of_input) {
            this.printToken(t)
        }
        this.printToken(t)
    }
}
const fs = require("fs")
fs.readFile(process.argv[2], "utf8", (err, data) => {
    l = new Lexer(data)
    l.printTokens()
})


import "dome" for Window
import "graphics" for Canvas, Color, ImageData
import "./dynamic" for Struct
import "./sort" for Sort

var QItem = Struct.create("QItem", ["color", "index"])

var ColorsUsed = []

class ColorQuantization {
    construct new(filename, filename2) {
        Window.title = "Color quantization"
        _image = ImageData.loadFromFile(filename)
        _w = _image.width
        _h = _image.height
        Window.resize(_w * 2 + 20, _h + 30)
        Canvas.resize(_w * 2 + 20, _h + 30)

        // draw original image on left half of canvas
        _image.draw(0, 0)
        Canvas.print(filename, _w/4, _h + 10, Color.white)

        // create ImageData object for the quantized image
        _qImage = ImageData.create(filename2, _w, _h)
        _qFilename = filename2
    }

    init() {
        // build the first bucket
        var bucket = List.filled(_w * _h, null)
        for (x in 0..._w) {
            for (y in 0..._h) {
                var idx = x * _w + y
                bucket[idx] = QItem.new(_image.pget(x, y), idx)
            }
        }
        var output = List.filled(_w * _h, Color.black)

        // launch the quantization
        medianCut(bucket, 4, output)

        // load the result into the quantized ImageData object
        for (x in 0..._w) {
            for (y in 0..._h) {
                _qImage.pset(x, y, output[x *_w + y])
            }
        }

        // draw the quantized image on right half of canvas
        _qImage.draw(_w + 20, 0)
        Canvas.print(_qFilename, _w * 5/4 + 20, _h + 10, Color.white)

        // save it to a file
        _qImage.saveToFile(_qFilename)

        // print colors used to terminal
        System.print("The 16 colors used in R, G, B format are:")
        for (c in ColorsUsed) {
            System.print("(%(c.r), %(c.g), %(c.b))")
        }
    }

    // apply the quantization to the colors in the bucket
    quantize(bucket, output) {
        // compute the mean value on each RGB component
        var means = List.filled(3, 0)
        for (q in bucket) {
            var i = 0
            for (val in [q.color.r, q.color.g, q.color.b]) {
                means[i] = means[i] + val
                i = i + 1
            }
        }
        for (i in 0..2) {
            means[i] = (means[i]/bucket.count).floor
        }
        var c = Color.rgb(means[0], means[1], means[2])
        ColorsUsed.add(c)

        // store the new color in the output list
        for (q in bucket) output[q.index] = c
    }

    // apply the algorithm to the bucket of colors
    medianCut(bucket, depth, output) {
        if (depth == 0) {  // terminated for this bucket, apply the quantization
            quantize(bucket, output)
            return
        }

        // compute the range of values for each RGB component
        var minVal = [1000, 1000, 1000]
        var maxVal = [-1, -1, -1]
        for (q in bucket) {
            var i = 0
            for (val in [q.color.r, q.color.g, q.color.b]) {
                if (val < minVal[i]) minVal[i] = val
                if (val > maxVal[i]) maxVal[i] = val
                i = i + 1
            }
        }
        var valRange = [maxVal[0] - minVal[0], maxVal[1] - minVal[1], maxVal[2] - minVal[2]]

        // find the RGB component with the greatest range
        var greatest = 0
        if (valRange[1] > valRange[0]) greatest = 1
        if (valRange[2] > greatest) greatest = 2
        // sort the quantization items according to the greatest
        var cmp
        if (greatest == 0) {
            cmp = Fn.new { |i, j|
                var t = (i.color.r - j.color.r).sign
                if (t != 0) return t
                return (i.index - j.index).sign
            }
        } else if (greatest == 1) {
            cmp = Fn.new { |i, j|
                var t = (i.color.g - j.color.g).sign
                if (t != 0) return t
                return (i.index - j.index).sign
            }
        } else {
            cmp = Fn.new { |i, j|
                var t = (i.color.b - j.color.b).sign
                if (t != 0) return t
                return (i.index - j.index).sign
            }
        }
        Sort.quick(bucket, 0, bucket.count-1, cmp)
        var medianIndex = ((bucket.count-1)/2).floor
        medianCut(bucket[0...medianIndex], depth - 1, output)
        medianCut(bucket[medianIndex..-1], depth - 1, output)
    }

    update() {}

    draw(alpha) {}
}

var Game = ColorQuantization.new("Quantum_frog.png", "Quantum_frog_16.png")


struct Tokenized
    startline::Int
    startcol::Int
    name::String
    value::Union{Nothing, Int, String}
end

const optokens = Dict("*" => "Op_multiply", "/" => "Op_divide", "%" => "Op_mod", "+" => "Op_add",
                      "-" => "Op_subtract", "!" => "Op_not", "<" => "Op_less", "<=" => "Op_lessequal",
                      ">" => "Op_greater", ">=" => "Op_greaterequal", "==" => "Op_equal", "!=" => "Op_notequal",
                      "!" => "Op_not", "=" => "Op_assign", "&&" => "Op_and", "||" => "Op_or")

const keywordtokens = Dict("if" => "Keyword_if", "else" => "Keyword_else", "while" => "Keyword_while",
                           "print" => "Keyword_print", "putc" => "Keyword_putc")

const symboltokens = Dict("(" => "LeftParen", ")" => "RightParen", "{" => "LeftBrace",
                          "}" => "RightBrace", ";" => "Semicolon", "," => "Comma")

const errors = ["Empty character constant.", "Unknown escape sequence.", "Multi-character constant.",
                "End-of-file in comment. Closing comment characters not found.",
                "End-of-file while scanning string literal. Closing string character not found.",
                "End-of-line while scanning string literal. Closing string character not found before end-of-line.",
                "Unrecognized character.", "Invalid number. Starts like a number, but ends in non-numeric characters."]

asws(s) = (nnl = length(findall(x->x=='\n', s)); " " ^ (length(s) - nnl) * "\n" ^ nnl)
comment2ws(t) = (while occursin("/*", t) t = replace(t, r"\/\* .+? (?: \*\/)"xs => asws; count = 1) end; t)
hasinvalidescapes(t) = ((m = match(r"\\.", t)) != nothing && m.match != "\\\\" && m.match != "\\n")
hasemptycharconstant(t) = (match(r"\'\'", t) != nothing)
hasmulticharconstant(t) = ((m = match(r"\'[^\'][^\']+\'", t)) != nothing && m.match != "\'\\\\\'" && m.match != "\'\\n\'")
hasunbalancedquotes(t) = isodd(length(findall(x -> x == '\"', t)))
hasunrecognizedchar(t) = match(r"[^\w\s\d\*\/\%\+\-\<\>\=\!\&\|\(\)\{\}\;\,\"\'\\]", t) != nothing

function throwiferror(line, n)
    if hasemptycharconstant(line)
        throw("Tokenizer error line $n: " * errors[1])
    end
    if hasinvalidescapes(line)
        throw("Tokenizer error line $n: " * errors[2])
    end
    if hasmulticharconstant(line)
    println("error at ", match(r"\'[^\'][^\']+\'", line).match)
        throw("Tokenizer error line $n: " * errors[3])
    end
    if occursin("/*", line)
        throw("Tokenizer error line $n: " * errors[4])
    end
    if hasunrecognizedchar(line)
        throw("Tokenizer error line $n: " * errors[7])
    end
end

function tokenize(txt)
    tokens = Vector{Tokenized}()
    txt = comment2ws(txt)
    lines = split(txt, "\n")
    if hasunbalancedquotes(txt)
        throw("Tokenizer error: $(errors[5])")
    end
    for (startline, line) in enumerate(lines)
        if strip(line) == ""
            continue
        end
        throwiferror(line, startline)
        lastc = Char(0)
        withintoken = 0
        for (startcol, c) in enumerate(line)
            if withintoken > 0
                withintoken -= 1
                continue
            elseif isspace(c[1])
                continue
            elseif (c == '=') && (startcol > 1) && ((c2 = line[startcol - 1]) in ['<', '>', '=', '!'])
                    tokens[end] = Tokenized(startline, startcol - 1, optokens[c2 * c], nothing)
            elseif (c == '&') || (c == '|')
                if length(line) > startcol && line[startcol + 1] == c
                    push!(tokens, Tokenized(startline, startcol, optokens[c * c], nothing))
                    withintoken = 1
                else
                    throw("Tokenizer error line $startline: $(errors[7])")
                end
            elseif haskey(optokens, string(c))
                push!(tokens, Tokenized(startline, startcol, optokens[string(c)], nothing))
            elseif haskey(symboltokens, string(c))
                push!(tokens, Tokenized(startline, startcol, symboltokens[string(c)], nothing))
            elseif isdigit(c)
                integerstring = match(r"^\d+", line[startcol:end]).match
                pastnumposition = startcol + length(integerstring)
                if (pastnumposition <= length(line)) && isletter(line[pastnumposition])
                    throw("Tokenizer error line $startline: " * errors[8])
                end
                i = parse(Int, integerstring)
                push!(tokens, Tokenized(startline, startcol, "Integer", i))
                withintoken = length(integerstring) - 1
            elseif c == Char(39)  # single quote
                if (m = match(r"([^\\\'\n]|\\n|\\\\)\'", line[startcol+1:end])) != nothing
                    chs = m.captures[1]
                    i = (chs == "\\n") ? Int('\n') : (chs == "\\\\" ? Int('\\') : Int(chs[1]))
                    push!(tokens, Tokenized(startline, startcol, "Integer", i))
                    withintoken = length(chs) + 1
                else
                    println("line $startline: bad match with ", line[startcol+1:end])
                end
            elseif c == Char(34)  # double quote
                if (m = match(r"([^\"\n]+)\"", line[startcol+1:end])) == nothing
                    throw("Tokenizer error line $startline: $(errors[6])")
                end
                litstring = m.captures[1]
                push!(tokens, Tokenized(startline, startcol, "String", "\"$litstring\""))
                withintoken = length(litstring) + 1
            elseif (cols = findfirst(r"[a-zA-Z]+", line[startcol:end])) != nothing
                litstring = line[cols .+ startcol .- 1]
                if haskey(keywordtokens, string(litstring))
                    push!(tokens, Tokenized(startline, startcol, keywordtokens[litstring], nothing))
                else
                    litstring = match(r"[_a-zA-Z0-9]+", line[startcol:end]).match
                    push!(tokens, Tokenized(startline, startcol, "Identifier", string(litstring)))
                end
                withintoken = length(litstring) - 1
            end
            lastc = c
        end
    end
    push!(tokens, Tokenized(length(lines), length(lines[end]) + 1, "End_of_input", nothing))
    tokens
end

const test3txt = raw"""
/*
  All lexical tokens - not syntactically correct, but that will
  have to wait until syntax analysis
 */
/* Print   */  print    /* Sub     */  -
/* Putc    */  putc     /* Lss     */  <
/* If      */  if       /* Gtr     */  >
/* Else    */  else     /* Leq     */  <=
/* While   */  while    /* Geq     */  >=
/* Lbrace  */  {        /* Eq      */  ==
/* Rbrace  */  }        /* Neq     */  !=
/* Lparen  */  (        /* And     */  &&
/* Rparen  */  )        /* Or      */  ||
/* Uminus  */  -        /* Semi    */  ;
/* Not     */  !        /* Comma   */  ,
/* Mul     */  *        /* Assign  */  =
/* Div     */  /        /* Integer */  42
/* Mod     */  %        /* String  */  "String literal"
/* Add     */  +        /* Ident   */  variable_name
/* character literal */  '\n'
/* character literal */  '\\'
/* character literal */  ' '
"""

println("Line Col        Name        Value")
for tok in tokenize(test3txt)
    println(lpad(tok.startline, 3), lpad(tok.startcol, 5), lpad(tok.name, 18), "  ", tok.value != nothing ? tok.value : "")
end


// Input: command line argument of file to process or console input. A two or
// three character console input of digits followed by a new line will be
// checked for an integer between zero and twenty-five to select a fixed test
// case to run. Any other console input will be parsed.

// Code based on the Java version found here:
// https://rosettacode.org/mw/index.php?title=Compiler/lexical_analyzer&action=edit&section=22

// Class to halt the parsing with an exception.
class ParsingFailed(message: String): Exception(message)

// Enumerate class of tokens supported by this scanner.
enum class TokenType {
    Tk_End_of_input, Op_multiply,  Op_divide, Op_mod, Op_add, Op_subtract,
    Op_negate, Op_not, Op_less, Op_lessequal, Op_greater, Op_greaterequal,
    Op_equal, Op_notequal, Op_assign, Op_and, Op_or, Kw_if,
    Kw_else, Kw_while, Kw_print, Kw_putc, Sy_LeftParen, Sy_RightParen,
    Sy_LeftBrace, Sy_RightBrace, Sy_Semicolon, Sy_Comma, Tk_Identifier,
    Tk_Integer, Tk_String;

    override fun toString() =
        listOf("End_of_input", "Op_multiply", "Op_divide", "Op_mod", "Op_add",
            "Op_subtract", "Op_negate", "Op_not", "Op_less", "Op_lessequal",
            "Op_greater", "Op_greaterequal", "Op_equal", "Op_notequal",
            "Op_assign", "Op_and", "Op_or", "Keyword_if", "Keyword_else",
            "Keyword_while", "Keyword_print", "Keyword_putc", "LeftParen",
            "RightParen", "LeftBrace", "RightBrace", "Semicolon", "Comma",
            "Identifier", "Integer", "String")[this.ordinal]
} // TokenType

// Data class of tokens returned by the scanner.
data class Token(val token: TokenType, val value: String, val line: Int,
        val pos: Int) {

    // Overridden method to display the token.
    override fun toString() =
        "%5d  %5d %-15s %s".format(line, pos, this.token,
            when (this.token) {
                TokenType.Tk_Integer, TokenType.Tk_Identifier ->
                    " %s".format(this.value)
                TokenType.Tk_String ->
                    this.value.toList().joinToString("", " \"", "\"") {
                        when (it) {
                            '\t' ->
                                "\\t"
                            '\n' ->
                                "\\n"
                            '\u000b' ->
                                "\\v"
                            '\u000c' ->
                                "\\f"
                            '\r' ->
                                "\\r"
                            '"' ->
                                "\\\""
                            '\\' ->
                                "\\"
                            in ' '..'~' ->
                                "$it"
                            else ->
                                "\\u%04x".format(it.code) } }
                else ->
                    "" } )
} // Token

// Function to display an error message and halt the scanner.
fun error(line: Int, pos: Int, msg: String): Nothing =
    throw ParsingFailed("(%d, %d) %s\n".format(line, pos, msg))

// Class to process the source into tokens with properties of the
// source string, the line number, the column position, the index
// within the source string, the current character being processed,
// and map of the keyword strings to the corresponding token type.
class Lexer(private val s: String) {
    private var line = 1
    private var pos = 1
    private var position = 0
    private var chr =
        if (s.isEmpty())
            ' '
        else
            s[0]
    private val keywords = mapOf<String, TokenType>(
        "if" to TokenType.Kw_if,
        "else" to TokenType.Kw_else,
        "print" to TokenType.Kw_print,
        "putc" to TokenType.Kw_putc,
        "while" to TokenType.Kw_while)

    // Method to retrive the next character from the source. Use null after
    // the end of our source.
    private fun getNextChar() =
        if (++this.position >= this.s.length) {
            this.pos++
            this.chr = '\u0000'
            this.chr
        } else {
            this.pos++
            this.chr = this.s[this.position]
            when (this.chr) {
                '\n' -> {
                    this.line++
                    this.pos = 0
                } // line
                '\t' ->
                    while (this.pos%8 != 1)
                        this.pos++
            } // when
            this.chr
        } // if

    // Method to return the division token, skip the comment, or handle the
    // error.
    private fun div_or_comment(line: Int, pos: Int): Token =
        if (getNextChar() != '*')
            Token(TokenType.Op_divide, "", line, pos);
        else {
            getNextChar() // Skip comment start
            [email protected]
            while (true)
                when (this.chr) {
                    '\u0000' ->
                        error(line, pos, "Lexer: EOF in comment");
                    '*' ->
                        if (getNextChar() == '/') {
                            getNextChar() // Skip comment end
                            [email protected]
                        } // if
                    else ->
                        getNextChar()
                } // when
            getToken()
        } // if

    // Method to verify a character literal. Return the token or handle the
    // error.
    private fun char_lit(line: Int, pos: Int): Token {
        var c = getNextChar() // skip opening quote
        when (c) {
            '\'' ->
                error(line, pos, "Lexer: Empty character constant");
            '\\' ->
                c = when (getNextChar()) {
                    'n' ->
                        10.toChar()
                    '\\' ->
                        '\\'
                    '\'' ->
                        '\''
                    else ->
                        error(line, pos, "Lexer: Unknown escape sequence '\\%c'".
                            format(this.chr)) }
        } // when
        if (getNextChar() != '\'')
            error(line, pos, "Lexer: Multi-character constant")
        getNextChar() // Skip closing quote
        return Token(TokenType.Tk_Integer, c.code.toString(), line, pos)
    } // char_lit

    // Method to check next character to see whether it belongs to the token
    // we might be in the middle of. Return the correct token or handle the
    // error.
    private fun follow(expect: Char, ifyes: TokenType, ifno: TokenType,
            line: Int, pos: Int): Token =
        when {
            getNextChar() == expect -> {
                getNextChar()
                Token(ifyes, "", line, pos)
            } // matches
            ifno == TokenType.Tk_End_of_input ->
                error(line, pos,
                    "Lexer: %c expected: (%d) '%c'".format(expect,
                    this.chr.code, this.chr))
            else ->
                Token(ifno, "", line, pos)
        } // when

    // Method to verify a character string. Return the token or handle the
    // error.
    private fun string_lit(start: Char, line: Int, pos: Int): Token {
        var result = ""
        while (getNextChar() != start)
            when (this.chr) {
                '\u0000' ->
                    error(line, pos, "Lexer: EOF while scanning string literal")
                '\n' ->
                    error(line, pos, "Lexer: EOL while scanning string literal")
                '\\' ->
                    when (getNextChar()) {
                        '\\' ->
                            result += '\\'
                        'n' ->
                            result += '\n'
                        '"' ->
                            result += '"'
                        else ->
                            error(line, pos, "Lexer: Escape sequence unknown '\\%c'".
                                format(this.chr))
                    } // when
                else ->
                    result += this.chr
            } // when
        getNextChar() // Toss closing quote
        return Token(TokenType.Tk_String, result, line, pos)
    } // string_lit

    // Method to retrive an identifier or integer. Return the keyword
    // token, if the string matches one. Return the integer token,
    // if the string is all digits. Return the identifer token, if the
    // string is valid. Otherwise, handle the error.
    private fun identifier_or_integer(line: Int, pos: Int): Token {
        var is_number = true
        var text = ""
        while (this.chr in listOf('_')+('0'..'9')+('a'..'z')+('A'..'Z')) {
            text += this.chr
            is_number = is_number && this.chr in '0'..'9'
            getNextChar()
        } // while
        if (text.isEmpty())
            error(line, pos, "Lexer: Unrecognized character: (%d) %c".
                format(this.chr.code, this.chr))
        return when {
            text[0] in '0'..'9' ->
                if (!is_number)
                    error(line, pos, "Lexer: Invalid number: %s".
                        format(text))
                else {
                    val max = Int.MAX_VALUE.toString()
                    if (text.length > max.length || (text.length == max.length &&
                            max < text))
                        error(line, pos,
                            "Lexer: Number exceeds maximum value %s".
                            format(text))
                    Token(TokenType.Tk_Integer, text, line, pos)
                } // if
            this.keywords.containsKey(text) ->
                Token(this.keywords[text]!!, "", line, pos)
            else ->
                Token(TokenType.Tk_Identifier, text, line, pos) }
    } // identifier_or_integer

    // Method to skip whitespace both C's and Unicode ones and retrive the next
    // token.
    private fun getToken(): Token {
        while (this.chr in listOf('\t', '\n', '\u000b', '\u000c', '\r', ' ') ||
                this.chr.isWhitespace())
            getNextChar()
        val line = this.line
        val pos = this.pos
        return when (this.chr) {
            '\u0000' ->
                Token(TokenType.Tk_End_of_input, "", line, pos)
            '/' ->
                div_or_comment(line, pos)
            '\'' ->
                char_lit(line, pos)
            '<' ->
                follow('=', TokenType.Op_lessequal, TokenType.Op_less, line, pos)
            '>' ->
                follow('=', TokenType.Op_greaterequal, TokenType.Op_greater, line, pos)
            '=' ->
                follow('=', TokenType.Op_equal, TokenType.Op_assign, line, pos)
            '!' ->
                follow('=', TokenType.Op_notequal, TokenType.Op_not, line, pos)
            '&' ->
                follow('&', TokenType.Op_and, TokenType.Tk_End_of_input, line, pos)
            '|' ->
                follow('|', TokenType.Op_or, TokenType.Tk_End_of_input, line, pos)
            '"' ->
                string_lit(this.chr, line, pos)
            '{' -> {
                getNextChar()
                Token(TokenType.Sy_LeftBrace, "", line, pos)
            } // open brace
            '}' -> {
                getNextChar()
                Token(TokenType.Sy_RightBrace, "", line, pos)
            } // close brace
            '(' -> {
                getNextChar()
                Token(TokenType.Sy_LeftParen, "", line, pos)
            } // open paren
            ')' -> {
                getNextChar()
                Token(TokenType.Sy_RightParen, "", line, pos)
            } // close paren
            '+' -> {
                getNextChar()
                Token(TokenType.Op_add, "", line, pos)
            } // plus
            '-' -> {
                getNextChar()
                Token(TokenType.Op_subtract, "", line, pos)
            } // dash
            '*' -> {
                getNextChar()
                Token(TokenType.Op_multiply, "", line, pos)
            } // asterisk
            '%' -> {
                getNextChar()
                Token(TokenType.Op_mod, "", line, pos)
            } // percent
            ';' -> {
                getNextChar()
                Token(TokenType.Sy_Semicolon, "", line, pos)
            } // semicolon
            ',' -> {
                getNextChar()
                Token(TokenType.Sy_Comma, "", line, pos)
            } // comma
            else ->
                identifier_or_integer(line, pos) }
    } // getToken

    // Method to parse and display tokens.
    fun printTokens() {
        do {
            val t: Token = getToken()
            println(t)
        } while (t.token != TokenType.Tk_End_of_input)
    } // printTokens
} // Lexer

// Function to test all good tests from the website and produce all of the
// error messages this program supports.
fun tests(number: Int) {

    // Function to generate test case 0 source: Hello World/Text.
    fun hello() {
        Lexer(
"""/*
Hello world
*/
print("Hello, World!\n");
""").printTokens()
    } // hello

    // Function to generate test case 1 source: Phoenix Number.
    fun phoenix() {
        Lexer(
"""/*
Show Ident and Integers
*/
phoenix_number = 142857;
print(phoenix_number, "\n");""").printTokens()
    } // phoenix

    // Function to generate test case 2 source: All Symbols.
    fun symbols() {
        Lexer(
"""/*
  All lexical tokens - not syntactically correct, but that will
  have to wait until syntax analysis
 */
/* Print   */  print    /* Sub     */  -
/* Putc    */  putc     /* Lss     */  <
/* If      */  if       /* Gtr     */  >
/* Else    */  else     /* Leq     */  <=
/* While   */  while    /* Geq     */  >=
/* Lbrace  */  {        /* Eq      */  ==
/* Rbrace  */  }        /* Neq     */  !=
/* Lparen  */  (        /* And     */  &&
/* Rparen  */  )        /* Or      */  ||
/* Uminus  */  -        /* Semi    */  ;
/* Not     */  !        /* Comma   */  ,
/* Mul     */  *        /* Assign  */  =
/* Div     */  /        /* Integer */  42
/* Mod     */  %        /* String  */  "String literal"
/* Add     */  +        /* Ident   */  variable_name
/* character literal */  '\n'
/* character literal */  '\\'
/* character literal */  ' '""").printTokens()
    } // symbols

    // Function to generate test case 3 source: Test Case 4.
    fun four() {
        Lexer(
"""/*** test printing, embedded \n and comments with lots of '*' ***/
print(42);
print("\nHello World\nGood Bye\nok\n");
print("Print a slash n - \\n.\n");""").printTokens()
    } // four

    // Function to generate test case 4 source: Count.
    fun count() {
        Lexer(
"""count = 1;
while (count < 10) {
    print("count is: ", count, "\n");
    count = count + 1;
}""").printTokens()
    } // count

    // Function to generate test case 5 source: 100 Doors.
    fun doors() {
        Lexer(
"""/* 100 Doors */
i = 1;
while (i * i <= 100) {
    print("door ", i * i, " is open\n");
    i = i + 1;
}""").printTokens()
    } // doors

    // Function to generate test case 6 source: Negative Tests.
    fun negative() {
        Lexer(
"""a = (-1 * ((-1 * (5 * 15)) / 10));
print(a, "\n");
b = -a;
print(b, "\n");
print(-b, "\n");
print(-(1), "\n");""").printTokens()
    } // negative

    // Function to generate test case 7 source: Deep.
    fun deep() {
        Lexer(
"""print(---------------------------------+++5, "\n");
print(((((((((3 + 2) * ((((((2))))))))))))), "\n");

if (1) { if (1) { if (1) { if (1) { if (1) { print(15, "\n"); } } } } }""").printTokens()
    } // deep

    // Function to generate test case 8 source: Greatest Common Divisor.
    fun gcd() {
        Lexer(
"""/* Compute the gcd of 1071, 1029: 21 */

a = 1071;
b = 1029;

while (b != 0) {
    new_a = b;
    b = a % b;
    a = new_a;
}
print(a);""").printTokens()
    } // gcd

    // Function to generate test case 9 source: Factorial.
    fun factorial() {
        Lexer(
"""/* 12 factorial is 479001600 */

n = 12;
result = 1;
i = 1;
while (i <= n) {
    result = result * i;
    i = i + 1;
}
print(result);""").printTokens()
    } // factorial

    // Function to generate test case 10 source: Fibonacci Sequence.
    fun fibonacci() {
        Lexer(
"""/* fibonacci of 44 is 701408733 */

n = 44;
i = 1;
a = 0;
b = 1;
while (i < n) {
    w = a + b;
    a = b;
    b = w;
    i = i + 1;
}
print(w, "\n");""").printTokens()
    } // fibonacci

    // Function to generate test case 11 source: FizzBuzz.
    fun fizzbuzz() {
        Lexer(
"""/* FizzBuzz */
i = 1;
while (i <= 100) {
    if (!(i % 15))
        print("FizzBuzz");
    else if (!(i % 3))
        print("Fizz");
    else if (!(i % 5))
        print("Buzz");
    else
        print(i);

    print("\n");
    i = i + 1;
}""").printTokens()
    } // fizzbuzz

    // Function to generate test case 12 source: 99 Bottles of Beer.
    fun bottles() {
        Lexer(
"""/* 99 bottles */
bottles = 99;
while (bottles > 0) {
    print(bottles, " bottles of beer on the wall\n");
    print(bottles, " bottles of beer\n");
    print("Take one down, pass it around\n");
    bottles = bottles - 1;
    print(bottles, " bottles of beer on the wall\n\n");
}""").printTokens()
    } // bottles

    // Function to generate test case 13 source: Primes.
    fun primes() {
        Lexer(
"""/*
Simple prime number generator
*/
count = 1;
n = 1;
limit = 100;
while (n < limit) {
    k=3;
    p=1;
    n=n+2;
    while ((k*k<=n) && (p)) {
        p=n/k*k!=n;
        k=k+2;
    }
    if (p) {
        print(n, " is prime\n");
        count = count + 1;
    }
}
print("Total primes found: ", count, "\n");""").printTokens()
    } // primes

    // Function to generate test case 14 source: Ascii Mandelbrot.
    fun ascii() {
        Lexer(
"""{
/*
 This is an integer ascii Mandelbrot generator
 */
    left_edge   = -420;
    right_edge  =  300;
    top_edge    =  300;
    bottom_edge = -300;
    x_step      =    7;
    y_step      =   15;

    max_iter    =  200;

    y0 = top_edge;
    while (y0 > bottom_edge) {
        x0 = left_edge;
        while (x0 < right_edge) {
            y = 0;
            x = 0;
            the_char = ' ';
            i = 0;
            while (i < max_iter) {
                x_x = (x * x) / 200;
                y_y = (y * y) / 200;
                if (x_x + y_y > 800 ) {
                    the_char = '0' + i;
                    if (i > 9) {
                        the_char = '@';
                    }
                    i = max_iter;
                }
                y = x * y / 100 + y0;
                x = x_x - y_y + x0;
                i = i + 1;
            }
            putc(the_char);
            x0 = x0 + x_step;
        }
        putc('\n');
        y0 = y0 - y_step;
    }
}
""").printTokens()
    } // ascii

    when (number) {
        0 ->
            hello()
        1 ->
            phoenix()
        2 ->
            symbols()
        3 ->
            four()
        4 ->
            count()
        5 ->
            doors()
        6 ->
            negative()
        7 ->
            deep()
        8 ->
            gcd()
        9 ->
            factorial()
        10 ->
            fibonacci()
        11 ->
            fizzbuzz()
        12 ->
            bottles()
        13 ->
            primes()
        14 ->
            ascii()
        15 -> // Lexer: Empty character constant
            Lexer("''").printTokens()
        16 -> // Lexer: Unknown escape sequence
            Lexer("'\\x").printTokens()
        17 -> // Lexer: Multi-character constant
            Lexer("'  ").printTokens()
        18 -> // Lexer: EOF in comment
            Lexer("/*").printTokens()
        19 -> // Lexer: EOL in string
            Lexer("\"\n").printTokens()
        20 -> // Lexer: EOF in string
            Lexer("\"").printTokens()
        21 -> // Lexer: Escape sequence unknown
            Lexer("\"\\x").printTokens()
        22 -> // Lexer: Unrecognized character
            Lexer("~").printTokens()
        23 -> // Lexer: invalid number
            Lexer("9a9").printTokens()
        24 -> // Lexer: Number exceeds maximum value
            Lexer("2147483648\n9223372036854775808").printTokens()
        25 -> // Lexer: Operator expected
            Lexer("|.").printTokens()
        else ->
            println("Invalid test number %d!".format(number))
    } // when
} // tests

// Main function to check our source and read its data before parsing it.
// With no source specified, run the test of all symbols.
fun main(args: Array<String>) {
    try {
        val s =
            if (args.size > 0 && args[0].isNotEmpty()) // file on command line
                java.util.Scanner(java.io.File(args[0]))
            else  // use the console
                java.util.Scanner(System.`in`)
        var source = ""
        while (s.hasNext())
            source += s.nextLine()+
                if (s.hasNext())
                    "\n"
                else
                    ""
        if (args.size > 0 && args[0].isNotEmpty()) // file on command line
            Lexer(source).printTokens()
        else {
            val digits = source.filter { it in '0'..'9' }
            when {
                source.isEmpty() -> // nothing given
                    tests(2)
                source.length in 1..2 && digits.length == source.length &&
                        digits.toInt() in 0..25 ->
                    tests(digits.toInt())
                else ->
                    Lexer(source).printTokens()
            } // when
        } // if
    } catch(e: Throwable) {
        println(e.message)
        System.exit(1)
    } // try
} // main


-- module token_name (in a file "token_name.lua")
local token_name = {
    ['*']     = 'Op_multiply',
    ['/']     = 'Op_divide',
    ['%']     = 'Op_mod',
    ['+']     = 'Op_add',
    ['-']     = 'Op_subtract',
    ['<']     = 'Op_less',
    ['<=']    = 'Op_lessequal',
    ['>']     = 'Op_greater',
    ['>=']    = 'Op_greaterequal',
    ['==']    = 'Op_equal',
    ['!=']    = 'Op_notequal',
    ['!']     = 'Op_not',
    ['=']     = 'Op_assign',
    ['&&']    = 'Op_and',
    ['||']    = 'Op_or',
    ['(']     = 'LeftParen',
    [')']     = 'RightParen',
    ['{']     = 'LeftBrace',
    ['}']     = 'RightBrace',
    [';']     = 'Semicolon',
    [',']     = 'Comma',
    ['if']    = 'Keyword_if',
    ['else']  = 'Keyword_else',
    ['while'] = 'Keyword_while',
    ['print'] = 'Keyword_print',
    ['putc']  = 'Keyword_putc',
}
return token_name


Module lexical_analyzer {
	a$={/*
	  All lexical tokens - not syntactically correct, but that will
	  have to wait until syntax analysis
	 */
	/* Print   */  print    /* Sub     */  -
	/* Putc    */  putc     /* Lss     */  <
	/* If      */  if       /* Gtr     */  >
	/* Else    */  else     /* Leq     */  <=
	/* While   */  while    /* Geq     */  >=
	/* Lbrace  */  {        /* Eq      */  ==
	/* Rbrace  */  }        /* Neq     */  !=
	/* Lparen  */  (        /* And     */  &&
	/* Rparen  */  )        /* Or      */  ||
	/* Uminus  */  -        /* Semi    */  ;
	/* Not     */  !        /* Comma   */  ,
	/* Mul     */  *        /* Assign  */  =
	/* Div     */  /        /* Integer */  42
	/* Mod     */  %        /* String  */  "String literal"
	/* Add     */  +        /* Ident   */  variable_name
	/* character literal */  '\n'
	/* character literal */  '\\'
	/* character literal */  ' '
	}
	lim=Len(a$)
	LineNo=1
	ColumnNo=1
	Document Output$
	Buffer Scanner as Integer*lim
	Return Scanner, 0:=a$
	offset=0
	buffer1$=""
	flag_rem=true
	Ahead=lambda Scanner (a$, offset)->{
		=false
		Try {
			\\ second parameter is the offset in buffer units
			\\ third parameter is length in bytes
			=Eval$(Scanner, offset,2*len(a$))=a$
		}
	}
	Ahead2=lambda Scanner (a$, offset)->{
		=false
		Try {
			=Eval$(Scanner, offset,2) ~ a$
		}
	}
	const nl$=chr$(13)+chr$(10), quo$="""", er$="@", Ansi=3
	Try {
		Do
		If Ahead("/*", offset) Then {
			offset+=2 : 	ColumnNo+=2
			While not Ahead("*/", offset)
				If Ahead(nl$, offset) Then
					lineNo++: ColumnNo=1 : offset+=2
				Else
					offset++ : ColumnNo++
				End If
				if offset>lim then
					Error "End-of-file in comment. Closing comment characters not found"+er$
				End if
			End While
			offset+=2 : ColumnNo+=2
		} Else.if Ahead(nl$, offset) Then{
			LineNo++: ColumnNo=1
			offset+=2
		} Else.if Ahead(quo$, offset) Then {
			Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)
			offset++ : ColumnNo++
			strin=offset
			While not Ahead(quo$, offset)
				If Ahead("/", offset) Then
					offset+=2 : ColumnNo+=2
				else
					offset++ : ColumnNo++
				End if
				checkerror()
			End While
			Output$="String "+quote$(Eval$(Scanner, strin, (offset-strin)*2))+nl$
			offset++ : ColumnNo++
		} Else.if Ahead("'", offset) Then {
			Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)
			offset++ : ColumnNo++
			strin=offset
			While not Ahead("'", offset)
				If Ahead("/", offset) Then
					offset+=2 : ColumnNo+=2
				else
					offset++ : ColumnNo++
				End if
				checkerror()
			End While
			lit$=format$(Eval$(Scanner, strin, (offset-strin)*2))
			select case len(lit$)
			case 1
				Output$="Integer "+str$(asc(lit$),0)+nl$
			case >1
				{Error "Multi-character constant."+er$}
			case 0
				{Error "Empty character constant."+er$}
			end select
			offset++ : ColumnNo++
		} Else.if Ahead2("[a-z]", offset) Then {
			strin=offset
			Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)
			offset++ : ColumnNo++
			While Ahead2("[a-zA-Z0-9_]", offset)
					offset++ : ColumnNo++
			End While
			Keywords(Eval$(Scanner, strin, (offset-strin)*2))
		} Else.if Ahead2("[0-9]", offset) Then {
			strin=offset
			Output$=format$("{0::-10}{1::-10} Integer ", LineNo, ColumnNo)
			offset++ : ColumnNo++
			While Ahead2("[0-9]", offset)
					offset++ : ColumnNo++
			End While
			if Ahead2("[a-zA-Z_]", offset) then
				{Error " Invalid number. Starts like a number, but ends in non-numeric characters."+er$}
			else
				Output$=Eval$(Scanner, strin, (offset-strin)*2)+nl$
			end if
		} Else {
			Symbols(Eval$(Scanner, Offset, 2))
			offset++ : ColumnNo++
		}
		Until offset>=lim
	}
	er1$=leftpart$(error$,er$)
	if er1$<>"" then
		Print
		Report "Error:"+er1$
		Output$="(Error)"+nl$+"Error:"+er1$
	else
		Output$=format$("{0::-10}{1::-10}", LineNo, ColumnNo)+" End_of_Input"+nl$
	end if
	Clipboard Output$
	Save.Doc Output$, "lex.t", Ansi
	document lex$
	Load.Doc lex$,"lex.t", Ansi
	Report lex$

	Sub Keywords(a$)
		select case a$
		case "if"
			a$="Keyword_if"
		case "else"
			a$="Keyword_else"
		case "while"
			a$="Keyword_while"
		case "print"
			a$="Keyword_print"
		case "putc"
			a$="Keyword_putc"
		else case
			a$="Identifier "+a$
		end select
		Output$=a$+nl$
	End sub
	Sub Symbols(a$)
		select case a$
		case " ", chr$(9)
			a$=""
		case "("
			a$="LeftParen"
		case ")"
			a$="RightParen"
		case "{"
			a$="LeftBrace"
		case "}"
			a$="RightBrace"
		case ";"
			a$="Semicolon"
		case ","
			a$="Comma"
		case "*"
			a$="Op_multiply"
		case "/"
			a$="Op_divide"
		case "+"
			a$="Op_add"
		case "-"
			a$="Op_subtract"
		case "%"
			a$="Op_mod"
		case "<"
		{	if Ahead("=", offset+1) Then
				offset++
				a$="Op_lessequal"
				ColumnNo++
			else
				a$="Op_less"
			end if
		}
		case ">"
		{	if Ahead("=", offset+1) Then
				offset++
				ColumnNo++
				a$="Op_greaterequal"
			else
				a$="Op_greater"
			end if
		}
		case "="
		{	if Ahead("=", offset+1) Then
				offset++
				ColumnNo++
				a$="Op_equal"
			else
				a$="Op_assign"
			end if
		}
		case "!"
		{	if Ahead("=", offset+1) Then
				offset++
				ColumnNo++
				a$="Op_notequal"
			else
				a$="Op_not"
			end if
		}
		case "&"
		{	if Ahead("&", offset+1) Then
				offset++
				ColumnNo++
				a$="Op_and"
			else
				a$=""
			end if
		}
		case "|"
		{	if Ahead("|", offset+1) Then
				offset++
				ColumnNo++
				a$="Op_or"
			else
				a$=""
			end if
		}
		else case
			{Error "Unrecognized character."+er$}
		end select
		if a$<>"" then
		Output$=format$("{0::-10}{1::-10} ", LineNo, ColumnNo)+a$+nl$
		end if
	End Sub
	Sub checkerror()
		if offset>lim then {
			Error "End-of-line while scanning string literal. Closing string character not found before end-of-line."+er$
		} else.if  Ahead(nl$,offset) then {
			Error "End-of-file while scanning string literal. Closing string character not found."+er$
		}
	End Sub
}
lexical_analyzer