def crunch(ascii)
  bitstring = ascii.bytes.collect {|b| "%07b" % b}.join
  [bitstring].pack("B*")
end

def expand(binary)
  bitstring = binary.unpack("B*")[0]
  bitstring.scan(/[01]{7}/).collect {|b| b.to_i(2).chr}.join
end

original = "This is an ascii string that will be crunched, written, read and expanded."
puts "my ascii string is #{original.length} bytes"

filename = "crunched.out"

# write the compressed data
File.open(filename, "w") do |fh|
  fh.binmode
  fh.print crunch(original)
end

filesize = File.size(filename)
puts "the file containing the crunched text is #{filesize} bytes"

# read and expand
expanded = File.open(filename, "r") do |fh|
  fh.binmode
  expand(fh.read)
end

if original == expanded
  puts "success"
else
  puts "fail!"
end


pub trait Codec<Input = u8> {
    type Output: Iterator<Item = u8>;

    fn accept(&mut self, input: Input) -> Self::Output;
    fn finish(self) -> Self::Output;
}

#[derive(Debug)]
pub struct BitDiscard {
    buf: u16,      // Use the higher byte for storing the leftovers
    buf_bits: u8,  // How many bits are valid in the buffer
    valid_len: u8, // How many bits to keep from the input
    shift_len: u8, // Pre-computed shift of the input byte
}

impl BitDiscard {
    pub fn new(discard: u8) -> Self {
        assert!(discard < 8);

        BitDiscard {
            buf: 0,
            buf_bits: 0,
            valid_len: 8 - discard,
            shift_len: 8 + discard,
        }
    }
}

impl Codec<u8> for BitDiscard {
    type Output = std::option::IntoIter<u8>;

    fn accept(&mut self, input: u8) -> Self::Output {
        let add = ((input as u16) << self.shift_len) >> self.buf_bits;
        self.buf |= add;
        self.buf_bits += self.valid_len;

        let result = if self.buf_bits >= 8 {
            let result = (self.buf >> 8) as u8;
            self.buf <<= 8;
            self.buf_bits -= 8;
            Some(result)
        } else {
            None
        };

        result.into_iter()
    }

    fn finish(self) -> Self::Output {
        let result = if self.buf_bits > 0 {
            Some((self.buf >> 8) as u8)
        } else {
            None
        };

        result.into_iter()
    }
}

#[derive(Debug)]
pub struct BitExpand {
    buf: u16,      // For storing the leftovers
    buf_bits: u8,  // How many bits are valid in the buffer
    valid_len: u8, // How many bits are valid in the input
    shift_len: u8, // How many bits to shift when expanding
}

impl BitExpand {
    pub fn new(expand: u8) -> Self {
        assert!(expand < 8);

        Self {
            buf: 0,
            buf_bits: 0,
            valid_len: 8 - expand,
            shift_len: 8 + expand,
        }
    }
}

impl Codec<u8> for BitExpand {
    type Output = BitExpandIter;

    fn accept(&mut self, input: u8) -> Self::Output {
        let add = ((input as u16) << 8) >> self.buf_bits;
        self.buf |= add;
        self.buf_bits += 8;
        let buf = self.buf;
        let leftover = self.buf_bits % self.valid_len;
        let buf_bits = self.buf_bits - leftover;
        self.buf <<= buf_bits;
        self.buf_bits = leftover;

        Self::Output {
            buf,
            buf_bits,
            shift_len: self.shift_len,
            valid_len: self.valid_len,
        }
    }

    fn finish(self) -> Self::Output {
        Self::Output {
            buf: 0,
            buf_bits: 0,
            shift_len: 0,
            valid_len: self.valid_len,
        }
    }
}

#[derive(Debug)]
pub struct BitExpandIter {
    buf: u16,
    buf_bits: u8,
    valid_len: u8,
    shift_len: u8,
}

impl Iterator for BitExpandIter {
    type Item = u8;

    fn next(&mut self) -> Option<u8> {
        if self.buf_bits < self.valid_len {
            None
        } else {
            let result = (self.buf >> self.shift_len) as u8;
            self.buf <<= self.valid_len;
            self.buf_bits -= self.valid_len;
            Some(result)
        }
    }
}

fn process_bytes<C: Codec>(mut codec: C, bytes: &[u8]) -> Vec<u8> {
    let mut result: Vec<u8> = bytes.iter().flat_map(|byte| codec.accept(*byte)).collect();
    codec.finish().for_each(|byte| result.push(byte));
    result
}

fn print_bytes(bytes: &[u8]) {
    for byte in bytes {
        print!("{:08b} ", byte);
    }
    println!();

    for byte in bytes {
        print!("{:02x} ", byte);
    }
    println!();
}

fn main() {
    let original = b"STRINGIFY!";
    let discard = 1;
    print_bytes(&original[..]);
    let compressed = process_bytes(BitDiscard::new(discard), &original[..]);
    print_bytes(&compressed);
    let decompressed = process_bytes(BitExpand::new(discard), &compressed);
    print_bytes(&decompressed);
}


program BtmAndPpm;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Classes,
  Winapi.Windows,
  Vcl.Graphics;

type
  TBitmapHelper = class helper for TBitmap
  private
  public
    procedure SaveAsPPM(FileName: TFileName; useGrayScale: Boolean = False);
    procedure LoadFromPPM(FileName: TFileName; useGrayScale: Boolean = False);
  end;

function ColorToGray(Color: TColor): TColor;
var
  L: Byte;
begin
  L := round(0.2126 * GetRValue(Color) + 0.7152 * GetGValue(Color) + 0.0722 *
    GetBValue(Color));
  Result := RGB(L, L, L);
end;

{ TBitmapHelper }

procedure TBitmapHelper.SaveAsPPM(FileName: TFileName; useGrayScale: Boolean = False);
var
  i, j, color: Integer;
  Header: AnsiString;
  ppm: TMemoryStream;
begin
  ppm := TMemoryStream.Create;
  try
    Header := Format('P6'#10'%d %d'#10'255'#10, [Self.Width, Self.Height]);
    writeln(Header);
    ppm.Write(Tbytes(Header), Length(Header));

    for i := 0 to Self.Height - 1 do
      for j := 0 to Self.Width - 1 do
      begin
        if useGrayScale then
          color := ColorToGray(ColorToRGB(Self.Canvas.Pixels[i, j]))
        else
          color := ColorToRGB(Self.Canvas.Pixels[i, j]);
        ppm.Write(color, 3);
      end;
    ppm.SaveToFile(FileName);
  finally
    ppm.Free;
  end;
end;

procedure TBitmapHelper.LoadFromPPM(FileName: TFileName; useGrayScale: Boolean = False);
var
  p: Integer;
  ppm: TMemoryStream;
  sW, sH: string;
  temp: AnsiChar;
  W, H: Integer;
  Color: TColor;

  function ReadChar: AnsiChar;
  begin
    ppm.Read(Result, 1);
  end;

begin
  ppm := TMemoryStream.Create;
  ppm.LoadFromFile(FileName);
  if ReadChar + ReadChar <> 'P6' then
    exit;

  repeat
    temp := ReadChar;
    if temp in ['0'..'9'] then
      sW := sW + temp;
  until temp = ' ';

  repeat
    temp := ReadChar;
    if temp in ['0'..'9'] then
      sH := sH + temp;
  until temp = #10;

  W := StrToInt(sW);
  H := StrToInt(sH);

  if ReadChar + ReadChar + ReadChar <> '255' then
    exit;

  ReadChar(); //skip newLine

  SetSize(W, H);
  p := 0;
  while ppm.Read(Color, 3) > 0 do
  begin
    if useGrayScale then
      Color := ColorToGray(Color);
    Canvas.Pixels[p mod W, p div W] := Color;
    inc(p);
  end;
  ppm.Free;
end;

begin
  with TBitmap.Create do
  begin
    // Load bmp
    LoadFromFile('Input.bmp');
    // Save as ppm
    SaveAsPPM('Output.ppm');

    // Load as ppm and convert in grayscale
    LoadFromPPM('Output.ppm', True);

    // Save as bmp
    SaveToFile('Output.bmp');

    Free;
  end;
end.


(define (write-ppm image file)
  (define (write-image image)
    (define (write-row row)
      (define (write-colour colour)
        (if (not (null? colour))
            (begin (write-char (integer->char (car colour)))
                   (write-colour (cdr colour)))))
      (if (not (null? row))
          (begin (write-colour (car row)) (write-row (cdr row)))))
    (if (not (null? image))
        (begin (write-row (car image)) (write-image (cdr image)))))
  (with-output-to-file file
    (lambda ()
      (begin (display "P6")
             (newline)
             (display (length (car image)))
             (display " ")
             (display (length image))
             (newline)
             (display 255)
             (newline)
             (write-image image)))))


$ include "seed7_05.s7i";
  include "draw.s7i";
  include "color.s7i";

const proc: writePPM (in string: fileName, in PRIMITIVE_WINDOW: aWindow) is func
  local
    var file: ppmFile is STD_NULL;
    var integer: x is 0;
    var integer: y is 0;
    var color: pixColor is black;
  begin
    ppmFile := open(fileName, "w");
    if ppmFile <> STD_NULL then
      writeln(ppmFile, "P6");
      writeln(ppmFile, width(aWindow) <& " " <& height(aWindow));
      writeln(ppmFile, "255");
      for y range 0 to pred(height(aWindow)) do
        for x range 0 to pred(width(aWindow)) do
          pixColor := getPixelColor(aWindow, x, y);
          write(ppmFile, str(chr(pixColor.redLight)) <& chr(pixColor.greenLight) <& chr(pixColor.blueLight));
        end for;
      end for;
      close(ppmFile);
    end if;
  end func;


#!/bin/bash

rand() {
  local min=${1:-0}
  local max=${2:-32767}

  [ ${min} -gt ${max} ] &&
  min=$(( min ^ max )) &&
  max=$(( min ^ max )) &&
  min=$(( min ^ max ))

  echo -n $(( ( $RANDOM % $max ) + $min ))
}

in_arr() {
  local quandry="${1}"
  shift
  local arr=( $@ )
  local i=''

  for i in ${arr[*]}
  do
    [ "${quandry}" == "${i}" ] && return 0 && break
  done

  return 1
}

delete_at() {
  local idx="$(( $1 + 1 ))"
  shift
  local arr=( "sentinel" $@ )

  echo -n "${arr[@]:1:$(( idx - 1 ))} ${arr[@]:$((idx + 1)):$(( ${#arr[@]} - idx - 1))}"
}

delete_first() {
  local meanie="${1}"
  shift
  local arr=( $@ )
  local i=0

  for (( i = 0; i < ${#arr[@]} ; i++ ))
  do
    [ "${arr[${i}]}" == "${meanie}" ] && arr=( $( delete_at ${i} ${arr[*]} ) )
  done

  echo -n "${arr[*]}"
}

to_arr() {
  local string="${1}"
  local arr=()

  while [ "${#string}" -gt 0 ]
  do
    arr=( ${arr[*]} ${string:0:1} )
    string="${string:1}"
  done

  echo -n "${arr[*]}"
}

choose_idx() {
  local arr=( $@ )

  echo -n "$( rand 0 $(( ${#arr[@]} - 1 )) )"
}

locate_bulls() {
  local secret=( $( to_arr "${1}" ) )
  local guess=( $( to_arr "${2}" ) )
  local hits=()
  local i=0

  for (( i=0; i<4; i++ ))
  do
    [ "${secret[${i}]}" -eq "${guess[${i}]}" ] && hits=( ${hits[*]} ${i} )
  done

  echo -n "${hits[*]}"
}

bulls() {
  local secret="${1}"
  local guess="${2}"
  local bulls=( $( locate_bulls "${secret}" "${guess}" ) )

  echo -n "${#bulls[@]}"
}

cows() {
  local secret=( $( to_arr "${1}" ) )
  local guess=( $( to_arr "${2}" ) )
  local bulls=( $( locate_bulls "${1}" "${2}" ) )
  local hits=0
  local i=''

  # Avoid double-counting bulls
  for i in ${bulls[*]}
  do
    secret=( $( delete_at ${i} ${secret[*]} ) )
  done

  # Process the guess against what's left of the secret
  for i in ${guess[*]}
  do
    in_arr "${i}" ${secret[*]} &&
    secret=( $( delete_first "${i}" ${secret[*]} ) ) &&
    (( hits++ ))
  done

  echo -n ${hits}
}

malformed() {
  local guess=( $( to_arr "${1}" ) )
  local i=''

  [ ${#guess[@]} -ne 4 ] &&
  return 0

  for i in ${guess[*]}
  do
    if ! in_arr ${i} 1 2 3 4 5 6 7 8 9
    then
      return 0
      break
    fi
  done

  return 1
}

candidates=( 1 2 3 4 5 6 7 8 9 )
secret=''

while [ "${#secret}" -lt 4 ]
do
  cidx=$( choose_idx ${candidates[*]} )
  secret="${secret}${candidates[${cidx}]}"
  candidates=( $(delete_at ${cidx} ${candidates[*]} ) )
done

while read -p "Enter a four-digit guess:  " guess
do
  malformed "${guess}" && echo "Malformed guess" && continue
  [ "${guess}" == "${secret}" ] && echo "You win!" && exit
  echo "Score: $( bulls "${secret}" "${guess}" ) Bulls, $( cows "${secret}" "${guess}" ) Cows"
done


$ include "seed7_05.s7i";
  include "bitdata.s7i";
  include "strifile.s7i";

const proc: initWriteAscii (inout file: outFile, inout integer: bitPos) is func
  begin
    outFile.bufferChar := '\0;';
    bitPos := 0;
  end func;

const proc: writeAscii (inout file: outFile, inout integer: bitPos, in string: ascii) is func
  local
    var char: ch is ' ';
  begin
    for ch range ascii do
      if ch > '\127;' then
        raise RANGE_ERROR;
      else
        putBitsMsb(outFile, bitPos, ord(ch), 7);
      end if;
    end for;
  end func;

const proc: finishWriteAscii (inout file: outFile, inout integer: bitPos) is func
  begin
    write(outFile, chr(ord(outFile.bufferChar)));
  end func;

const proc: initReadAscii (inout file: outFile, inout integer: bitPos) is func
  begin
    bitPos := 8;
  end func;

const func string: readAscii (inout file: inFile, inout integer: bitPos, in integer: length) is func
  result
    var string: stri is "";
  local
    var char: ch is ' ';
  begin
    while not eof(inFile) and length(stri) < length do
      ch := chr(getBitsMsb(inFile, bitPos, 7));
      if inFile.bufferChar <> EOF then
        stri &:= ch;
      end if;
    end while;
  end func;

const proc: main is func
  local
    var file: aFile is STD_NULL;
    var integer: bitPos is 0;
  begin
    aFile := openStrifile;
    initWriteAscii(aFile, bitPos);
    writeAscii(aFile, bitPos, "Hello, Rosetta Code!");
    finishWriteAscii(aFile, bitPos);
    seek(aFile, 1);
    initReadAscii(aFile, bitPos);
    writeln(literal(readAscii(aFile, bitPos, 100)));
  end func;


package require Tcl 8.5

proc crunch {ascii} {
    binary scan $ascii B* bitstring
    # crunch: remove the extraneous leading 0 bit
    regsub -all {0(.{7})} $bitstring {\1} 7bitstring
    set padded "$7bitstring[string repeat 0 [expr {8 - [string length $7bitstring]%8}]]"
    return [binary format B* $padded]
}

proc expand {binary} {
    binary scan $binary B* padded
    # expand the 7 bit segments with their leading 0 bit
    set bitstring "0[join [regexp -inline -all {.{7}} $padded] 0]"
    return [binary format B* $bitstring]
}

proc crunch_and_write {ascii filename} {
    set fh [open $filename w]
    fconfigure $fh -translation binary
    puts -nonewline $fh [crunch $ascii]
    close $fh
}

proc read_and_expand {filename} {
    set fh [open $filename r]
    fconfigure $fh -translation binary
    set input [read $fh [file size $filename]]
    close $fh
    return [expand $input]
}

set original "This is an ascii string that will be crunched, written, read and expanded."
puts "my ascii string is [string length $original] bytes"

set filename crunched.out
crunch_and_write $original $filename

set filesize [file size $filename]
puts "the file containing the crunched text is $filesize bytes"

set expanded [read_and_expand $filename]

if {$original eq $expanded} {
    puts "the expanded string is the same as the original"
} else {
    error "not the same"
}


def chr := <import:java.lang.makeCharacter>.asChar

def readPPM(inputStream) {
  # Proper native-to-E stream IO facilities have not been designed and
  # implemented yet, so we are borrowing Java's. Poorly. This *will* be
  # improved eventually.

  # Reads one header token, skipping comments and whitespace, and exactly
  # one trailing whitespace character
  def readToken() {
    var token := ""
    var c := chr(inputStream.read())
    while (c == ' ' || c == '\t' || c == '\r' || c == '\n' || c == '#') {
      if (c == '#') {
        while (c != '\n') { c := chr(inputStream.read()) }
      }
      # skip over initial whitespace
      c := chr(inputStream.read())
    }
    while (!(c == ' ' || c == '\t' || c == '\r' || c == '\n')) {
      if (c == '#') {
        while (c != '\n') { c := chr(inputStream.read()) }
      } else {
        token += E.toString(c)
        c := chr(inputStream.read())
      }
    }
    return token
  }

  # Header
  require(readToken() == "P6")
  def width := __makeInt(readToken())
  def height := __makeInt(readToken())
  def maxval := __makeInt(readToken())

  def size := width * height * 3

  # Body
  # See [[Basic bitmap storage]] for the definition and origin of sign()
  def data := <elib:tables.makeFlexList>.fromType(<type:java.lang.Byte>, size)
  if (maxval >= 256) {
    for _ in 1..size {
      data.push(sign((inputStream.read() * 256 + inputStream.read()) * 255 // maxval))
    }
  } else {
    for _ in 1..size {
      data.push(sign(inputStream.read() * 255 // maxval))
    }
  }

  def image := makeImage(width, height)
  image.replace(data.snapshot())
  return image
}


subset Int   < Number {|n| n.is_int  }
subset UInt  < Int    {|n| n >= 0    }
subset UInt8 < Int    {|n| n ~~ ^256 }

struct Pixel {
    R < UInt8,
    G < UInt8,
    B < UInt8
}

class Bitmap(width < UInt, height < UInt) {
    has data = []

    method fill(Pixel p) {
        data = (width*height -> of { Pixel(p.R, p.G, p.B) })
    }

    method setpixel(i < UInt, j < UInt, Pixel p) {

        subset WidthLimit  < UInt { |n| n ~~ ^width  }
        subset HeightLimit < UInt { |n| n ~~ ^height }

        func (w < WidthLimit, h < HeightLimit) {
            data[w*height + h] = p
        }(i, j)
    }

    method p6 {
        <<-EOT + data.map {|p| [p.R, p.G, p.B].pack('C3') }.join
        P6
        #{width} #{height}
        255
        EOT
    }
}

var b = Bitmap(width: 125, height: 125)

for i,j in (^b.height ~X ^b.width) {
    b.setpixel(i, j, Pixel(2*i, 2*j, 255 - 2*i))
}

%f"palette.ppm".write(b.p6, :raw)


mata
void writeppm(name, r, g, b) {
	n = rows(r)
	p = cols(r)
	f = fopen(name, "w")
	fput(f, "P3")
	fput(f, strofreal(p) + " " + strofreal(n) + " 255")
	for (i = 1; i <= n; i++) {
		for (j = 1; j <= p; j++) {
			fput(f, strofreal(r[i,j]) + " " + strofreal(g[i,j]) + " " + strofreal(b[i,j]))
		}
	}
	fclose(f)
}

r = J(1, 6, (0::5) * 51)
g = J(6, 1, (0..5) * 51)
b = J(6, 6, 255)
writeppm("image.ppm", r, g, b)
end


Option Explicit

Sub Main_Bulls_and_cows()
Dim strNumber As String, strInput As String, strMsg As String, strTemp As String
Dim boolEnd As Boolean
Dim lngCpt As Long
Dim i As Byte, bytCow As Byte, bytBull As Byte
Const NUMBER_OF_DIGITS As Byte = 4
Const MAX_LOOPS As Byte = 25 'the max of lines supported by MsgBox

    strNumber = Create_Number(NUMBER_OF_DIGITS)
    Do
        bytBull = 0: bytCow = 0: lngCpt = lngCpt + 1
        If lngCpt > MAX_LOOPS Then strMsg = "Max of loops... Sorry you loose!": Exit Do
        strInput = AskToUser(NUMBER_OF_DIGITS)
        If strInput = "Exit Game" Then strMsg = "User abort": Exit Do
        For i = 1 To Len(strNumber)
            If Mid(strNumber, i, 1) = Mid(strInput, i, 1) Then
                bytBull = bytBull + 1
            ElseIf InStr(strNumber, Mid(strInput, i, 1)) > 0 Then
                bytCow = bytCow + 1
            End If
        Next i
        If bytBull = Len(strNumber) Then
            boolEnd = True: strMsg = "You win in " & lngCpt & " loops!"
        Else
            strTemp = strTemp & vbCrLf & "With : " & strInput & " ,you have : " & bytBull & " bulls," & bytCow & " cows."
            MsgBox strTemp
        End If
    Loop While Not boolEnd
    MsgBox strMsg
End Sub

Function Create_Number(NbDigits As Byte) As String
Dim myColl As New Collection
Dim strTemp As String
Dim bytAlea As Byte

    Randomize
    Do
        bytAlea = Int((Rnd * 9) + 1)
        On Error Resume Next
        myColl.Add CStr(bytAlea), CStr(bytAlea)
        If Err <> 0 Then
            On Error GoTo 0
        Else
            strTemp = strTemp & CStr(bytAlea)
        End If
    Loop While Len(strTemp) < NbDigits
    Create_Number = strTemp
End Function

Function AskToUser(NbDigits As Byte) As String
Dim boolGood As Boolean, strIn As String, i As Byte, NbDiff As Byte

    Do While Not boolGood
        strIn = InputBox("Enter your number (" & NbDigits & " digits)", "Number")
        If StrPtr(strIn) = 0 Then strIn = "Exit Game": Exit Do
        If strIn <> "" Then
            If Len(strIn) = NbDigits Then
                NbDiff = 0
                For i = 1 To Len(strIn)
                    If Len(Replace(strIn, Mid(strIn, i, 1), "")) < NbDigits - 1 Then
                        NbDiff = 1
                        Exit For
                    End If
                Next i
                If NbDiff = 0 Then boolGood = True
            End If
        End If
    Loop
    AskToUser = strIn
End Function


import "io" for File

class BitFilter {
    construct new(name) {
        _name = name
        _accu = 0
        _bits = 0
    }

    openWriter() {
        _bw = File.create(_name)
    }

    openReader() {
        _br = File.open(_name)
        _offset = 0
    }

    write(buf, start, nBits, shift) {
        var index = start + (shift/8).floor
        shift = shift % 8
        while (nBits != 0 || _bits >= 8) {
            while (_bits >= 8) {
                _bits = _bits - 8
                _bw.writeBytes(String.fromByte((_accu >> _bits) & 255))
            }
            while (_bits < 8 && nBits != 0) {
                var b = buf[index]
                _accu = (_accu << 1) | (((128 >> shift) & b) >> (7 - shift))
                nBits = nBits - 1
                _bits = _bits + 1
                shift = shift + 1
                if (shift == 8) {
                    shift = 0
                    index = index + 1
                }
            }
        }
    }

    read(buf, start, nBits, shift) {
        var index = start + (shift/8).floor
        shift = shift % 8
        while (nBits != 0) {
            while (_bits != 0 && nBits != 0) {
                var mask = 128 >> shift
                if ((_accu & (1 << (_bits - 1))) != 0) {
                    buf[index] = (buf[index] | mask) & 255
                } else {
                    buf[index] = (buf[index] & ~mask) & 255
                }
                nBits = nBits - 1
                _bits = _bits - 1
                shift = shift + 1
                if (shift >= 8) {
                    shift = 0
                    index = index + 1
                }
            }
            if (nBits == 0) break
            var byte = _br.readBytes(1, _offset).bytes[0]
            _accu = (_accu << 8) | byte
            _bits = _bits + 8
            _offset = _offset + 1
        }
    }

    closeWriter() {
        if (_bits != 0) {
            _accu = _accu << (8 - _bits)
            _bw.writeBytes(String.fromByte(_accu & 255))
        }
        _bw.close()
        _accu = 0
        _bits = 0
    }

    closeReader() {
        _br.close()
        _accu = 0
        _bits = 0
        _offset = 0
    }
}

var s = "abcdefghijk".bytes.toList
var f = "test.bin"
var bf = BitFilter.new(f)

/* for each byte in s, write 7 bits skipping 1 */
bf.openWriter()
for (i in 0...s.count) bf.write(s, i, 7, 1)
bf.closeWriter()

/* read 7 bits and expand to each byte of s2 skipping 1 bit */
bf.openReader()
var s2 = List.filled(s.count, 0)
for (i in 0...s2.count) bf.read(s2, i, 7, 1)
bf.closeReader()
System.print(s2.map { |b| String.fromByte(b) }.join())


% This module provides basic operations on ppm files:
% Read from file, create ppm in memory (from generic bitmap) and save to file.
% Writing PPM files was introduced in roseta code task 'Bitmap/Write a PPM file'
% but the same code is included here to provide whole set of operations on ppm
% needed for purposes of this task.

-module(ppm).

-export([ppm/1, write/2, read/1]).

% constants for writing ppm file
-define(WHITESPACE, <<10>>).
-define(SPACE, <<32>>).

% constants for reading ppm file
-define(WHITESPACES, [9, 10, 13, 32]).
-define(PPM_HEADER, "P6").

% data structure introduced in task Bitmap (module ros_bitmap.erl)
-record(bitmap, {
    mode = rgb,
    pixels = nil,
    shape = {0, 0}
  }).

%%%%%%%%% API %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% read ppm file from file
read(Filename) ->
    {ok, File} = file:read_file(Filename),
    parse(File).

% create ppm image from bitmap record
ppm(Bitmap) ->
    {Width, Height} = Bitmap#bitmap.shape,
    Pixels = ppm_pixels(Bitmap),
    Maxval = 255,  % original ppm format maximum
    list_to_binary([
      header(), width_and_height(Width, Height), maxval(Maxval), Pixels]).

% write bitmap as ppm file
write(Bitmap, Filename) ->
    Ppm = ppm(Bitmap),
    {ok, File} = file:open(Filename, [binary, write]),
    file:write(File, Ppm),
    file:close(File).

%%%%%%%%% Reading PPM %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
parse(Binary) ->
    {?PPM_HEADER, Data} = get_next_token(Binary),
    {Width, HeightAndRest} = get_next_token(Data),
    {Height, MaxValAndRest} = get_next_token(HeightAndRest),
    {_MaxVal, RawPixels} = get_next_token(MaxValAndRest),
    Shape = {list_to_integer(Width), list_to_integer(Height)},
    Pixels = load_pixels(RawPixels),
    #bitmap{pixels=Pixels, shape=Shape}.

% load binary as a list of RGB triplets
load_pixels(Binary) when is_binary(Binary)->
    load_pixels([], Binary).
load_pixels(Acc, <<>>) ->
    array:from_list(lists:reverse(Acc));
load_pixels(Acc, <<R, G, B, Rest/binary>>) ->
    load_pixels([<<R,G,B>>|Acc], Rest).

is_whitespace(Byte) ->
    lists:member(Byte, ?WHITESPACES).

% get next part of PPM file, skip whitespaces, and return the rest of a binary
get_next_token(Binary) ->
    get_next_token("", true, Binary).
get_next_token(CurrentToken, false, <<Byte, Rest/binary>>) ->
    case is_whitespace(Byte) of
        true ->
            {lists:reverse(CurrentToken), Rest};
        false ->
            get_next_token([Byte | CurrentToken], false, Rest)
    end;
get_next_token(CurrentToken, true, <<Byte, Rest/binary>>) ->
    case is_whitespace(Byte) of
        true ->
            get_next_token(CurrentToken, true, Rest);
        false ->
            get_next_token([Byte | CurrentToken], false, Rest)
    end.

%%%%%%%%% Writing PPM %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
header() ->
    [<<"P6">>, ?WHITESPACE].

width_and_height(Width, Height) ->
    [encode_decimal(Width), ?SPACE, encode_decimal(Height), ?WHITESPACE].

maxval(Maxval) ->
   [encode_decimal(Maxval), ?WHITESPACE].

ppm_pixels(Bitmap) ->
    % 24 bit color depth
    array:to_list(Bitmap#bitmap.pixels).

encode_decimal(Number) ->
    integer_to_list(Number).


package require Tk

proc output_ppm {image filename} {
    $image write $filename -format ppm
}

set img [newImage 150 150]
fill $img red
setPixel $img green 40 40
output_ppm $img filename.ppm

# check the file format:
set fh [open filename.ppm]
puts [gets $fh] ;# ==> P6
puts [gets $fh] ;# ==> 150 150
puts [gets $fh] ;# ==> 255
binary scan [read $fh 3] c3 pixel
foreach colour $pixel {puts [expr {$colour & 0xff}]} ;# ==> 255 \n 0 \n 0 \n
close $fh


    function write {
        _.to_s > "$1"
    }


/////////////////////////////////////////////////////////////////////
//
//  Save image as PPM file.
//  @10 = filename.  Buffer #10 contains the Pixel data.
//
:SAVE_PPM:
Buf_Switch(#10)
BOF
IT("P6") IN
Num_Ins(#11, LEFT)	  // width of image
Num_Ins(#12, LEFT)	  // height of image
Num_Ins(255, LEFT+NOCR)	  // maxval
IC(10)
File_Save_As(@10, OK)
Return


randomize timer
fail=array("Wrong number of chars","Only figures 0 to 9 allowed","Two or more figures are the same")
p=dopuzzle()
wscript.echo "Bulls and Cows. Guess my 4 figure number!"
do
 do
  wscript.stdout.write vbcrlf & "your move ": s=trim(wscript.stdin.readline)
  c=checkinput(s)
  if not isarray (c) then wscript.stdout.write fail(c) :exit do
  bu=c(0)
  wscript.stdout.write "bulls: " & c(0) & " | cows: " & c(1)
 loop while 0
loop until bu=4
wscript.stdout.write vbcrlf & "You won! "

function dopuzzle()
  dim b(10)
  for i=1 to 4
    do
      r=fix(rnd*10)
    loop until b(r)=0
    b(r)=1:dopuzzle=dopuzzle+chr(r+48)
  next
end function

function checkinput(s)
  dim c(10)
  bu=0:co=0
  if len(s)<>4 then checkinput=0:exit function
  for i=1 to 4
    b=mid(s,i,1)
    if instr("0123456789",b)=0 then checkinput=1 :exit function
		if c(asc(b)-48)<>0 then checkinput=2 :exit function
    c(asc(b)-48)=1
    for j=1 to 4
      if asc(b)=asc(mid(p,j,1)) then
        if i=j then bu=bu+1 else co=co+1
      end if
    next
  next
  checkinput=array(bu,co)
end function


Buf_Switch(Buf_Free)
#90 = Time_Tick                     // seed for random number generator
#91 = 10                            // random numbers in range 0 to 9
while (EOB_pos < 4) {               // 4 digits needed
    Call("RANDOM")
    BOF Ins_Char(Return_Value + '0')
    Replace("(.)(.*)\1", "\1\2", REGEXP+BEGIN+NOERR)  // remove any duplicate
}

#3 = 0
repeat (99) {
    Get_Input(10, "Guess a 4-digit number with no duplicate digits: ", NOCR)
    if (Reg_Size(10) == 0) { Break }                // empty string = exit
    Num_Eval_Reg(10)                                // check for numeric digits
    if (Chars_Matched != 4) {
        M("You should enter 4 numeric digits\n")
        Continue
    }

    Goto_Pos(4)                                     // count bulls
    Reg_Ins(10, OVERWRITE)
    #1 = Search("(.)...\1", REGEXP+BEGIN+ALL+NOERR)

    RS(10, "[", INSERT)                             // count cows
    RS(10, "]", APPEND)
    #2 = Search_Block(@10, 0, 4, REGEXP+BEGIN+ALL+NOERR) - #1

    #3++
    NT(#1, NOCR) M(" bulls,") NT(#2, NOCR) M(" cows\n")
    if (#1 == 4) {
        M("You won after") NT(#3, NOCR) M(" guesses!\n")
        Break
    }
}
Buf_Quit(OK)
Return

//--------------------------------------------------------------
// Generate random numbers in range 0 <= Return_Value < #91
//  #90 = Seed    (0 to 0x7fffffff)
//  #91 = Scaling (0 to 0x10000)

:RANDOM:
#92 = 0x7fffffff / 48271
#93 = 0x7fffffff % 48271
#90 = (48271 * (#90 % #92) - #93 * (#90 / #92)) & 0x7fffffff
Return ((#90 & 0xffff) * #91 / 0x10000)


StoreBinaryString:
	;INPUT:
	;	HL = SOURCE ADDRESS
	;	DE = OUTPUT STRING RAM
	;	BC = HOW MANY BYTES OF SOURCE DATA TO CONVERT
	ld a,(hl)
	push bc
		ld b,a	 	;backup a for later
		ld c,%10000000 	;a "revolving bit mask" is used to compare
				;	each bit of A, in sequence.
loop:
		ld a,b	 	;restore A
		and c
		ld a,'0'	;get ascii 0 into A. This does not affect the flags!
		jr z,skip       ;this jump is based on the result of B AND C
		      inc a	;convert ascii 0 into ascii 1, only if B AND C was nonzero.
skip:
		LD (DE),A	;store in output string
		inc de		;next byte of output string
		rrc c		;shift the bit mask down to the next bit of A
		jr nc,loop      ;once a 1 is shifted into the carry, we're finished. Otherwise, check next bit.

	pop bc
	inc hl
	dec bc
	ld a,b
	or c
	jp nz,StoreBinaryString
	ret


   // stream of numBits sized ints to bytes, numBits<8
fcn toBytes(n,[(numBits,acc,bitsSoFar)]state){
   acc=acc.shiftLeft(numBits) + n; bitsSoFar+=numBits;
   reg r;
   if(bitsSoFar>=8){
      bitsSoFar-=8;
      r=acc.shiftRight(bitsSoFar);
      acc=acc.bitAnd((-1).shiftLeft(bitsSoFar).bitNot());
   }
   else r=Void.Skip;  // need more bits to make a byte
   state.clear(numBits,acc,bitsSoFar);
   r
}


include get.e

function get2(integer fn)
    sequence temp
    temp = get(fn)
    return temp[2] - temp[1]*temp[1]
end function

function read_ppm(sequence filename)
    sequence image, line
    integer dimx, dimy, maxcolor
    atom fn
    fn = open(filename, "rb")
    if fn < 0 then
        return -1 -- unable to open
    end if
    line = gets(fn)
    if not equal(line,"P6\n") then
        return -1 -- only ppm6 files are supported
    end if
    dimx = get2(fn)
    if dimx < 0 then
        return -1
    end if
    dimy = get2(fn)
    if dimy < 0 then
        return -1
    end if
    maxcolor = get2(fn)
    if maxcolor != 255 then
        return -1 -- maxcolors other then 255 are not supported
    end if
    image = repeat(repeat(0,dimy),dimx)
    for y = 1 to dimy do
        for x = 1 to dimx do
            image[x][y] = getc(fn)*#10000 + getc(fn)*#100 + getc(fn)
        end for
    end for
    close(fn)
    return image
end function


#ESCAPECHARS ON

DIM colored = ".\\Lena.ppm", grayscale = ".\\LenaGry.ppm"
DIM head, tail, r, g, b, l, ptr, blobsize

FILEGET(FILEOPEN(colored, BINARY), FILELEN(colored)): FILECLOSE(FILEOPEN) ' Load buffer
blobsize = INSTR(FILEGET, "\n255\n") + 4 ' Get sizeof PPM header
head = @FILEGET + blobsize: tail = @FILEGET + FILELEN ' Set loop bounds

FOR ptr = head TO tail STEP 3 ' Transform color triplets
	r = PEEK(ptr + 0, 1) ' Read colors stored in RGB order
	g = PEEK(ptr + 1, 1)
	b = PEEK(ptr + 2, 1)
	l = 0.2126 * r + 0.7152 * g + 0.0722 * b ' Derive luminance
	POKE(ptr + 0, CHR(l))(ptr + 1, CHR)(ptr + 2, CHR) ' Write grayscale
NEXT

FILEPUT(FILEOPEN(grayscale, BINARY_NEW), FILEGET): FILECLOSE(FILEOPEN) ' Save buffer


Public Shared Sub SaveRasterBitmapToPpmFile(ByVal rasterBitmap As RasterBitmap, ByVal filepath As String)
   Dim header As String = String.Format("P6{0}{1}{2}{3}{0}255{0}", vbLf, rasterBitmap.Width, " "c, rasterBitmap.Height)
   Dim bufferSize As Integer = header.Length + (rasterBitmap.Width * rasterBitmap.Height * 3)
   Dim bytes(bufferSize - 1) As Byte
   Buffer.BlockCopy(Encoding.ASCII.GetBytes(header.ToString), 0, bytes, 0, header.Length)
   Dim index As Integer = header.Length
   For y As Integer = 0 To rasterBitmap.Height - 1
      For x As Integer = 0 To rasterBitmap.Width - 1
         Dim color As Rgb = rasterBitmap.GetPixel(x, y)
         bytes(index) = color.R
         bytes(index + 1) = color.G
         bytes(index + 2) = color.B
         index += 3
      Next
   Next
   My.Computer.FileSystem.WriteAllBytes(filepath, bytes, False)
End Sub


import "graphics" for Canvas, ImageData, Color
import "dome" for Window, Process
import "io" for FileSystem

class Bitmap {
    construct new(name, width, height) {
        Window.title = name
        Window.resize(width, height)
        Canvas.resize(width, height)
        _bmp = ImageData.create(name, width, height)
        // create bitmap
        for (y in 0...height) {
            for (x in 0...width) {
                var c = Color.rgb(x % 256, y % 256, (x * y) % 256)
                pset(x, y, c)
            }
        }
        _w = width
        _h = height
    }

    init() {
        // write bitmap to a PPM file
        var ppm = "P6\n%(_w) %(_h)\n255\n"
        for (y in 0..._h) {
            for (x in 0..._w) {
                var c = pget(x, y)
                ppm = ppm + String.fromByte(c.r)
                ppm = ppm + String.fromByte(c.g)
                ppm = ppm + String.fromByte(c.b)
            }
        }
        FileSystem.save("output.ppm", ppm)
        Process.exit(0)
    }

    pset(x, y, col) { _bmp.pset(x, y, col) }

    pget(x, y) { _bmp.pget(x, y) }

    update() {}

    draw(alpha) {}
}

var Game = Bitmap.new("Bitmap - write to PPM  file", 320, 320)


Imports System
Imports System.Text.RegularExpressions

Module Bulls_and_Cows
    Function CreateNumber() As String
        Dim random As New Random()
        Dim sequence As Char() = {"1"c, "2"c, "3"c, "4"c, "5"c, "6"c, "7"c, "8"c, "9"c}

        For i As Integer = 0 To sequence.Length - 1
            Dim j As Integer = random.Next(sequence.Length)
            Dim temp As Char = sequence(i) : sequence(i) = sequence(j) : sequence(j) = temp
        Next

        Return New String(sequence, 0, 4)
    End Function

    Function IsFourDigitNumber(ByVal number As String) As Boolean
        Return Regex.IsMatch(number, "^[1-9]{4}$")
    End Function

    Sub Main()
        Dim chosenNumber As String = CreateNumber()
        Dim attempt As Integer = 0
        Console.WriteLine("Number is chosen")
        Dim gameOver As Boolean = False
        Do
            attempt += 1
            Console.WriteLine("Attempt #{0}. Enter four digit number: ", attempt)
            Dim number As String = Console.ReadLine()
            Do While Not IsFourDigitNumber(number)
                Console.WriteLine("Invalid number: type four characters. Every character must digit be between '1' and '9'.")
                number = Console.ReadLine()
            Loop

            Dim bulls As Integer = 0
            Dim cows As Integer = 0

            For i As Integer = 0 To number.Length - 1
                Dim j As Integer = chosenNumber.IndexOf(number(i))
                If i = j Then
                    bulls += 1
                ElseIf j >= 0 Then
                    cows += 1
                End If
            Next

            If bulls < chosenNumber.Length Then
                Console.WriteLine("The number '{0}' has {1} bulls and {2} cows", _
                    number, bulls, cows)
            Else
                gameOver = True
            End If
        Loop Until gameOver
        Console.WriteLine("The number was guessed in {0} attempts. Congratulations!", attempt)
    End Sub
End Module


: read-ppm { fid -- bmp }
  pad dup 80 fid read-line throw 0= abort" Partial line"
  s" P6" compare abort" Only P6 supported."
  pad dup 80 fid read-line throw 0= abort" Partial line"
  0. 2swap >number
  1 /string		\ skip space
  0. 2swap >number
  2drop drop nip    ( w h )
  bitmap { bmp }
  pad dup 80 fid read-line throw 0= abort" Partial line"
  s" 255" compare abort" Only 8-bits per color channel supported"
  0 pad !
  bmp bdim
  0 do
    dup 0 do
      pad 3 fid read-file throw
      3 - abort" Not enough pixel data in file"
      pad @ i j bmp b!
    loop
  loop drop
  bmp ;

\ testing round-trip
4 3 bitmap value test
red test bfill
green 1 2 test b!

s" red.ppm" w/o create-file throw
test over write-ppm
close-file throw

s" red.ppm" r/o open-file throw
dup read-ppm value test2
close-file throw

: bsize ( bmp -- len ) bdim * pixels bdata ;

test dup bsize  test2 dup bsize  compare .    \ 0 if identical


subroutine read_ppm(u, img)
  integer, intent(in) :: u
  type(rgbimage), intent(out) :: img
  integer :: i, j, ncol, cc
  character(2) :: sign
  character :: ccode

  img%width = 0
  img%height = 0
  nullify(img%red)
  nullify(img%green)
  nullify(img%blue)

  read(u, '(A2)') sign
  read(u, *) img%width, img%height
  read(u, *) ncol

  write(0,*) sign
  write(0,*) img%width, img%height
  write(0,*) ncol

  if ( ncol /= 255 ) return

  call alloc_img(img, img%width, img%height)

  if ( valid_image(img) ) then
     do j=1, img%height
        do i=1, img%width
           read(u, '(A1)', advance='no', iostat=status) ccode
           cc = iachar(ccode)
           img%red(i,j) = cc
           read(u, '(A1)', advance='no', iostat=status) ccode
           cc = iachar(ccode)
           img%green(i,j) = cc
           read(u, '(A1)', advance='no', iostat=status) ccode
           cc = iachar(ccode)
           img%blue(i,j) = cc
        end do
     end do
  end if

end subroutine read_ppm


include c:\cxpl\codes;          \intrinsic 'code' declarations
def Width=180, Height=135, Color=$123456;

proc WriteImage;                \Write screen image to a a PPM file
int  X, Y, C;
[Text(3,"P6 "); IntOut(3,Width); ChOut(3,^ ); IntOut(3,Height); Text(3," 255
");
for Y:= 0 to Height-1 do
    for X:= 0 to Width-1 do
        [C:= ReadPix(X, Y);
        ChOut(3, C>>16);
        ChOut(3, C>>8);
        ChOut(3, C);
        ];
];

proc OpenOutFile(FN);           \Open for output the named file
char FN;        \file name string
int  H;         \handle
[H:= FOpen(FN, 1);
FSet(H, ^o);                    \small buffer allows multiple files, and it is
OpenO(3);                       \ closed automatically when the program exits
];

proc MakeImage;                 \Make a bitmap image
int  X, Y;
[for Y:= 0 to Height-1 do       \fill area with Color
    for X:= 0 to Width-1 do
        Point(X, Y, Color);
Move(60, 60);  HexOut(6, ReadPix(0,0)); \show hex value of color of pixel at 0,0
];

[SetVid($112);  \set display for 640x480 graphics in 24-bit RGB color
MakeImage;
OpenOutFile("IMAGE.PPM");
WriteImage;
SetVid(3);                      \restore display to normal text mode
]


clear screen

wid = 150 : hei = 200
open window wid, hei
window origin "cc"
color 255, 0, 0
fill circle 0, 0, 50
color 0, 255, 0
fill circle 0, 0, 35
color 0, 0, 255
fill circle 0, 0, 20
window origin "lt"

header$ = "P6\n" + str$(wid) + " " + str$(hei) + "\n255\n"

fn = open("exmaple.PPM", "wb")

print #fn header$

for x = 0 to hei - 1
	for y = 0 to wid - 1
		c$ = right$(getbit$(y, x, y, x), 6)
		poke #fn, dec(left$(c$, 2))
		poke #fn, dec(right$(c$, 2))
		poke #fn, dec(mid$(c$, 3, 2))
	next y
next x

poke #fn, asc("\n")
close #fn


// convert Windows BMP (bit map) image to PPM

    // Read BMP file
bmp:=File.stdin.read().howza(0); // BMP to memory (byte bucket), treat as bytes
_assert_(bmp[0]==0x42,"Stdin not a BMP file");
width:=bmp.toLittleEndian(18,2,False); height:=bmp.toLittleEndian(22,2,False); // signed
println(width," x ",height);
bmp.del(0,14 + bmp.toLittleEndian(14,2));  // get rid of header

    // Write BMP to PPM image (in memory)
ppm:=Data(width*height*3 + 100);  // sized byte bucket plus some header slop
ppm.write("P6\n#rosettacode BMP to PPM test\n%d %d\n255\n".fmt(width,height));
foreach y in ([height - 1 .. 0,-1]){  // BGR 1 byte each, image is stored upside down
   bmp[y*width*3,width*3].pump(ppm,T(Void.Read,2),fcn(b,g,r){ return(r,g,b) });
}

File("foo.ppm","wb").write(ppm);  // File.stdout isn't binary, let GC close file


import "random" for Random
import "/set" for Set
import "/ioutil" for Input

var MAX_GUESSES = 20  // say
var r = Random.new()
var num
// generate a 4 digit random number from 1234 to 9876 with no zeros or repeated digits
while (true) {
    num = (1234 + r.int(8643)).toString
    if (!num.contains("0") && Set.new(num).count == 4) break
}

System.print("All guesses should have exactly 4 distinct digits excluding zero.")
System.print("Keep guessing until you guess the chosen number (maximum %(MAX_GUESSES) valid guesses).\n")
var guesses = 0
while (true) {
    var guess = Input.text("Enter your guess : ")
    if (guess == num) {
        System.print("You've won with %(guesses+1) valid guesses!")
        return
    }
    var n = Num.fromString(guess)
    if (!n) {
        System.print("Not a valid number")
    } else if (guess.contains("-") || guess.contains("+")) {
        System.print("Can't contain a sign")
    } else if (guess.contains("0")) {
        System.print("Can't contain zero")
    } else if (guess.count != 4) {
        System.print("Must have exactly 4 digits")
    } else if (Set.new(guess).count < 4) {
        System.print("All digits must be distinct")
    } else {
        var bulls = 0
        var cows  = 0
        var i = 0
        for (c in guess) {
            if (num[i] == c) {
                bulls = bulls + 1
            } else if (num.contains(c)) {
                cows = cows + 1
            }
            i = i + 1
        }
        System.print("Your score for this guess:  Bulls = %(bulls)  Cows = %(cows)")
        guesses = guesses + 1
        if (guesses == MAX_GUESSES) {
            System.print("You've now had %(guesses) valid guesses, the maximum allowed")
            return
        }
    }
}


package raster

import (
    "errors"
    "io"
    "io/ioutil"
    "os"
    "regexp"
    "strconv"
)

// ReadFrom constructs a Bitmap object from an io.Reader.
func ReadPpmFrom(r io.Reader) (b *Bitmap, err error) {
    var all []byte
    all, err = ioutil.ReadAll(r)
    if err != nil {
        return
    }
    bss := rxHeader.FindSubmatch(all)
    if bss == nil {
        return nil, errors.New("unrecognized ppm header")
    }
    x, _ := strconv.Atoi(string(bss[3]))
    y, _ := strconv.Atoi(string(bss[6]))
    maxval, _ := strconv.Atoi(string(bss[9]))
    if maxval > 255 {
        return nil, errors.New("16 bit ppm not supported")
    }
    allCmts := append(append(append(bss[1], bss[4]...), bss[7]...), bss[10]...)
    b = NewBitmap(x, y)
    b.Comments = rxComment.FindAllString(string(allCmts), -1)
    b3 := all[len(bss[0]):]
    var n1 int
    for i := range b.px {
        b.px[i].R = byte(int(b3[n1]) * 255 / maxval)
        b.px[i].G = byte(int(b3[n1+1]) * 255 / maxval)
        b.px[i].B = byte(int(b3[n1+2]) * 255 / maxval)
        n1 += 3
    }
    return
}

const (
    // single whitespace character
    ws = "[ \n\r\t\v\f]"
    // isolated comment
    cmt = "#[^\n\r]*"
    // comment sub expression
    cmts = "(" + ws + "*" + cmt + "[\n\r])"
    // number with leading comments
    num = "(" + cmts + "+" + ws + "*|" + ws + "+)([0-9]+)"
)

var rxHeader = regexp.MustCompile("^P6" + num + num + num +
    "(" + cmts + "*" + ")" + ws)
var rxComment = regexp.MustCompile(cmt)

// ReadFile writes binary P6 format PPM from the specified filename.
func ReadPpmFile(fn string) (b *Bitmap, err error) {
    var f *os.File
    if f, err = os.Open(fn); err != nil {
        return
    }
    if b, err = ReadPpmFrom(f); err != nil {
        return
    }
    return b, f.Close()
}


d:=Dictionary(); do{ d[(1).random(10)]=True }while(d.len()<4);
abcd:=d.keys.shuffle();
while(1){
   guess:=ask("4 digits: ")-" ,";
   if(guess.len()!=4 or guess.unique().len()!=4) continue;
   bulls:=abcd.zipWith('==,guess).sum(0);
   cows:=guess.split("").enumerate()
      .reduce('wrap(s,[(n,c)]){ s + (d.find(c,False) and abcd[n]!=c) },0);
   if(bulls==4) { println("You got it!"); break; }
   "%d bull%s and %d cow%s".fmt(bulls,s(bulls),cows,s(cows)).println();
}
fcn s(n){ (n!=1) and "s" or "" }


import Bitmap
import Bitmap.RGB
import Bitmap.Gray
import Bitmap.Netpbm

import Control.Monad
import Control.Monad.ST

main =
    (readNetpbm "original.ppm" :: IO (Image RealWorld RGB)) >>=
    stToIO . toGrayImage >>=
    writeNetpbm "new.pgm"


require 'files'

readppm=: monad define
  dat=. fread y                                           NB. read from file
  msk=. 1 ,~ (*. 3 >: +/\) (LF&[email protected]}: *. '#'&~:@}.) dat     NB. mark field ends
  't wbyh maxval dat'=. msk <;._2 dat                     NB. parse
  'wbyh maxval'=. 2 1([ {. [: _99&". (LF,' ')&charsub)&.> wbyh;maxval  NB. convert to numeric
  if. (_99 0 +./@e. wbyh,maxval) +. 'P6' [email protected]: 2{.t do. _1 return. end.
  (a. i. dat) makeRGB |.wbyh                              NB. convert to basic bitmap format
)


using Images, FileIO, Netpbm

rgbimg = load("data/bitmapInputTest.ppm")
greyimg = Gray.(rgbimg)
save("data/bitmapOutputTest.ppm", greyimg)


// Version 1.2.40

import java.awt.Color
import java.awt.Graphics
import java.awt.image.BufferedImage
import java.io.FileInputStream
import java.io.PushbackInputStream
import java.io.File
import javax.imageio.ImageIO

class BasicBitmapStorage(width: Int, height: Int) {
    val image = BufferedImage(width, height, BufferedImage.TYPE_3BYTE_BGR)

    fun fill(c: Color) {
        val g = image.graphics
        g.color = c
        g.fillRect(0, 0, image.width, image.height)
    }

    fun setPixel(x: Int, y: Int, c: Color) = image.setRGB(x, y, c.getRGB())

    fun getPixel(x: Int, y: Int) = Color(image.getRGB(x, y))

    fun toGrayScale() {
        for (x in 0 until image.width) {
            for (y in 0 until image.height) {
                var rgb  = image.getRGB(x, y)
                val red   = (rgb shr 16) and 0xFF
                val green = (rgb shr  8) and 0xFF
                val blue  =  rgb and 0xFF
                val lumin = (0.2126 * red + 0.7152 * green + 0.0722 * blue).toInt()
                rgb = (lumin shl 16) or (lumin shl 8) or lumin
                image.setRGB(x, y, rgb)
            }
        }
    }
}

fun PushbackInputStream.skipComment() {
    while (read().toChar() != '\n') {}
}

fun PushbackInputStream.skipComment(buffer: ByteArray) {
    var nl: Int
    while (true) {
        nl = buffer.indexOf(10) // look for newline at end of comment
        if (nl != -1) break
        read(buffer)  // read another buffer full if newline not yet found
    }
    val len = buffer.size
    if (nl < len - 1) unread(buffer, nl + 1, len - nl - 1)
}

fun Byte.toUInt() = if (this < 0) 256 + this else this.toInt()

fun main(args: Array<String>) {
    // use file, output.ppm, created in the Bitmap/Write a PPM file task
    val pbis = PushbackInputStream(FileInputStream("output.ppm"), 80)
    pbis.use {
        with (it) {
            val h1 = read().toChar()
            val h2 = read().toChar()
            val h3 = read().toChar()
            if (h1 != 'P' || h2 != '6' || h3 != '\n') {
                println("Not a P6 PPM file")
                System.exit(1)
            }
            val sb = StringBuilder()
            while (true) {
                val r = read().toChar()
                if (r == '#') { skipComment(); continue }
                if (r == ' ') break  // read until space reached
                sb.append(r.toChar())
            }
            val width = sb.toString().toInt()
            sb.setLength(0)
            while (true) {
                val r = read().toChar()
                if (r == '#') { skipComment(); continue }
                if (r == '\n') break  // read until new line reached
                sb.append(r.toChar())
            }
            val height = sb.toString().toInt()
            sb.setLength(0)
            while (true) {
                val r = read().toChar()
                if (r == '#') { skipComment(); continue }
                if (r == '\n') break  // read until new line reached
                sb.append(r.toChar())
            }
            val maxCol = sb.toString().toInt()
            if (maxCol !in 0..255) {
                println("Maximum color value is outside the range 0..255")
                System.exit(1)
            }
            var buffer = ByteArray(80)
            // get rid of any more opening comments before reading data
            while (true) {
                read(buffer)
                if (buffer[0].toChar() == '#') {
                    skipComment(buffer)
                }
                else {
                    unread(buffer)
                    break
                }
            }
            // read data
            val bbs = BasicBitmapStorage(width, height)
            buffer = ByteArray(width * 3)
            var y = 0
            while (y < height) {
                read(buffer)
                for (x in 0 until width) {
                    val c = Color(
                        buffer[x * 3].toUInt(),
                        buffer[x * 3 + 1].toUInt(),
                        buffer[x * 3 + 2].toUInt()
                    )
                    bbs.setPixel(x, y, c)
                }
                y++
            }
            // convert to grayscale and save to a file
            bbs.toGrayScale()
            val grayFile = File("output_gray.jpg")
            ImageIO.write(bbs.image, "jpg", grayFile)
        }
    }
}


function Read_PPM( filename )
    local fp = io.open( filename, "rb" )
    if fp == nil then return nil end

    local data = fp:read( "*line" )
    if data ~= "P6" then return nil end

    repeat
        data = fp:read( "*line" )
    until string.find( data, "#" ) == nil

    local image = {}
    local size_x, size_y

    size_x = string.match( data, "%d+" )
    size_y = string.match( data, "%s%d+" )

    data = fp:read( "*line" )
    if tonumber(data) ~= 255 then return nil end

    for i = 1, size_x do
        image[i] = {}
    end

    for j = 1, size_y do
        for i = 1, size_x do
            image[i][j] = { string.byte( fp:read(1) ), string.byte( fp:read(1) ), string.byte( fp:read(1) ) }
        end
    end

    fp:close()

    return image
end


Module Checkit {
      Function Bitmap  {
            If match("NN") then {
                 Read x as long, y as long
            } else.if Match("N") Then  {
                \\ is a file?
                  Read f
                  if not Eof(f) then {
                        Line Input #f,  p3$
                              If p3$="P3" Then {
                                    Line Input #f, Comment$
                                    if left$(Comment$,1)="#" then {
                                          Line Input #f, Dimension$
                                    } else  Dimension$=Comment$
                                    long x=Val(piece$(Dimension$," ")(0))
                                    long y=Val(piece$(Dimension$," ")(1))
                                    do {
                                          Line Input #f, P255$
                                    } until left$(P255$, 1)<>"#"
                                    If not P255$="255" then Error "Not proper ppm format"
                              }
                  }
            } else Error "No proper arguments"

            if x<1 or y<1 then  Error "Wrong dimensions"
            structure rgb {
                  red as byte
                  green as byte
                  blue as byte
            }
            m=len(rgb)*x mod 4
            if m>0 then m=4-m  ' add some bytes to raster line
            m+=len(rgb) *x
            Structure rasterline {
                  {
                        pad as byte*m
                  }
                  \\ union pad+hline
                  hline as rgb*x
            }

            Structure Raster {
                  magic as integer*4
                  w as integer*4
                  h as integer*4
                  lines as rasterline*y
            }
            Buffer Clear Image1 as Raster
            \\ 24 chars as header to be used from bitmap render build in functions
            Return Image1, 0!magic:="cDIB", 0!w:=Hex$(x,2), 0!h:=Hex$(y, 2)
            \\ fill white (all 255)
            \\ Str$(string) convert to ascii, so we get all characters from words  width to byte width
            if not valid(f) then  Return Image1, 0!lines:=Str$(String$(chrcode$(255), Len(rasterline)*y))
            Buffer Clear Pad as Byte*4
            SetPixel=Lambda Image1, Pad,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x, y, c) ->{
                  where=alines+3*x+blines*y
                  if c>0 then c=color(c)
                  c-!
                  Return Pad, 0:=c as long
                  Return Image1, 0!where:=Eval(Pad, 2) as byte, 0!where+1:=Eval(Pad, 1) as byte, 0!where+2:=Eval(Pad, 0) as byte

            }
            GetPixel=Lambda Image1,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x,y) ->{
                  where=alines+3*x+blines*y
                  =color(Eval(image1, where+2 as byte), Eval(image1, where+1 as byte), Eval(image1, where as byte))
            }
            StrDib$=Lambda$ Image1, Raster -> {
                  =Eval$(Image1, 0, Len(Raster))
            }
            CopyImage=Lambda Image1 (image$) -> {
                  if left$(image$,12)=Eval$(Image1, 0, 24 ) Then  {
                         Return Image1, 0:=Image$
                  } Else Error "Can't Copy Image"
            }
            Export2File=Lambda Image1, x, y (f) -> {
                  \\ use this between open and close
                  Print #f, "P3"
                  Print #f,"# Created using M2000 Interpreter"
                  Print #f, x;" ";y
                  Print #f, 255
                  x2=x-1
                  where=24
                  For y1= 0 to y-1 {
                        a$=""
                        For x1=0 to x2 {
                              Print #f, a$;Eval(Image1, where+2 as byte);" ";
                              Print #f,  Eval(Image1, where+1 as byte);" ";
                              Print #f,  Eval(Image1, where as byte);
                              where+=3
                              a$=" "
                        }
                        Print #f
                        m=where mod 4
                        if m<>0 then where+=4-m
                  }
            }
            if valid(F) then {
                  'load  RGB values form file
                  x0=x-1
                  where=24
                        For y1=y-1 to 0 {
                              do {
                                          Line Input #f, aline$
                              } until left$(aline$,1)<>"#"
                              flush   ' empty stack
                              Stack aline$  ' place all values to stack as FIFO
                              For x1=0 to x0 {
                                    \\ now read from stack using Number
                                    Return Image1, 0!where+2:=Number as byte, 0!where+1:=Number as byte, 0!where:=Number as byte
                                    where+=3
                              }
                              m=where mod 4
                              if m<>0 then where+=4-m
                        }
            }
            Group Bitmap {
                  SetPixel=SetPixel
                  GetPixel=GetPixel
                  Image$=StrDib$
                  Copy=CopyImage
                  ToFile=Export2File
            }
            =Bitmap
      }
      A=Bitmap(10, 10)
      Call A.SetPixel(5,5, color(128,0,255))
      Open "A.PPM" for Output as #F
            Call A.ToFile(F)
      Close #f
      Open "A.PPM" for Input as #F
      Try {
            C=Bitmap(f)
            Copy 400*twipsx,200*twipsy use C.Image$()
      }
      Close #f
      ' is the same as this one
        Open "A.PPM" for Input as #F
            Line Input #f,  p3$
            If p3$="P3" Then {
                  Line Input #f, Comment$
                  if left$(Comment$,1)="#" then {
                        Line Input #f, Dimension$
                  } else  Dimension$=Comment$
                  Long x=Val(piece$(Dimension$," ")(0))
                  Long y=Val(piece$(Dimension$," ")(1))
                  do {
                        Line Input #f, P255$
                  } until left$(P255$, 1)<>"#"
                  If not P255$="255" then Error "Not proper ppm format"
                  B=Bitmap(x, y)
                  x0=x-1
                  For y1=y-1 to 0 {
                        do {
                                    Line Input #f, aline$
                        } until left$(aline$,1)<>"#"
                        flush   ' empty stack
                        Stack aline$  ' place all values to stack as FIFO
                        For x1=0 to x0 {
                              \\ now read from stack
                              Read red, green, blue
                              Call B.setpixel(x1, y1, Color(red, green, blue))
                        }
                  }
            }
      Close #f
      If valid("B") then  Copy 200*twipsx,200*twipsy use B.Image$()
}
Checkit


import strutils
import bitmap
import streams

type FormatError = object of CatchableError

# States used to parse the header.
type State = enum waitingMagic, waitingWidth, waitingHeight, waitingColors

#---------------------------------------------------------------------------------------------------

iterator tokens(f: Stream): tuple[value: string, lastInLine: bool] =
  ## Yield the tokens in the header.
  for line in f.lines:
    if not line.startsWith('#'):
      let fields = line.splitWhitespace()
      for i, t in fields:
        yield (t, i == fields.high)

#---------------------------------------------------------------------------------------------------

proc getInt(s: string): int {.inline.} =
  ## Try to parse an int. Raise an exception if not an integer.
  try:
    result = s.parseInt()
  except ValueError:
    raise newException(FormatError, "Invalid value")

#---------------------------------------------------------------------------------------------------

proc header(f: Stream): tuple[width, height: Index] =
  ## Read the header and retrun the image width and height.
  var state = waitingMagic
  for (token, lastInLine) in f.tokens:
    case state
    of waitingMagic:
      if token != "P6":
        raise newException(FormatError, "Invalid file header")
    of waitingWidth:
      result.width = token.getInt()
    of waitingHeight:
      result.height = token.getInt()
    of waitingColors:
      if token.getInt() != 255:
        raise newException(FormatError, "Invalid number of colors")
      if not lastInLine:
        raise newException(FormatError, "Invalid data after number of colors")
      break
    state = succ(state)

#---------------------------------------------------------------------------------------------------

proc readPPM*(f: Stream): Image =
  ## Read a PPM file from a stream into an image.

  let header = f.header()
  result = newImage(header.width, header.height)

  var
    arr: array[256, int8]
    read = f.readData(addr(arr), 256)
    pos = 0

  while read != 0:
    for i in 0 ..< read:
      case pos mod 3
      of 0: result.pixels[pos div 3].r = arr[i].uint8
      of 1: result.pixels[pos div 3].g = arr[i].uint8
      of 2: result.pixels[pos div 3].b = arr[i].uint8
      else: discard
      inc pos

    read = f.readData(addr(arr), 256)

  if pos != 3 * result.w * result.h:
    raise newException(FormatError, "Truncated file")

#---------------------------------------------------------------------------------------------------

proc readPPM*(filename: string): Image =
  ## Load a PPM file into an image.

  var file = openFileStream(filename, fmRead)
  result = file.readPPM()
  file.close()

#———————————————————————————————————————————————————————————————————————————————————————————————————

when isMainModule:
  let image = readPPM("output.ppm")
  echo image.h, " ", image.w


let read_ppm ~filename =
  let ic = open_in filename in
  let line = input_line ic in
  if line <> "P6" then invalid_arg "not a P6 ppm file";
  let line = input_line ic in
  let line =
    try if line.[0] = '#'  (* skip comments *)
    then input_line ic
    else line
    with _ -> line
  in
  let width, height =
    Scanf.sscanf line "%d %d" (fun w h -> (w, h))
  in
  let line = input_line ic in
  if line <> "255" then invalid_arg "not a 8 bit depth image";
  let all_channels =
    let kind = Bigarray.int8_unsigned
    and layout = Bigarray.c_layout
    in
    Bigarray.Array3.create kind layout 3 width height
  in
  let r_channel = Bigarray.Array3.slice_left_2 all_channels 0
  and g_channel = Bigarray.Array3.slice_left_2 all_channels 1
  and b_channel = Bigarray.Array3.slice_left_2 all_channels 2
  in
  for y = 0 to pred height do
    for x = 0 to pred width do
      r_channel.{x,y} <- (input_byte ic);
      g_channel.{x,y} <- (input_byte ic);
      b_channel.{x,y} <- (input_byte ic);
    done;
  done;
  close_in ic;
  (all_channels,
   r_channel,
   g_channel,
   b_channel)


functor
import
   Bitmap
   Open
export
   Read
   %% Write
define
   fun {Read Filename}
      F = {New Open.file init(name:Filename)}

      fun {ReadColor8 _}
	 Bytes = {F read(list:$ size:3)}
      in
	 {List.toTuple color Bytes}
      end

      fun {ReadColor16 _}
	 Bytes = {F read(list:$ size:6)}
      in
	 {List.toTuple color {Map {PairUp Bytes} FromBytes}}
      end
   in
      try
	 Magic = {F read(size:2 list:$)}
	 if Magic \= "P6" then raise bitmapIO(read unsupportedFormat(Magic)) end end
	 Width = {ReadNumber F}
	 Height = {ReadNumber F}
	 MaxVal = {ReadNumber F}
	 MaxVal =< 0xffff = true
	 Reader = if MaxVal =< 0xff then ReadColor8 else ReadColor16 end
	 B = {Bitmap.new Width Height}
      in
	 {Bitmap.transform B Reader}
	 B
      finally
	 {F close}
      end
   end

   fun {ReadNumber F}
      Ds
   in
      {SkipWS F}
      Ds = for collect:Collect break:Break do
	      [C] = {F read(list:$ size:1)}
	   in
	      if {Char.isDigit C} then {Collect C}
	      else {Break}
	      end
	   end
      {SkipWS F}
      {String.toInt Ds}
   end

   proc {SkipWS F}
      [C] = {F read(list:$ size:1)}
   in
      if {Char.isSpace C} then {SkipWS F}
      elseif C == &# then
	 {SkipLine F}
      else
	 {F seek(whence:current offset:~1)}
      end
   end

   proc {SkipLine F}
      [C] = {F read(list:$ size:1)}
   in
      if C \= &\n andthen  C \= &\r then {SkipLine F} end
   end

   fun {PairUp Xs}
      case Xs of X1|X2|Xr then [X1 X2]|{PairUp Xr}
      [] nil then nil
      end
   end

   fun {FromBytes [C1 C2]}
      C1 * 0x100 + C2
   end

   %% Omitted: Write
end


#! /usr/bin/perl

use strict;
use Image::Imlib2;

my $img = Image::Imlib2->load("out0.ppm");

# let's do something with it now
$img->set_color(255, 255, 255, 255);
$img->draw_line(0,0, $img->width,$img->height);
$img->image_set_format("png");
$img->save("out1.png");

exit 0;


-- demo\rosetta\Bitmap_read_ppm.exw (runnable version)

function read_ppm(string filename)
sequence image, line
integer dimx, dimy, maxcolor
atom fn = open(filename, "rb")
    if fn<0 then
        return -1 -- unable to open
    end if
    line = gets(fn)
    if line!="P6\n" then
        return -1 -- only ppm6 files are supported
    end if
    line = gets(fn)
    {{dimx,dimy}} = scanf(line,"%d %d%s")
    line = gets(fn)
    {{maxcolor}} = scanf(line,"%d%s")
    image = repeat(repeat(0,dimy),dimx)
    for y=1 to dimy do
        for x=1 to dimx do
            image[x][y] = getc(fn)*#10000 + getc(fn)*#100 + getc(fn)
        end for
    end for
    close(fn)
    return image
end function

--include ppm.e   -- read_ppm(), write_ppm(), to_grey()  (as distributed, instead of the above)

sequence img = read_ppm("Lena.ppm")
img = to_grey(img)
write_ppm("LenaGray.ppm",img)


(de ppmRead (File)
   (in File
      (unless (and `(hex "5036") (rd 2))  # P6
         (quit "Wrong file format" File) )
      (rd 1)
      (let (DX 0  DY 0  Max 0  C)
         (while (>= 9 (setq C (- (rd 1) `(char "0"))) 0)
            (setq DX (+ (* 10 DX) C)) )
         (while (>= 9 (setq C (- (rd 1) `(char "0"))) 0)
            (setq DY (+ (* 10 DY) C)) )
         (while (>= 9 (setq C (- (rd 1) `(char "0"))) 0)
            (setq Max (+ (* 10 Max) C)) )
         (prog1
            (make (do DY (link (need DX))))
            (for Y @
               (map
                  '((X) (set X (list (rd 1) (rd 1) (rd 1))))
                  Y ) ) ) ) ) )


/* BITMAP FILE: read in a file in PPM format, P6 (binary). 14/5/2010 */
test: procedure options (main);
   declare (m, n, max_color, i, j) fixed binary (31);
   declare ch character (1), ID character (2);
   declare 1 pixel union,
            2 color bit(24) aligned,
            2 primary_colors,
               3 R char (1),
               3 G char (1),
               3 B char (1);
   declare in file record;

   open file (in) title ('/IMAGE.PPM,TYPE(FIXED),RECSIZE(1)' ) input;

   call get_char;
   ID = ch;
   call get_char;
   substr(ID, 2,1) = ch;
   /* Read in the dimensions of the image */
   call get_integer (m);
   call get_integer (n);

   /* Read in the maximum color size used */
   call get_integer (max_color);
      /* The previous call reads in ONE line feed or CR or other terminator */
      /* character. */

begin;
   declare image (0:m-1,0:n-1) bit (24);

   do i = 0 to hbound(image, 1);
      do j = 0 to hbound(image,2);
         read file (in) into (R);
         read file (in) into (G);
         read file (in) into (B);
         image(i,j) = color;
      end;
   end;
end;

get_char: procedure;
   do until (ch ^= ' ');
      read file (in) into (ch);
   end;
end get_char;

get_integer: procedure (value);
   declare value fixed binary (31);

   do until (ch = ' ');
      read file (in) into (ch);
   end;
   value = 0;
   do until (is_digit(ch));
      value = value*10 + ch;
      read file (in) into (ch);
   end;
end get_integer;

is_digit: procedure (ch) returns (bit(1));
   declare ch character (1);
   return (index('0123456789', ch) > 0);
end is_digit;
end test;


Structure PPMColor
  r.c
  g.c
  b.c
EndStructure

Procedure LoadImagePPM(Image, file$)
  ; Author Roger Rösch (Nickname Macros)
  IDFile = ReadFile(#PB_Any, file$)
  If IDFile
    If CreateImage(Image, 1, 1)
      Format$ = ReadString(IDFile)
      ReadString(IDFile) ; skip comment
      Dimensions$ = ReadString(IDFile)
      w           = Val(StringField(Dimensions$, 1, " "))
      h           = Val(StringField(Dimensions$, 2, " "))
      ResizeImage(Image, w, h)
      StartDrawing(ImageOutput(Image))
      max = Val(ReadString(IDFile))           ; Maximal Value for a color
      Select Format$
        Case "P3" ; File in ASCII format
          ; Exract everey number remaining in th file into an array using an RegEx
          Stringlen = Lof(IDFile) - Loc(IDFile)
          content$  = Space(Stringlen)
          Dim color.s(0)
          ReadData(IDFile, @content$, Stringlen)
          CreateRegularExpression(1, "\d+")
          ExtractRegularExpression(1, content$, color())
          ; Plot color information on our empty Image
          For y = 0 To h - 1
            For x = 0 To w - 1
              pos = (y*w + x)*3
              r=Val(color(pos))*255 / max
              g=Val(color(pos+1))*255 / max
              b=Val(color(pos+2))*255 / max
              Plot(x, y, RGB(r,g,b))
            Next
          Next
        Case "P6" ;File In binary format
          ; Read whole bytes into a buffer because its faster than reading single ones
          Bufferlen = Lof(IDFile) - Loc(IDFile)
          *Buffer   = AllocateMemory(Bufferlen)
          ReadData(IDFile, *Buffer, Bufferlen)
          ; Plot color information on our empty Image
          For y = 0 To h - 1
            For x = 0 To w - 1
              *color.PPMColor = pos + *Buffer
              Plot(x, y, RGB(*color\r*255 / max, *color\g*255 / max, *color\b*255 / max))
              pos + 3
            Next
          Next
      EndSelect
      StopDrawing()
      ; Return 1 if successfully loaded to behave as other PureBasic functions
      ProcedureReturn 1
    EndIf
  EndIf
EndProcedure


# With help from http://netpbm.sourceforge.net/doc/ppm.html

# String masquerading as ppm file (version P3)
import io

ppmtxt = '''P3
# feep.ppm
4 4
15
 0  0  0    0  0  0    0  0  0   15  0 15
 0  0  0    0 15  7    0  0  0    0  0  0
 0  0  0    0  0  0    0 15  7    0  0  0
15  0 15    0  0  0    0  0  0    0  0  0
'''

def tokenize(f):
    for line in f:
        if line[0] != '#':
            for t in line.split():
                yield t

def ppmp3tobitmap(f):
    t = tokenize(f)
    nexttoken = lambda : next(t)
    assert 'P3' == nexttoken(), 'Wrong filetype'
    width, height, maxval = (int(nexttoken()) for i in range(3))
    bitmap = Bitmap(width, height, Colour(0, 0, 0))
    for h in range(height-1, -1, -1):
        for w in range(0, width):
            bitmap.set(w, h, Colour( *(int(nexttoken()) for i in range(3))))

    return bitmap

print('Original Colour PPM file')
print(ppmtxt)
ppmfile = io.StringIO(ppmtxt)
bitmap = ppmp3tobitmap(ppmfile)
print('Grey PPM:')
bitmap.togreyscale()
ppmfileout = io.StringIO('')
bitmap.writeppmp3(ppmfileout)
print(ppmfileout.getvalue())

'''
The print statements above produce the following output:

Original Colour PPM file
P3
# feep.ppm
4 4
15
 0  0  0    0  0  0    0  0  0   15  0 15
 0  0  0    0 15  7    0  0  0    0  0  0
 0  0  0    0  0  0    0 15  7    0  0  0
15  0 15    0  0  0    0  0  0    0  0  0

Grey PPM:
P3
# generated from Bitmap.writeppmp3
4 4
11
    0  0  0    0  0  0    0  0  0    4  4  4
    0  0  0   11 11 11    0  0  0    0  0  0
    0  0  0    0  0  0   11 11 11    0  0  0
    4  4  4    0  0  0    0  0  0    0  0  0

'''


#lang racket
(require racket/draw)

(define (read-ppm port)
  (parameterize ([current-input-port port])
    (define magic (read))
    (define width (read))
    (define height (read))
    (define maxcol (read))
    (define bm (make-object bitmap% width height))
    (define dc (new bitmap-dc% [bitmap bm]))
    (send dc set-smoothing 'unsmoothed)
    (define (adjust v) (* 255 (/ v maxcol)))
    (for/list ([x width])
      (for/list ([y height])
        (define red (read))
        (define green (read))
        (define blue (read))
        (define color (make-object color% (adjust red) (adjust green) (adjust blue)))
        (send dc set-pen color 1 'solid)
        (send dc draw-point x y)))
    bm))


class Pixel { has UInt ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @.data;
}

role PGM {
    has @.GS;
    method P5 returns Blob {
	"P5\n{self.width} {self.height}\n255\n".encode('ascii')
	~ Blob.new: self.GS
    }
}

sub load-ppm ( $ppm ) {
    my $fh    = $ppm.IO.open( :enc('ISO-8859-1') );
    my $type  = $fh.get;
    my ($width, $height) = $fh.get.split: ' ';
    my $depth = $fh.get;
    Bitmap.new( width => $width.Int, height => $height.Int,
      data => ( $fh.slurp.ords.rotor(3).map:
        { Pixel.new(R => $_[0], G => $_[1], B => $_[2]) } )
    )
}

sub grayscale ( Bitmap $bmp ) {
    $bmp.GS = map { (.R*0.2126 + .G*0.7152 + .B*0.0722).round(1) min 255 }, $bmp.data;
}

my $filename = './camelia.ppm';

my Bitmap $b = load-ppm( $filename ) but PGM;

grayscale($b);

'./camelia-gs.pgm'.IO.open(:bin, :w).write: $b.P5;


/*REXX program reads a PPM formatted image file,  and creates a gray─scale image of it. */
parse arg iFN oFN                                /*obtain optional argument from the CL.*/
if iFN=='' | iFN==","  then  iFN= 'Lenna50'      /*Not specified?  Then use the default.*/
if oFN=='' | oFN==","  then  oFN= 'greyscale'    /* "      "         "   "   "     "    */
iFID= iFN'.ppm';             oFID= oFN'.ppm'     /*complete the  input and output  FIDs.*/
call charin iFID, 1, 0                           /*set the position of the input file.  */
y=charin(iFID, , copies(9, digits() ) )          /*read the entire input file  ───►  X  */
parse var  y   id  3 c 4 3 width height # pixels /*extract header info from the PPM hdr.*/
      LF= 'a'x                                   /*define a comment separator  (in hdr).*/      /* ◄─── LF delimiters & comments*/
if c==LF  then do;  commentEND=pos(LF, y, 4)     /*point to the last char in the comment*/      /* ◄─── LF delimiters & comments*/
                    parse var  y   =(commentEND)  +1  width  height          #  pixels          /* ◄─── LF delimiters & comments*/
               end                                                                              /* ◄─── LF delimiters & comments*/
                                                 /* [↓]  has an alternative delimiter?  */      /* ◄─── LF delimiters & comments*/
z=pos(LF, height);  if z\==0  then parse var  height height    =(z)   +1     #  pixels          /* ◄─── LF delimiters & comments*/
z=pos(LF, #     );  if z\==0  then parse var  #      #         =(z)   +1        pixels          /* ◄─── LF delimiters & comments*/
chunk=4000                                       /*chunk size to be written at one time.*/
LenPixels= length(pixels)

  do j=0  for 256;  _=d2c(j);   @._=j;   @@.j=_  /*build two tables for fast conversions*/
  end   /*j*/

call charout oFID, ,  1                          /*set the position of the output file. */
call charout oFID, id || width height #' '       /*write the header followed by a blank.*/
!=1
    do until !>=LenPixels;            $=         /*$:      partial output string so far.*/
      do !=!  by 3  for chunk                    /*chunk:  # pixels converted at 1 time.*/
      parse var pixels  =(!)  r +1   g +1   b +1 /*obtain the next  RGB  of a PPM pixel.*/
      if r==''  then leave                       /*has the end─of─string been reached?  */
      _=(.2126*@.r  + .7152*@.g  + .0722*@.b )%1 /*an integer RGB greyscale of a pixel. */
      $=$  ||  @@._  ||  @@._  ||  @@._          /*lump (grey)  R G B  pixels together. */
      end   /*!*/                                /* [↑]  D2C  converts decimal ───► char*/
    call charout oFID, $                         /*write the next bunch of pixels.      */
    end     /*until*/

call charout oFID                                /*close the output file just to be safe*/
say 'File '       oFID       " was created."     /*stick a fork in it,  we're all done. */


class Pixmap
  # 'open' is a class method
  def self.open(filename)
    bitmap = nil
    File.open(filename, 'r') do |f|
      header = [f.gets.chomp, f.gets.chomp, f.gets.chomp]
      width, height = header[1].split.map {|n| n.to_i }
      if header[0] != 'P6' or header[2] != '255' or width < 1 or height < 1
        raise StandardError, "file '#{filename}' does not start with the expected header"
      end
      f.binmode
      bitmap = self.new(width, height)
      height.times do |y|
        width.times do |x|
          # read 3 bytes
          red, green, blue = f.read(3).unpack('C3')
          bitmap[x,y] = RGBColour.new(red, green, blue)
        end
      end
    end
    bitmap
  end
end

# create an image: a green cross on a blue background
colour_bitmap = Pixmap.new(20, 30)
colour_bitmap.fill(RGBColour::BLUE)
colour_bitmap.height.times {|y| [9,10,11].each {|x| colour_bitmap[x,y]=RGBColour::GREEN}}
colour_bitmap.width.times  {|x| [14,15,16].each {|y| colour_bitmap[x,y]=RGBColour::GREEN}}
colour_bitmap.save('testcross.ppm')

# then, convert to grayscale
Pixmap.open('testcross.ppm').to_grayscale!.save('testgray.ppm')


parser.rs:
use super::{Color, ImageFormat};
use std::str::from_utf8;
use std::str::FromStr;

pub fn parse_version(input: &[u8]) -> nom::IResult<&[u8], ImageFormat> {
    use nom::branch::alt;
    use nom::bytes::complete::tag;
    use nom::character::complete::line_ending;
    use nom::combinator::map;
    use nom::sequence::terminated;

    // starts with P3/P6 ends with a CR/LF
    terminated(
        alt((
            map(tag("P3".as_bytes()), |_| ImageFormat::P3),
            map(tag("P6".as_bytes()), |_| ImageFormat::P6),
        )),
        line_ending,
    )(input)
}

pub fn parse_image_attributes(input: &[u8]) -> nom::IResult<&[u8], (usize, usize, usize)> {
    use nom::character::complete::line_ending;
    use nom::character::complete::{digit1, space1};
    use nom::sequence::terminated;
    use nom::sequence::tuple;

    // 3 numbers separated by spaces ends with a CR/LF
    terminated(tuple((digit1, space1, digit1, space1, digit1)), line_ending)(input).map(
        |(next_input, result)| {
            (
                next_input,
                (
                    usize::from_str_radix(from_utf8(result.0).unwrap(), 10).unwrap(),
                    usize::from_str_radix(from_utf8(result.2).unwrap(), 10).unwrap(),
                    usize::from_str_radix(from_utf8(result.4).unwrap(), 10).unwrap(),
                ),
            )
        },
    )
}

pub fn parse_color_binary(input: &[u8]) -> nom::IResult<&[u8], Color> {
    use nom::number::complete::u8 as nom_u8;
    use nom::sequence::tuple;

    tuple((nom_u8, nom_u8, nom_u8))(input).map(|(next_input, res)| {
        (
            next_input,
            Color {
                red: res.0,
                green: res.1,
                blue: res.2,
            },
        )
    })
}

pub fn parse_data_binary(input: &[u8]) -> nom::IResult<&[u8], Vec<Color>> {
    use nom::multi::many0;
    many0(parse_color_binary)(input)
}

pub fn parse_color_ascii(input: &[u8]) -> nom::IResult<&[u8], Color> {
    use nom::character::complete::{digit1, space0, space1};
    use nom::sequence::tuple;

    tuple((digit1, space1, digit1, space1, digit1, space0))(input).map(|(next_input, res)| {
        (
            next_input,
            Color {
                red: u8::from_str(from_utf8(res.0).unwrap()).unwrap(),
                green: u8::from_str(from_utf8(res.2).unwrap()).unwrap(),
                blue: u8::from_str(from_utf8(res.4).unwrap()).unwrap(),
            },
        )
    })
}

pub fn parse_data_ascii(input: &[u8]) -> nom::IResult<&[u8], Vec<Color>> {
    use nom::multi::many0;
    many0(parse_color_ascii)(input)
}

lib.rs:
extern crate nom;
extern crate thiserror;
mod parser;

use std::default::Default;
use std::fmt;
use std::io::{BufWriter, Error, Write};
use std::ops::{Index, IndexMut};
use std::{fs::File, io::Read};
use thiserror::Error;

#[derive(Copy, Clone, Default, PartialEq, Debug)]
pub struct Color {
    pub red: u8,
    pub green: u8,
    pub blue: u8,
}

#[derive(Copy, Clone, PartialEq, Debug)]
pub enum ImageFormat {
    P3,
    P6,
}

impl From<&str> for ImageFormat {
    fn from(i: &str) -> Self {
        match i.to_lowercase().as_str() {
            "p3" => ImageFormat::P3,
            "p6" => ImageFormat::P6,
            _ => unimplemented!("no other formats supported"),
        }
    }
}

impl fmt::Display for ImageFormat {
    fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
        match self {
            ImageFormat::P3 => {
                write!(f, "P3")
            }
            ImageFormat::P6 => {
                write!(f, "P6")
            }
        }
    }
}

#[derive(Error, Debug)]
pub enum ImageError {
    #[error("File not found")]
    FileNotFound,
    #[error("File not readable")]
    FileNotReadable,
    #[error("Invalid header information")]
    InvalidHeader,
    #[error("Invalid information in the data block")]
    InvalidData,
    #[error("Invalid max color information")]
    InvalidMaxColor,
    #[error("File is incomplete")]
    IncompleteFile,
    #[error("unknown data store error")]
    Unknown,
}
pub struct Image {
    pub format: ImageFormat,
    pub width: usize,
    pub height: usize,
    pub data: Vec<Color>,
}

impl Image {
    #[must_use]
    pub fn new(width: usize, height: usize) -> Self {
        Self {
            format: ImageFormat::P6,
            width,
            height,
            data: vec![Color::default(); width * height],
        }
    }

    pub fn fill(&mut self, color: Color) {
        for elem in &mut self.data {
            *elem = color;
        }
    }

    /// # Errors
    ///
    /// Will return `Error` if `filename` does not exist or the user does not have
    /// permission to write to it, or the write operation fails.
    pub fn write_ppm(&self, filename: &str) -> Result<(), Error> {
        let file = File::create(filename)?;
        let mut writer = BufWriter::new(file);
        writeln!(&mut writer, "{}", self.format.to_string())?;
        writeln!(&mut writer, "{} {} 255", self.width, self.height)?;
        match self.format {
            ImageFormat::P3 => {
                writer.write_all(
                    &self
                        .data
                        .iter()
                        .flat_map(|color| {
                            vec![
                                color.red.to_string(),
                                color.green.to_string(),
                                color.blue.to_string(),
                            ]
                        })
                        .collect::<Vec<String>>()
                        .join(" ")
                        .as_bytes(),
                )?;
            }
            ImageFormat::P6 => {
                writer.write_all(
                    &self
                        .data
                        .iter()
                        .flat_map(|color| vec![color.red, color.green, color.blue])
                        .collect::<Vec<u8>>(),
                )?;
            }
        }
        Ok(())
    }

    /// # Panics
    ///
    /// Panics if the format is not P6 or P3 PPM
    /// # Errors
    ///
    /// Will return `Error` if `filename` does not exist or the user does not have
    /// permission to read it or the read operation fails, or the file format does not
    /// match the specification
    pub fn read_ppm(filename: &str) -> Result<Image, ImageError> {
        let mut file = File::open(filename).map_err(|_| ImageError::FileNotFound)?;
        let mut data: Vec<u8> = Vec::new();
        file.read_to_end(&mut data)
            .map_err(|_| ImageError::FileNotReadable)?;

        let (i, format) = parser::parse_version(&data).map_err(|_| ImageError::InvalidHeader)?;
        let (i, (width, height, max_color)) =
            parser::parse_image_attributes(i).map_err(|_| ImageError::InvalidHeader)?;

        if max_color != 255 {
            return Err(ImageError::InvalidMaxColor);
        }

        let (_, data) = match format {
            ImageFormat::P3 => parser::parse_data_ascii(i).map_err(|_| ImageError::InvalidData)?,
            ImageFormat::P6 => parser::parse_data_binary(i).map_err(|_| ImageError::InvalidData)?,
        };

        if data.len() != height * width {
            return Err(ImageError::IncompleteFile);
        };

        Ok(Image {
            format,
            width,
            height,
            data,
        })
    }
}

impl Index<(usize, usize)> for Image {
    type Output = Color;

    fn index(&self, (x, y): (usize, usize)) -> &Color {
        &self.data[x + y * self.width]
    }
}

impl IndexMut<(usize, usize)> for Image {
    fn index_mut(&mut self, (x, y): (usize, usize)) -> &mut Color {
        &mut self.data[x + y * self.width]
    }
}

use bitmap::Image;

// see read_ppm implementation in the bitmap library

pub fn main() {
    // read a PPM image, which was produced by the write-a-ppm-file task
    let image = Image::read_ppm("./test_image.ppm").unwrap();

    println!("Read using nom parsing:");
    println!("Format: {:?}", image.format);
    println!("Dimensions: {} x {}", image.height, image.width);
}


import scala.io._
import scala.swing._
import java.io._
import java.awt.Color
import javax.swing.ImageIcon

object Pixmap {
   private case class PpmHeader(format:String, width:Int, height:Int, maxColor:Int)

   def load(filename:String):Option[RgbBitmap]={
      implicit val in=new BufferedInputStream(new FileInputStream(filename))
      val header=readHeader
      if(header.format=="P6")
      {
         val bm=new RgbBitmap(header.width, header.height);
         for(y <- 0 until bm.height; x <- 0 until bm.width; c=readColor)
            bm.setPixel(x, y, c)
         return Some(bm)
      }
      None
   }

   private def readHeader(implicit in:InputStream)={
      var format=readLine

      var line=readLine
      while(line.startsWith("#"))   //skip comments
         line=readLine

      val parts=line.split("\\s")
      val width=parts(0).toInt
      val height=parts(1).toInt
      val maxColor=readLine.toInt

      new PpmHeader(format, width, height, maxColor)
   }

   private def readColor(implicit in:InputStream)=new Color(in.read, in.read, in.read)

   private def readLine(implicit in:InputStream)={
      var out=""
      var b=in.read
      while(b!=0xA){out+=b.toChar; b=in.read}
      out
   }
}


$ include "seed7_05.s7i";
  include "draw.s7i";
  include "color.s7i";

const func PRIMITIVE_WINDOW: getPPM (in string: fileName) is func
  result
    var PRIMITIVE_WINDOW: aWindow is PRIMITIVE_WINDOW.value;
  local
    var file: ppmFile is STD_NULL;
    var string: line is "";
    var integer: width is 0;
    var integer: height is 0;
    var integer: x is 0;
    var integer: y is 0;
    var color: pixColor is black;
  begin
    ppmFile := open(fileName, "r");
    if ppmFile <> STD_NULL then
      if getln(ppmFile) = "P6" then
        repeat
          line := getln(ppmFile);
        until line = "" or line[1] <> '#';
        read(ppmFile, width);
        readln(ppmFile, height);
        aWindow := newPixmap(width, height);
        for y range 0 to pred(height) do
          for x range 0 to pred(width) do
            pixColor.redLight   := ord(getc(ppmFile));
            pixColor.greenLight := ord(getc(ppmFile));
            pixColor.blueLight  := ord(getc(ppmFile));
          end for;
        end for;
      end if;
      close(ppmFile);
    end if;
  end func;


package require Tk

proc readPPM {image file} {
    $image read $file -format ppm
}


//   Load a PPM file
//     @10 = filename
//   On return:
//     #10 points to buffer containing pixel data,
//     #11 = width,  #12 = height.

:LOAD_PPM:
File_Open(@10)
BOF
Search("|X", ADVANCE)		// skip "P6"
#11 = Num_Eval(ADVANCE)		// #11 = width
Match("|X", ADVANCE)		// skip separator
#12 = Num_Eval(ADVANCE)		// #12 = height
Match("|X", ADVANCE)
Search("|X", ADVANCE)		// skip maxval (assume 255)
Del_Block(0,CP)			// remove the header
Return


import "graphics" for Canvas, ImageData, Color
import "dome" for Window, Process
import "io" for FileSystem

class Bitmap {
    construct new(fileName, fileName2, width, height) {
        Window.title = "Bitmap - read PPM file"
        Window.resize(width, height)
        Canvas.resize(width, height)
        _w = width
        _h = height
        _fn2 = fileName2
        loadPPMFile(fileName)
    }

    init() {
        toGrayScale()
        // display images side by side
        _bmp.draw(0, 0)
        _bmp2.draw(536, 0)
        // save gray scale image to file
        _bmp2.saveToFile(_fn2)
    }

    loadPPMFile(fileName) {
        var ppm = FileSystem.load(fileName)
        if (ppm[0..1] != "P6") {
            System.print("The loaded file is not a P6 file.")
            Process.exit()
        }
        var lines = ppm.split("\n")
        if (Num.fromString(lines[2]) > 255) {
            System.print("The maximum color value can't exceed 255.")
            Process.exit()
        }
        var wh = lines[1].split(" ")
        var w = Num.fromString(wh[0])
        var h = Num.fromString(wh[1])
        _bmp = ImageData.create(fileName, w, h)
        var bytes = ppm.bytes
        var i = bytes.count - 3 * w * h
        for (y in 0...h) {
            for (x in 0...w) {
                var r = bytes[i]
                var g = bytes[i+1]
                var b = bytes[i+2]
                var c = Color.rgb(r, g, b)
                pset(x, y, c)
                i = i + 3
            }
        }
    }

    toGrayScale() {
        _bmp2 = ImageData.create("gray scale", _bmp.width, _bmp.height)
        for (x in 0..._bmp.width) {
            for (y in 0..._bmp.height) {
                var c1 = _bmp.pget(x, y)
                var lumin = (0.2126 * c1.r + 0.7152 * c1.g + 0.0722 * c1.b).floor
                var c2 = Color.rgb(lumin, lumin,lumin, c1.a)
                _bmp2.pset(x, y, c2)
            }
        }
    }

    pset(x, y, col) { _bmp.pset(x, y, col) }

    pget(x, y) { _bmp.pget(x, y) }

    update() {}

    draw(alpha) {}
}

var Game = Bitmap.new("Lenna100.ppm", "Lenna100_gs.jpg", 1048, 512)


include c:\cxpl\codes;          \intrinsic 'code' declarations

func OpenInFile;                \Open for input the file typed on command line
int  CpuReg, Handle;
char CmdTail($80);
[CpuReg:= GetReg;
Blit(CpuReg(11), $81, CpuReg(12), CmdTail, $7F);       \get copy of command line
Trap(false);                    \turn off error trapping
Handle:= FOpen(CmdTail, 0);     \open named file for input
FSet(Handle, ^I);               \assign file to input device 3
OpenI(3);                       \initialize input buffer pointers
if GetErr then return false;
Trap(true);
return true;
];

int  C, X, Y, Width, Height, Max, Lum;
real Red, Green, Blue;
[if not OpenInFile then [Text(0, "File not found");  exit];
if ChIn(3)#^P or ChIn(3)#^6 then [Text(0, "Not P6 PPM file");  exit];
repeat  loop    [C:= ChIn(3);
                if C # ^# then quit;
                repeat C:= ChIn(3) until C=$0A\EOL\;
                ];
until   C>=^0 & C<=^9;
Backup;                         \back up so IntIn re-reads first digit
Width:=  IntIn(3);              \(skips any whitespace)
Height:= IntIn(3);
Max:=    IntIn(3) + 1;          \(255/15=17; 256/16=16)
case of
  Width<= 640 & Height<=480: SetVid($112);
  Width<= 800 & Height<=600: SetVid($115);
  Width<=1024 & Height<=768: SetVid($118)
other SetVid($11B);             \1280x1024
for Y:= 0 to Height-1 do
    for X:= 0 to Width-1 do
        [Red  := float(ChIn(3)*256/Max) * 0.21; \convert color to grayscale
         Green:= float(ChIn(3)*256/Max) * 0.72;
         Blue := float(ChIn(3)*256/Max) * 0.07;
         Lum:= fix(Red) + fix(Green) + fix(Blue);
         Point(X, Y, Lum<<16 + Lum<<8 + Lum);
        ];
X:= ChIn(1);                    \wait for keystroke
SetVid(3);                      \restore normal text display
]


sub readPPM(f$)
	local ff, x, y, t$, dcol$, wid, hei

	if f$ = "" print "No PPM file name indicate." : return false

	ff = open (f$, "rb")
	if not ff print "File ", f$, " not found."  : return false

	input #ff t$, wid, hei, dcol$

	if t$ = "P6" then
		open window wid, hei

		for x = 0 to hei - 1
		 	for y = 0 to wid - 1
		 		color peek(#ff), peek(#ff), peek(#ff)
		 		dot y, x
		 	next y
		next x

		close #ff
	else
		print "File is NOT PPM P6 type." : return false
	end if

	return true
end sub


//24-bpp P6 PPM solution:
image:=File("lena.ppm","rb").read();
start:=image.find("\n255\n")+5;   // Get sizeof PPM header

foreach n in ([start..image.len()-1,3]){  //  Transform color triplets
   r,g,b:=image[n,3];  // Read colors stored in RGB order
   l:=(0.2126*r + 0.7152*g + 0.0722*b).toInt(); // Derive luminance
   image[n,3]=T(l,l,l);
}

File("lenaGrey.ppm","wb").write(image);


T Colour
   Byte r, g, b

   F (r, g, b)
      .r = r
      .g = g
      .b = b

   F ==(other)
      R .r == other.r & .g == other.g & .b == other.b

V black = Colour(0, 0, 0)
V white = Colour(255, 255, 255)

T Bitmap
   Int width, height
   Colour background
   [[Colour]] map

   F (width = 40, height = 40, background = white)
      assert(width > 0 & height > 0)
      .width = width
      .height = height
      .background = background
      .map = (0 .< height).map(h -> (0 .< @width).map(w -> @@background))

   F fillrect(x, y, width, height, colour = black)
      assert(x >= 0 & y >= 0 & width > 0 & height > 0)
      L(h) 0 .< height
         L(w) 0 .< width
            .map[y + h][x + w] = colour

   F chardisplay()
      V txt = .map.map(row -> row.map(bit -> (I bit == @@.background {‘ ’} E ‘@’)).join(‘’))
      txt = txt.map(row -> ‘|’row‘|’)
      txt.insert(0, ‘+’(‘-’ * .width)‘+’)
      txt.append(‘+’(‘-’ * .width)‘+’)
      print(reversed(txt).join("\n"))

   F set(x, y, colour = black)
      .map[y][x] = colour

   F get(x, y)
      R .map[y][x]

   F circle(x0, y0, radius, colour = black)
      V f = 1 - radius
      V ddf_x = 1
      V ddf_y = -2 * radius
      V x = 0
      V y = radius
      .set(x0, y0 + radius, colour)
      .set(x0, y0 - radius, colour)
      .set(x0 + radius, y0, colour)
      .set(x0 - radius, y0, colour)

      L x < y
         I f >= 0
            y--
            ddf_y += 2
            f += ddf_y
         x++
         ddf_x += 2
         f += ddf_x
         .set(x0 + x, y0 + y, colour)
         .set(x0 - x, y0 + y, colour)
         .set(x0 + x, y0 - y, colour)
         .set(x0 - x, y0 - y, colour)
         .set(x0 + y, y0 + x, colour)
         .set(x0 - y, y0 + x, colour)
         .set(x0 + y, y0 - x, colour)
         .set(x0 - y, y0 - x, colour)

V bitmap = Bitmap(25, 25)
bitmap.circle(x0' 12, y0' 12, radius' 12)
bitmap.chardisplay()


INCLUDE "H6:RGBCIRCL.ACT" ;from task Midpoint circle algorithm

RGB black,yellow,violet,blue

PROC DrawImage(RgbImage POINTER img BYTE x,y)
  RGB POINTER ptr
  BYTE i,j

  ptr=img.data
  FOR j=0 TO img.h-1
  DO
    FOR i=0 TO img.w-1
    DO
      IF RgbEqual(ptr,yellow) THEN
        Color=1
      ELSEIF RgbEqual(ptr,violet) THEN
        Color=2
      ELSEIF RgbEqual(ptr,blue) THEN
        Color=3
      ELSE
        Color=0
      FI
      Plot(x+i,y+j)
      ptr==+RGBSIZE
    OD
  OD
RETURN

PROC Main()
  RgbImage img
  BYTE CH=$02FC,width=[81],height=[51],st=[3]
  BYTE ARRAY ptr(12393)
  BYTE n
  INT x,y
  RGB POINTER col

  Graphics(7+16)
  SetColor(0,13,12) ;yellow
  SetColor(1,4,8)   ;violet
  SetColor(2,8,6)   ;blue
  SetColor(4,0,0)   ;black

  RgbBlack(black)
  RgbYellow(yellow)
  RgbViolet(violet)
  RgbBlue(blue)

  InitRgbImage(img,width,height,ptr)
  FillRgbImage(img,black)

  FOR n=0 TO height/st
  DO
    IF n MOD 3=0 THEN col=yellow
    ELSEIF n MOD 3=1 THEN col=violet
    ELSE col=blue FI
    RgbCircle(img,width/2,height/2,st*n,col)
  OD

  DrawImage(img,(160-width)/2,(96-height)/2)

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN


procedure Circle
          (  Picture : in out Image;
             Center  : Point;
             Radius  : Natural;
             Color   : Pixel
          )  is
   F     : Integer := 1 - Radius;
   ddF_X : Integer := 0;
   ddF_Y : Integer := -2 * Radius;
   X     : Integer := 0;
   Y     : Integer := Radius;
begin
   Picture (Center.X, Center.Y + Radius) := Color;
   Picture (Center.X, Center.Y - Radius) := Color;
   Picture (Center.X + Radius, Center.Y) := Color;
   Picture (Center.X - Radius, Center.Y) := Color;
   while X < Y loop
      if F >= 0 then
         Y := Y - 1;
         ddF_Y := ddF_Y + 2;
         F := F + ddF_Y;
      end if;
      X := X + 1;
      ddF_X := ddF_X + 2;
      F := F + ddF_X + 1;
      Picture (Center.X + X, Center.Y + Y) := Color;
      Picture (Center.X - X, Center.Y + Y) := Color;
      Picture (Center.X + X, Center.Y - Y) := Color;
      Picture (Center.X - X, Center.Y - Y) := Color;
      Picture (Center.X + Y, Center.Y + X) := Color;
      Picture (Center.X - Y, Center.Y + X) := Color;
      Picture (Center.X + Y, Center.Y - X) := Color;
      Picture (Center.X - Y, Center.Y - X) := Color;
   end loop;
end Circle;


# -*- coding: utf-8 -*- #

circle OF class image :=
          (  REF IMAGE picture,
             POINT center,
             INT radius,
             PIXEL color
          )VOID:
BEGIN
   INT f     := 1 - radius,
   POINT ddf := (0, -2 * radius),
         df := (0, radius);
   picture [x OF center, y OF center + radius] :=
   picture [x OF center, y OF center - radius] :=
   picture [x OF center + radius, y OF center] :=
   picture [x OF center - radius, y OF center] := color;
   WHILE x OF df < y OF df DO
      IF f >= 0 THEN
         y OF df -:= 1;
         y OF ddf +:= 2;
         f +:= y OF ddf
      FI;
      x OF df +:= 1;
      x OF ddf +:= 2;
      f +:= x OF ddf + 1;
      picture [x OF center + x OF df, y OF center + y OF df] :=
      picture [x OF center - x OF df, y OF center + y OF df] :=
      picture [x OF center + x OF df, y OF center - y OF df] :=
      picture [x OF center - x OF df, y OF center - y OF df] :=
      picture [x OF center + y OF df, y OF center + x OF df] :=
      picture [x OF center - y OF df, y OF center + x OF df] :=
      picture [x OF center + y OF df, y OF center - x OF df] :=
      picture [x OF center - y OF df, y OF center - x OF df] := color
   OD
END # circle #;

SKIP


#! /bin/bash
# Based on https://en.wikipedia.org/wiki/Midpoint_circle_algorithm

function putpixel {
    echo -en "\e[$2;$1H#"
}

function drawcircle {
    x0=$1
    y0=$2
    radius=$3

    for y in $( seq $((y0-radius)) $((y0+radius)) )
    do
        echo -en "\e[${y}H"
    	for x in $( seq $((x0+radius)) )
	do
		echo -n "-"
	done
    done

    x=$((radius-1))
    y=0
    dx=1
    dy=1
    err=$((dx-(radius<<1)))

    while [ $x -ge $y ]
    do
        putpixel $(( x0 + x )) $(( y0 + y ))
        putpixel $(( x0 + y )) $(( y0 + x ))
        putpixel $(( x0 - y )) $(( y0 + x ))
        putpixel $(( x0 - x )) $(( y0 + y ))
        putpixel $(( x0 - x )) $(( y0 - y ))
        putpixel $(( x0 - y )) $(( y0 - x ))
        putpixel $(( x0 + y )) $(( y0 - x ))
        putpixel $(( x0 + x )) $(( y0 - y ))

        if [ $err -le 0 ]
        then
	    ((++y))
            ((err+=dy))
            ((dy+=2))
        fi
        if [ $err -gt 0 ]
	then
            ((--x))
            ((dx+=2))
            ((err+=dx-(radius<<1)))
        fi
    done
}

clear
drawcircle 13 13 11
echo -en "\e[H"


fastgraphics
clg
color red
call DrawCircle(150,100,100)
refresh
color blue
call DrawCircle(200,200,50)
refresh

	#Function DrawCircle
	#1st param = X-coord of center
	#2nd param = Y-coord of center
	#3rd param = radius
Function DrawCircle(x0,y0,radius)
	x=radius
	y=0
	decisionOver2=1-x

	while x>=y
		plot( x + x0,  y + y0)
		plot( y + x0,  x + y0)
		plot(-x + x0,  y + y0)
		plot(-y + x0,  x + y0)
		plot(-x + x0, -y + y0)
		plot(-y + x0, -x + y0)
		plot( x + x0, -y + y0)
		plot( y + x0, -x + y0)

		y++

		if decisionOver2<=0 then
			decisionOver2+=2*y+1
		else
			x--
      			decisionOver2+=2*(y-x)+1
		end if
	end while
	return 0
End Function