#lang racket

; secret : (listof exact-nonnegative-integer?)
(define secret
  (foldr (λ (n result)
           (cons n (map (λ (y) (if (>= y n) (add1 y) y))
                        result)))
         '()
         (map random '(10 9 8 7))))

; (count-bulls/cows guess) -> (values exact-nonnegative-integer?
;                                     exact-nonnegative-integer?)
; guess : (listof exact-nonnegative-integer?)
(define (count-bulls/cows guess)
  (let* ([bulls (map = guess secret)]
         [cow-candidates (filter-map (λ (x y) (if (false? x) y #f))
                                      bulls
                                      secret)]
         [cows (filter (curryr member cow-candidates) guess)])
    (values (length (filter ((curry equal?) #t) bulls))
            (length cows))))

; (valid-guess guess-str) -> (or/c (listof exact-nonnegative-integer?) #f)
; guess-str : string?
(define (valid-guess guess-str)
  (define (char->digit c)
    (- (char->integer c) (char->integer #\0)))
  (if (regexp-match-exact? #px"[0-9]{4}" guess-str)
      (let ([guess (map char->digit (string->list guess-str))])
        (if (andmap (λ (x) (equal? (count ((curry equal?) x) guess) 1))
                    guess)
            guess
            #f))
      #f))

; Game states
(define win #t)
(define game #f)

; (main-loop state step) -> void?
; state : boolean?
; step  : exact-nonnegative-integer?
(define (main-loop state step)
  (if (equal? state win)
      (printf "You won after ~a guesses." step)
      (begin
        (let* ([guess-str (read-line)]
               [guess (valid-guess guess-str)])
          (if (false? guess)
              (begin (displayln "Guess should include exactly four different digits")
                     (main-loop state step))
              (let-values ([(bulls cows) (count-bulls/cows guess)])
                (if (= bulls 4)
                    (main-loop win (add1 step))
                    (begin (printf "Bulls: ~a Cows: ~a\n" bulls cows)
                           (main-loop state (add1 step))))))))))

(main-loop game 0)


my $size = 4;
my @secret = pick $size, '1' .. '9';

for 1..* -> $guesses {
    my @guess;
    loop {
        @guess = (prompt("Guess $guesses: ") // exit).comb;
        last if @guess == $size and
            all(@guess) eq one(@guess) & any('1' .. '9');
        say 'Malformed guess; try again.';
    }
    my ($bulls, $cows) = 0, 0;
    for ^$size {
        when @guess[$_] eq @secret[$_] { ++$bulls; }
        when @guess[$_] eq any @secret { ++$cows; }
    }
    last if $bulls == $size;
    say "$bulls bulls, $cows cows.";
}

say 'A winner is you!';


import Data.List
import Data.Char
import Control.Monad
import Control.Arrow
import System.Environment

int2bin :: Int -> [Int]
int2bin = unfoldr(\x -> if x==0 then Nothing
                          else Just (uncurry(flip(,)) (divMod x 2)))

bin2int :: [Int] -> Int
bin2int = foldr ((.(2 *)).(+)) 0

bitReader = map (chr.bin2int). takeWhile(not.null). unfoldr(Just. splitAt 7)
  . (take =<< (7 *) . (`div` 7) . length)

bitWriter xs =  tt ++ z00 where
  tt = concatMap (take 7.(++repeat 0).int2bin.ord) xs
  z00 = replicate (length xs `mod` 8) 0

main = do
  (xs:_) <- getArgs
  let bits = bitWriter xs

  putStrLn "Text to compress:"
  putStrLn $ '\t' : xs
  putStrLn $ "Uncompressed text length is " ++ show (length xs)
  putStrLn $ "Compressed text has " ++ show (length bits `div` 8) ++ " bytes."
  putStrLn "Read and decompress:"
  putStrLn $ '\t' : bitReader bits


-- helper function, simulates PHP's array_fill function
local array_fill = function(vbegin, vend, value)
    local t = {}
    for i=vbegin, vend do
        t[i] = value
    end
    return t
end

Bitmap = {}
Bitmap.__index = Bitmap

function Bitmap.new(width, height)
    local self = {}
    setmetatable(self, Bitmap)
    local white = array_fill(0, width, {255, 255, 255})
    self.data = array_fill(0, height, white)
    self.width = width
    self.height = height
    return self
end

function Bitmap:writeRawPixel(file, c)
    local dt
    dt = string.format("%c", c)
    file:write(dt)
end

function Bitmap:writeComment(fh, ...)
    local strings = {...}
    local str = ""
    local result
    for _, s in pairs(strings) do
        str = str .. tostring(s)
    end
    result = string.format("# %s\n", str)
    fh:write(result)
end

function Bitmap:writeP6(filename)
    local fh = io.open(filename, 'w')
    if not fh then
        error(string.format("failed to open %q for writing", filename))
    else
        fh:write(string.format("P6 %d %d 255\n", self.width, self.height))
        self:writeComment(fh, "automatically generated at ", os.date())
        for _, row in pairs(self.data) do
            for _, pixel in pairs(row) do
                self:writeRawPixel(fh, pixel[1])
                self:writeRawPixel(fh, pixel[2])
                self:writeRawPixel(fh, pixel[3])
            end
        end
    end
end

function Bitmap:fill(x, y, width, height, color)
    width = (width == nil) and self.width or width
    height = (height == nil) and self.height or height
    width = width + x
    height = height + y
    for i=y, height do
        for j=x, width do
            self:setPixel(j, i, color)
        end
    end
end

function Bitmap:setPixel(x, y, color)
    if x >= self.width then
        --error("x is bigger than self.width!")
        return false
    elseif x < 0 then
        --error("x is smaller than 0!")
        return false
    elseif y >= self.height then
        --error("y is bigger than self.height!")
        return false
    elseif y < 0 then
        --error("y is smaller than 0!")
        return false
    end
    self.data[y][x] = color
    return true
end

function example_colorful_stripes()
    local w = 260*2
    local h = 260*2
    local b = Bitmap.new(w, h)
    --b:fill(2, 2, 18, 18, {240,240,240})
    b:setPixel(0, 15, {255,68,0})
    for i=1, w do
        for j=1, h do
            b:setPixel(i, j, {
                    (i + j * 8) % 256,
                    (j + (255 * i)) % 256,
                    (i * j) % 256
                }
            );
        end
    end
    return b
end

example_colorful_stripes():writeP6('p6.ppm')


Red[]
a: "0123456789"
bulls: 0
random/seed now/time
number: copy/part random a 4
while [bulls <> 4] [
	bulls: 0
	cows: 0
	guess: ask "make a guess: "
	repeat i 4 [
		if (pick guess i) = (pick number i) [bulls: bulls + 1]
	]
	cows: (length? intersect guess number) - bulls
	print ["bulls: " bulls " cows: " cows]
]
print "You won!"


/*REXX program scores the   Bulls & Cows   game with  CBLFs  (Carbon Based Life Forms). */
?=; do  until length(?)==4;   r= random(1, 9)  /*generate a unique four-digit number.   */
    if pos(r,?)\==0  then iterate;  ?= ? || r  /*don't allow a repeated digit/numeral.  */
    end   /*until length*/                     /* [↑]  builds a unique four-digit number*/
$= '──────── [Bulls & Cows]  '                 /*a literal that is part of the prompt.  */
    do  until  bulls==4;      say              /*play until guessed  or  enters  "Quit".*/
    say $  'Please enter a 4-digit guess (with no zeroes)   [or Quit]:'
    pull n;  n=space(n, 0);   if abbrev('QUIT', n, 1)  then exit   /*user wants to quit?*/
    q=?;   L= length(n);   bulls= 0;   cows= 0 /*initialize some REXX variables.        */
        do j=1  for L;    if substr(n, j, 1)\==substr(q, j, 1)  then iterate  /*is bull?*/
        bulls= bulls +1;  q= overlay(., q, j)  /*bump the bull count;  disallow for cow.*/
        end   /*j*/                            /* [↑]  bull count───────────────────────*/
                                                                              /*is cow? */
        do k=1  for L;   _= substr(n, k, 1);           if pos(_, q)==0  then iterate
        cows=cows + 1;   q= translate(q, , _)  /*bump the cow count;  allow mult digits.*/
        end   /*k*/                            /* [↑]  cow  count───────────────────────*/
    say;                  @= 'You got'   bulls
    if L\==0  &  bulls\==4  then say $  @  'bull's(bulls)    "and"    cows   'cow's(cows).
    end   /*until bulls*/
                            say "          ┌─────────────────────────────────────────┐"
                            say "          │                                         │"
                            say "          │  Congratulations, you've guessed it !!  │"
                            say "          │                                         │"
                            say "          └─────────────────────────────────────────┘"
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
s:  if arg(1)==1  then return '';   return "s"   /*this function handles pluralization. */


function compress7(inio, outio)
    nextwritebyte = read(inio, UInt8) & 0x7f
    filled = 7
    while !eof(inio)
        inbyte = read(inio, UInt8)
        write(outio, UInt8(nextwritebyte | inbyte << filled))
        nextwritebyte = inbyte >> (8 - filled)
        filled = (filled + 7) % 8
        if filled == 0
            if eof(inio)
                break
            end
            nextwritebyte = read(inio, UInt8) & 0x7f
            filled = 7
        end
    end
    if filled != 0
        write(outio, UInt8(nextwritebyte))
    end
end

function expand7(inio, outio)
    newbyte = read(inio, UInt8)
    write(outio, UInt8(newbyte & 0x7f))
    residualbyte::UInt8 = newbyte >> 7
    filled = 1
    while !eof(inio)
        inbyte = read(inio, UInt8)
        write(outio, UInt8((residualbyte | inbyte << filled) & 0x7f))
        residualbyte = inbyte >> (7 - filled)
        filled = (filled + 1) % 7
        if filled == 0
            write(outio, UInt8(residualbyte & 0x7f))
            residualbyte = 0
        end
    end
end

str = b"These bit oriented I/O functions can be used to implement compressors and decompressors."
ins = IOBuffer(str)
outs = IOBuffer()
newouts = IOBuffer()
compress7(ins, outs)
seek(outs,0)
expand7(outs, newouts)
println("Initial string of length $(length(str)): ", String(ins.data))
println("Compressed to length $(length(outs.data)) on line below:\n", String(outs.data))
println("Decompressed string: ", String(newouts.data))


export image "test" to file "~/Test.PPM" as paint -- paint format is one of PBM, PGM, or PPM


Module Checkit {
      Function Bitmap (x as long, y as long) {
            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
            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
                  }
            }
            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 "A2.PPM" for Output as #F
            Call A.ToFile(F)
      Close #f
      ' is the same as this one
      Try {
            Open "A.PPM" for Output as #F
            Print #f, "P3"
            Print #f,"# Created using M2000 Interpreter"
            Print #f, 10;" ";10
            Print #f, 255
            For y=10-1 to 0 {
                  a$=""
                  For x=0 to 10-1 {
                        rgb=-A.GetPixel(x, y)
                        Print #f, a$;Binary.And(rgb, 0xFF); " ";
                        Print #f, Binary.And(Binary.Shift(rgb, -8), 0xFF); " ";
                        Print #f, Binary.Shift(rgb, -16);
                        a$=" "
                  }
                  Print #f
            }
            Close #f
      }
}
Checkit


# Project : Bulls and cows

secret = ""
while len(secret) != 4
        c = char(48 + random(9))
        if substr(secret, c) = 0
           secret = secret + c
        ok
end

see "guess a four-digit number with no digit used twice."
guesses = 0
guess = ""
while true
        guess = ""
        while len(guess) != 4
                see "enter your guess: "
                give guess
                if len(guess) != 4
                   see "must be a four-digit number" + nl
                ok
        end
        guesses = guesses + 1
        if guess = secret
           see "you won after " + guesses + " guesses!"
           exit
        ok
        bulls = 0
        cows = 0
        for i = 1 to 4
             c = secret[i]
             if guess[i] = c
                bulls = bulls + 1
             but substr(guess, c) > 0
                 cows = cows + 1
             ok
        next
        see "you got " + bulls + " bull(s) and " + cows + " cow(s)." + nl
end


def generate_word(len)
  [*"1".."9"].shuffle.first(len)        # [*"1".."9"].sample(len)  ver 1.9+
end

def get_guess(len)
  loop do
    print "Enter a guess: "
    guess = gets.strip
    err = case
          when guess.match(/[^1-9]/)             ; "digits only"
          when guess.length != len               ; "exactly #{len} digits"
          when guess.split("").uniq.length != len; "digits must be unique"
          else return guess.split("")
          end
    puts "the word must be #{len} unique digits between 1 and 9 (#{err}). Try again."
  end
end

def score(word, guess)
  bulls = cows = 0
  guess.each_with_index do |num, idx|
    if word[idx] == num
      bulls += 1
    elsif word.include? num
      cows += 1
    end
  end
  [bulls, cows]
end

word_length = 4
puts "I have chosen a number with #{word_length} unique digits from 1 to 9."
word = generate_word(word_length)
count = 0
loop do
  guess = get_guess(word_length)
  count += 1
  break if word == guess
  puts "that guess has %d bulls and %d cows" % score(word, guess)
end
puts "you guessed correctly in #{count} tries."


// version 1.2.31

import java.io.File

class BitFilter(val f: File, var accu: Int = 0, var bits: Int = 0) {

    private val bw = f.bufferedWriter()
    private val br = f.bufferedReader()

    fun write(buf: ByteArray, start: Int, _nBits: Int, _shift: Int) {
        var nBits = _nBits
        var index = start + _shift / 8
        var shift = _shift % 8

        while (nBits != 0 || bits >= 8) {
            while (bits >= 8) {
                bits -= 8
                bw.write(accu ushr bits)
                accu = accu and ((1 shl bits) - 1)
            }
            while (bits < 8 && nBits != 0) {
                val b = buf[index].toInt()
                accu = (accu shl 1) or (((128 ushr shift) and b) ushr (7 - shift))
                nBits--
                bits++
                if (++shift == 8) { shift = 0; index++ }
            }
        }
    }

    fun read(buf: ByteArray, start: Int, _nBits: Int, _shift: Int) {
        var nBits = _nBits
        var index = start + _shift / 8
        var shift = _shift % 8

        while (nBits != 0) {
            while (bits != 0 && nBits != 0) {
                val mask = 128 ushr shift
                if ((accu and (1 shl (bits - 1))) != 0)
                    buf[index] = (buf[index].toInt() or mask).toByte()
                else
                    buf[index] = (buf[index].toInt() and mask.inv()).toByte()
                nBits--
                bits--
                if (++shift >= 8) { shift = 0; index++ }
            }
            if (nBits == 0) break
            accu = (accu shl 8) or br.read()
            bits += 8
        }
    }

    fun closeWriter() {
        if (bits != 0) {
            accu = (accu shl (8 - bits))
            bw.write(accu)
        }
        bw.close()
        accu = 0
        bits = 0
    }

    fun closeReader() {
        br.close()
        accu = 0
        bits = 0
    }
}

fun main(args: Array<String>) {
    val s = "abcdefghijk".toByteArray(Charsets.UTF_8)
    val f = File("test.bin")
    val bf = BitFilter(f)

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

    /* read 7 bits and expand to each byte of s2 skipping 1 bit */
    val s2 = ByteArray(s.size)
    for (i in 0 until s2.size) bf.read(s2, i, 7, 1)
    bf.closeReader()
    println(String(s2, Charsets.UTF_8))
}


INTERFACE PPM;

IMPORT Bitmap, Pathname;

PROCEDURE Create(imgfile: Pathname.T; img: Bitmap.T);

END PPM.


import bitmap
import streams

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

proc writePPM*(img: Image, stream: Stream) =
  ## Write an image to a PPM stream.

  stream.writeLine("P6 ", $img.w, " ", $img.h, " 255")

  for x, y in img.indices:
    stream.write(chr(img[x, y].r))
    stream.write(chr(img[x, y].g))
    stream.write(chr(img[x, y].b))

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

proc writePPM*(img: Image; filename: string) =
  ## Write an image in a PPM file.

  var file = openFileStream(filename, fmWrite)
  img.writePPM(file)
  file.close()

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

when isMainModule:
  var image = newImage(100, 50)
  image.fill(color(255, 0, 0))
  for row in 10..20:
    for col in 0..<image.w:
      image[col, row] = color(0, 255, 0)
  for row in 30..40:
    for col in 0..<image.w:
      image[col, row] = color(0, 0, 255)
  image.writePPM("output.ppm")


let output_ppm ~oc ~img:(_, r_channel, g_channel, b_channel) =
  let width = Bigarray.Array2.dim1 r_channel
  and height = Bigarray.Array2.dim2 r_channel in
  Printf.fprintf oc "P6\n%d %d\n255\n" width height;
  for y = 0 to pred height do
    for x = 0 to pred width do
      output_char oc (char_of_int r_channel.{x,y});
      output_char oc (char_of_int g_channel.{x,y});
      output_char oc (char_of_int b_channel.{x,y});
    done;
  done;
  output_char oc '\n';
  flush oc;
;;


use std::io;
use rand::{Rng,thread_rng};

extern crate rand;

const NUMBER_OF_DIGITS: usize = 4;

static DIGITS: [char; 9] = ['1', '2', '3', '4', '5', '6', '7', '8', '9'];

fn generate_digits() -> Vec<char> {
    let mut temp_digits: Vec<_> = (&DIGITS[..]).into();
    thread_rng().shuffle(&mut temp_digits);
    return temp_digits.iter().take(NUMBER_OF_DIGITS).map(|&a| a).collect();
}

fn parse_guess_string(guess: &str) -> Result<Vec<char>, String> {
    let chars: Vec<char> = (&guess).chars().collect();

    if !chars.iter().all(|c| DIGITS.contains(c)) {
        return Err("only digits, please".to_string());
    }

    if chars.len() != NUMBER_OF_DIGITS {
        return Err(format!("you need to guess with {} digits", NUMBER_OF_DIGITS));
    }

    let mut uniques: Vec<char> = chars.clone();
    uniques.dedup();
    if uniques.len() != chars.len() {
        return Err("no duplicates, please".to_string());
    }

    return Ok(chars);
}

fn calculate_score(given_digits: &[char], guessed_digits: &[char]) -> (usize, usize) {
    let mut bulls = 0;
    let mut cows = 0;
    for i in 0..NUMBER_OF_DIGITS {
        let pos: Option<usize> = guessed_digits.iter().position(|&a| -> bool {a == given_digits[i]});
        match pos {
            None              => (),
            Some(p) if p == i => bulls += 1,
            Some(_)           => cows += 1
        }
    }
    return (bulls, cows);
}

fn main() {
    let reader = io::stdin();

    loop {
        let given_digits = generate_digits();
        println!("I have chosen my {} digits. Please guess what they are", NUMBER_OF_DIGITS);

        loop {
            let guess_string: String = {
                let mut buf = String::new();
                reader.read_line(&mut buf).unwrap();
                buf.trim().into()
            };

            let digits_maybe = parse_guess_string(&guess_string);
            match digits_maybe {
                Err(msg) => {
                    println!("{}", msg);
                    continue;
                },
                Ok(guess_digits) => {
                    match calculate_score(&given_digits, &guess_digits) {
                        (NUMBER_OF_DIGITS, _) => {
                            println!("you win!");
                            break;
                        },
                        (bulls, cows) => println!("bulls: {}, cows: {}", bulls, cows)
                    }
                }
            }
        }
    }
}


import scala.util.Random

object BullCow {
   def main(args: Array[String]): Unit = {
      val number=chooseNumber
      var guessed=false
      var guesses=0

      while(!guessed){
         Console.print("Guess a 4-digit number with no duplicate digits: ")
         val input=Console.readInt
         val digits=input.toString.map(_.asDigit).toList
         if(input>=1111 && input<=9999 && !hasDups(digits)){
            guesses+=1
            var bulls, cows=0
            for(i <- 0 to 3)
               if(number(i)==digits(i))
                  bulls+=1
               else if(number.contains(digits(i)))
                  cows+=1

            if(bulls==4)
               guessed=true
            else
               println("%d Cows and %d Bulls.".format(cows, bulls))
         }
      }
      println("You won after "+guesses+" guesses!");
   }

   def chooseNumber={
      var digits=List[Int]()
      while(digits.size<4){
         val d=Random.nextInt(9)+1
         if (!digits.contains(d))
            digits=digits:+d
      }
      digits
   }

   def hasDups(input:List[Int])=input.size!=input.distinct.size
}


-- parent script "BitArray"

property ancestor
property bitSize
property _pow2

----------------------------------------
-- @constructor
-- @param {integer} [bSize=0]
----------------------------------------
on new (me, bSize)
  if voidP(bitSize) then bitSize=0
  me.bitSize = bSize
  byteSize = bitSize/8 + (bitSize mod 8>0)
  me._pow2 = [128,64,32,16,8,4,2,1] -- pow2 lookup list
  me.ancestor = ByteArray(byteSize)
  return me
end

----------------------------------------
-- Sets bit at position <bitPos> to <bitValue>.
-- @param {integer} bitPos - starts at 1, as ByteArray's native byte access functions
-- @param {boolean} bitValue
----------------------------------------
on setBit (me, bitPos, bitValue)
  bytePos = (bitPos-1)/8 + 1
  bitPos = (bitPos-1) mod 8 + 1
  if bitValue then
    me[bytePos] = bitOr(me[bytePos], me._pow2[bitPos])
  else
    me[bytePos] = bitAnd(me[bytePos], bitNot(me._pow2[bitPos]))
  end if
end

----------------------------------------
-- Gets bit value at position <bitPos>.
-- @param {integer} bitPos - starts at 1, as ByteArray's native byte access functions
-- @return {boolean} bitValue
----------------------------------------
on getBit (me, bitPos)
  bytePos = (bitPos-1)/8 + 1
  bitPos = (bitPos-1) mod 8 + 1
  return bitAnd(me[bytePos], me._pow2[bitPos])<>0
end

----------------------------------------
-- Returns all bits as string. To be in accordance with ByteArray's native toHexString(),
-- returned string is separated with SPACE (e.g. "0 1 1 0...")
-- @param {integer} [bitSizeOnly=FALSE] - if TRUE, only <bitSize> bits without byte-padding
-- @return {string}
----------------------------------------
on toBinString (me, bitSizeOnly)
  res = ""
  repeat with i = 1 to me.length
    byte = me[i]
    repeat with j = 1 to 8
      put (bitAnd(byte, me._pow2[j])<>0)&" " after res
      if bitSizeOnly and (i-1)*8+j=me.bitSize then exit repeat
    end repeat
  end repeat
  delete the last char of res
  return res
end


local function BitWriter() return {
    accumulator = 0, -- For current byte.
    bitCount    = 0, -- Bits set in current byte.
    outChars    = {},

    -- writer:writeBit( bit )
    writeBit = function(writer, bit)
        writer.bitCount = writer.bitCount + 1
        if bit > 0 then
            writer.accumulator = writer.accumulator + 2^(8-writer.bitCount)
        end
        if writer.bitCount == 8 then
            writer:_flush()
        end
    end,

    -- writer:writeLsb( value, width )
    writeLsb = function(writer, value, width)
        for i = 1, width do
            writer:writeBit(value%2)
            value = math.floor(value/2)
        end
    end,

    -- dataString = writer:getOutput( )
    getOutput = function(writer)
        writer:_flush()
        return table.concat(writer.outChars)
    end,

    _flush = function(writer)
        if writer.bitCount == 0 then  return  end

        table.insert(writer.outChars, string.char(writer.accumulator))
        writer.accumulator = 0
        writer.bitCount    = 0
    end,
} end

local function BitReader(data) return {
    bitPosition = 0, -- Absolute position in 'data'.

    -- bit = reader:readBit( ) -- Returns nil at end-of-data.
    readBit = function(reader)
        reader.bitPosition = reader.bitPosition + 1
        local bytePosition = math.floor((reader.bitPosition-1)/8) + 1

        local byte = data:byte(bytePosition)
        if not byte then  return nil  end

        local bitIndex = ((reader.bitPosition-1)%8) + 1
        return math.floor(byte / 2^(8-bitIndex)) % 2
    end,

    -- value = reader:readLsb( width ) -- Returns nil at end-of-data.
    readLsb = function(reader, width)
        local accumulator = 0

        for i = 1, width do
            local bit = reader:readBit()
            if not bit then  return nil  end

            if bit > 0 then
                accumulator = accumulator + 2^(i-1)
            end
        end

        return accumulator
    end,
} end


functor
import
   Bitmap
   Open
export
   %% Read
   Write
define
   %% Omitted: Read

   proc {Write B=bitmap(array2d(width:W height:H ...)) Filename}
      F = {New Open.file init(name:Filename flags:[write create truncate binary])}

      proc {WriteColor8 color(R G B)}
	 {F write(vs:[R G B])}
      end

      fun {ToBytes C}
	 [C div 0x100  C mod 0x100]
      end

      proc {WriteColor16 color(R G B)}
	 {F write(vs:{Flatten {Map [R G B] ToBytes}})}
      end

      MaxCol = {Bitmap.maxValue B}
      MaxVal#Writer = if MaxCol =< 0xff then 0xff#WriteColor8
		      else 0xffff#WriteColor16
		      end
      Header = "P6\n"#W#" "#H#" "#MaxVal#"\n"
   in
      try
	 {F write(vs:Header)}
	 {Bitmap.forAllPixels B Writer}
      finally
	 {F close}
      end
   end
end


use Imager;

$image = Imager->new(xsize => 200, ysize => 200);
$image->box(filled => 1, color => red);
$image->box(filled => 1, color => black,
            xmin =>  50, ymin =>  50,
            xmax => 150, ymax => 150);
$image->write(file => 'bitmap.ppm') or die $image->errstr;


;generate a random non-repeating list of 4 digits, 1-9 inclusive
(define (get-num)
  (define (gen lst)
    (if (= (length lst) 4) lst
        (let ((digit (+ (random 9) 1)))
          (if (member digit lst) ;make sure the new digit isn't in the
                                 ;list
              (gen lst)
              (gen (cons digit lst))))))
  (string->list (apply string-append (map number->string (gen '())))))

;is g a valid guess (that is, non-repeating, four digits 1-9
;inclusive?)
(define (valid-guess? g)
  (let ((g-num (string->number (apply string g))))
    ;does the same digit appear twice in lst?
    (define (repeats? lst)
      (cond ((null? lst) #f)
            ((member (car lst) (cdr lst)) #t)
            (else (repeats? (cdr lst)))))
    (and g-num
         (> g-num 1233)
         (< g-num 9877)
         (not (repeats? g)))))

;return '(cows bulls) for the given guess
(define (score answer guess)
  ;total cows + bulls
  (define (cows&bulls a g)
    (cond ((null? a) 0)
          ((member (car a) g) (+ 1 (cows&bulls (cdr a) g)))
          (else (cows&bulls (cdr a) g))))
  ;bulls only
  (define (bulls a g)
    (cond ((null? a) 0)
          ((equal? (car a) (car g)) (+ 1 (bulls (cdr a) (cdr g))))
          (else (bulls (cdr a) (cdr g)))))
  (list (- (cows&bulls answer guess) (bulls answer guess)) (bulls answer guess)))

;play the game
(define (bull-cow answer)
  ;get the user's guess as a list
  (define (get-guess)
    (let ((e (read)))
      (if (number? e)
          (string->list (number->string e))
          (string->list (symbol->string e)))))
  (display "Enter a guess: ")
  (let ((guess (get-guess)))
    (if (valid-guess? guess)
        (let ((bulls (cadr (score answer guess)))
              (cows (car (score answer guess))))
          (if (= bulls 4)
              (display "You win!\n")
              (begin
                (display bulls)
                (display " bulls, ")
                (display cows)
                (display " cows.\n")
                (bull-cow answer))))
        (begin
          (display "Invalid guess.\n")
          (bull-cow answer)))))

(bull-cow (get-num))


type
  BitWriter * = tuple
    file: File
    bits: uint8
    nRemain: int

  BitReader * = tuple
    file: File
    bits: uint8
    nRemain: int
    nRead: int

proc newBitWriter * (file: File) : ref BitWriter =
  result = new BitWriter
  result.file = file
  result.bits = 0
  result.nRemain = 8

proc flushBits (stream : ref BitWriter) =
  discard stream.file.writeBuffer(stream.bits.addr, 1)
  stream.nRemain = 8
  stream.bits = 0

proc write * (stream: ref BitWriter, bits: uint8, nBits: int) =
  assert(nBits <= 8)

  for ii in countdown((nBits - 1), 0) :
    stream.bits = (stream.bits shl 1) or ((bits shr ii) and 1)
    stream.nRemain.dec(1)
    if stream.nRemain == 0:
      stream.flushBits

proc flush * (stream: ref BitWriter) =
  if stream.nRemain < 8:
    stream.bits = stream.bits shl stream.nRemain
    stream.flushBits

proc newBitReader * (file: File) : ref BitReader =
  result = new BitReader
  result.file = file
  result.bits = 0
  result.nRemain = 0
  result.nRead = 0

proc read * (stream: ref BitReader, nBits: int) : uint8 =
  assert(nBits <= 8)

  result = 0
  for ii in 0 ..< nBits :
    if stream.nRemain == 0:
      stream.nRead = stream.file.readBuffer(stream.bits.addr, 1)
      if stream.nRead == 0:
        break
      stream.nRemain = 8

    result = (result shl 1) or ((stream.bits shr 7) and 1)

    stream.bits = stream.bits shl 1
    stream.nRemain.dec(1)

when isMainModule:
  var
    file: File
    writer: ref BitWriter
    reader: ref BitReader

  file = open("testfile.dat", fmWrite)
  writer = newBitWriter(file)

  for ii in 0 .. 255:
    writer.write(ii.uint8, 7)

  writer.flush
  file.close

  var dataCtr = 0

  file = open("testfile.dat", fmRead)
  reader = newBitReader(file)

  while true:
    let aByte = reader.read(7)

    if reader.nRead == 0:
      break

    assert((dataCtr and 0x7f).uint8 == aByte)

    inc dataCtr

  assert(dataCtr == 256)

  file.close

  echo "OK"


-- demo\rosetta\Bitmap_write_ppm.exw
constant dimx = 512, dimy = 512
constant fn = open("first.ppm","wb") -- b - binary mode
sequence color
printf(fn, "P6\n%d %d\n255\n", {dimx,dimy})
for y=0 to dimy-1 do
    for x=0 to dimx-1 do
        color = {remainder(x,256),   -- red
                 remainder(y,256),   -- green
                 remainder(x*y,256)} -- blue
        puts(fn,color)
    end for
end for
close(fn)


class Bitmap {
  public $data;
  public $w;
  public $h;
  public function __construct($w = 16, $h = 16){
    $white = array_fill(0, $w, array(255,255,255));
    $this->data = array_fill(0, $h, $white);
    $this->w = $w;
    $this->h = $h;
  }
  //Fills a rectangle, or the whole image with black by default
  public function fill($x = 0, $y = 0, $w = null, $h = null, $color = array(0,0,0)){
    if (is_null($w)) $w = $this->w;
    if (is_null($h)) $h = $this->h;
    $w += $x;
    $h += $y;
    for ($i = $y; $i < $h; $i++){
      for ($j = $x; $j < $w; $j++){
        $this->setPixel($j, $i, $color);
      }
    }
  }
  public function setPixel($x, $y, $color = array(0,0,0)){
    if ($x >= $this->w) return false;
    if ($x < 0) return false;
    if ($y >= $this->h) return false;
    if ($y < 0) return false;
    $this->data[$y][$x] = $color;
  }
  public function getPixel($x, $y){
    return $this->data[$y][$x];
  }
  public function writeP6($filename){
    $fh = fopen($filename, 'w');
    if (!$fh) return false;
    fputs($fh, "P6 {$this->w} {$this->h} 255\n");
    foreach ($this->data as $row){
      foreach($row as $pixel){
        fputs($fh, pack('C', $pixel[0]));
        fputs($fh, pack('C', $pixel[1]));
        fputs($fh, pack('C', $pixel[2]));
      }
    }
    fclose($fh);
  }
}

$b = new Bitmap(16,16);
$b->fill();
$b->fill(2, 2, 18, 18, array(240,240,240));
$b->setPixel(0, 15, array(255,0,0));
$b->writeP6('p6.ppm');


$ include "seed7_05.s7i";

const proc: main is func
  local
    const integer: size is 4;
    var set of char: digits is {'1' .. '9'};
    var string: chosen is " " mult size;
    var integer: guesses is 0;
    var string: guess is "";
    var integer: pos is 0;
    var integer: bulls is 0;
    var integer: cows is 0;
    var boolean: okay is FALSE;
  begin
    for pos range 1 to 4 do
      chosen @:= [pos] rand(digits);
      excl(digits, chosen[pos]);
    end for;
    writeln("I have chosen a number from " <& size <& " unique digits from 1 to 9 arranged in a random order.");
    writeln("You need to input a " <& size <& " digit, unique digit number as a guess at what I have chosen");
    repeat
      incr(guesses);
      repeat
        write("Next guess [" <& guesses <& "]: ");
        readln(guess);
        okay := length(guess) = size;
        for key pos range guess do
          okay := okay and guess[pos] in {'1' .. '9'} and pos(guess[succ(pos) ..], guess[pos]) = 0;
        end for;
        if not okay then
          writeln("Problem, try again. You need to enter " <& size <& " unique digits from 1 to 9");
        end if;
      until okay;
      if guess <> chosen then
        bulls := 0;
        cows := 0;
        for key pos range chosen do
          if guess[pos] = chosen[pos] then
            incr(bulls);
          elsif pos(chosen, guess[pos]) <> 0 then
            incr(cows);
          end if;
        end for;
        writeln("  " <& bulls <& " Bulls");
        writeln("  " <& cows <& " Cows");
      end if;
    until guess = chosen;
    writeln("Congratulations you guessed correctly in " <& guesses <& " attempts");
  end func;


let write_7bit_string ~filename ~str =
  let oc = open_out filename in
  let ob = IO.output_bits(IO.output_channel oc) in
  String.iter (fun c -> IO.write_bits ob 7 (int_of_char c)) str;
  IO.flush_bits ob;
  close_out oc;
;;


#! /usr/bin/perl

use strict;

# $buffer = write_bits(*STDOUT, $buffer, $number, $bits)
sub write_bits( $$$$ )
{
    my ($out, $l, $num, $q) = @_;
    $l .= substr(unpack("B*", pack("N", $num)),
         -$q);
    if ( (length($l) > 8) ) {
    my $left = substr($l, 8);
    print $out pack("B8", $l);
    $l = $left;
    }
    return $l;
}

# flush_bits(*STDOUT, $buffer)
sub flush_bits( $$ )
{
    my ($out, $b) = @_;
    print $out pack("B*", $b);
}

# ($val, $buf) = read_bits(*STDIN, $buf, $n)
sub read_bits( $$$ )
{
    my ( $in, $b, $n ) = @_;
    # we put a limit in the number of bits we can read
    # with one shot; this should mirror the limit of the max
    # integer value perl can hold
    if ( $n > 32 ) { return 0; }
    while ( length($b) < $n ) {
    my $v;
    my $red = read($in, $v, 1);
    if ( $red < 1 ) { return ( 0, -1 ); }
    $b .= substr(unpack("B*", $v), -8);
    }
    my $bits = "0" x ( 32-$n ) . substr($b, 0, $n);
    my $val = unpack("N", pack("B32", $bits));
    $b = substr($b, $n);
    return ($val, $b);
}


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 set(x, y, colour = black)
      .map[y][x] = colour

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

   F togreyscale()
      L(h) 0 .< .height
         L(w) 0 .< .width
            V (r, g, b) = .get(w, h)
            V l = Int(0.2126 * r + 0.7152 * g + 0.0722 * b)
            .set(w, h, Colour(l, l, l))

   F writeppmp3()
      V magic = "P3\n"
      V comment = "# generated from Bitmap.writeppmp3\n"
      V s = magic‘’comment‘’("#. #.\n#.\n".format(.width, .height, 255))
      L(h) (.height - 1 .< -1).step(-1)
         L(w) 0 .< .width
            V (r, g, b) = .get(w, h)
            s ‘’= ‘   #3 #3 #3’.format(r, g, b)
         s ‘’= "\n"
      R s

F tokenize(fstr)
   [String] tokens
   L(line) fstr.split("\n")
      I !line.starts_with(‘#’)
         L(t) line.split(‘ ’, group_delimiters' 1B)
            tokens.append(t)
   R tokens

F ppmp3tobitmap(fstr)
   V tokens = tokenize(fstr)
   V tokeni = -1
   F nexttoken()
      @tokeni++
      R @tokens[@tokeni]
   assert(‘P3’ == nexttoken(), ‘Wrong filetype’)
   V width  = Int(nexttoken())
   V height = Int(nexttoken())
   V maxval = Int(nexttoken())
   V bitmap = Bitmap(width, height, Colour(0, 0, 0))
   L(h) (height - 1 .< -1).step(-1)
      L(w) 0 .< width
         V r = Int(nexttoken())
         V g = Int(nexttoken())
         V b = Int(nexttoken())
         bitmap.set(w, h, Colour(r, g, b))

   R bitmap

V 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
             ’

V bitmap = ppmp3tobitmap(ppmtxt)
print(‘Grey PPM:’)
bitmap.togreyscale()
print(bitmap.writeppmp3())


(de ppmWrite (Ppm File)
   (out File
      (prinl "P6")
      (prinl (length (car Ppm)) " " (length Ppm))
      (prinl 255)
      (for Y Ppm (for X Y (apply wr X))) ) )


/* BITMAP FILE: write out a file in PPM format, P6 (binary). 14/5/2010 */
test: procedure options (main);
   declare image (0:19,0:19) bit (24);
   declare 1 pixel union,
            2 color bit (24) aligned,
            2 primaries,
               3 R character (1),
               3 G character (1),
               3 B character (1);
   declare ch character (1);
   declare (i, j) fixed binary;
   declare out file record;

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

   ch = 'P'; write file (out) from (ch);
   ch = '6'; write file (out) from (ch);

   call put_integer (hbound(image, 1));
   call put_integer (hbound(image, 2));
   call put_integer (255);

   do i = 0 to hbound(image,1);
      do j = 0 to hbound(image, 2);
         color = image(i,j);
         write file (out) from (R);
         write file (out) from (G);
         write file (out) from (B);
      end;
   end;

put_integer: procedure (k);
   declare k fixed binary;
   declare s character (30) varying;
   declare i fixed binary;
   declare ch character (1);

   s = k;
   s = trim(s);
   do i = 1 to length(s);
      ch = substr(s, i, 1);
      write file (out) from (ch);
   end;
   ch = '09'x;
   write file (out) from (ch);
end put_integer;
end test;


:- module(bitmapIO, [
	write_ppm_p6/2]).

:- use_module(library(lists)).

%write_ppm_p6(File,Bitmap)
write_ppm_p6(Filename,[[X,Y],Pixels]):-
	open(Filename,write,Output,[encoding(octet)]),
	%write p6 header
	writeln(Output, 'P6'),
	atomic_list_concat([X, Y], ' ', Dimensions),
	writeln(Output, Dimensions),
	writeln(Output, '255'),
	%write bytes
	maplist(maplist(maplist(put_byte(Output))),Pixels),
	close(Output).


repeat forever
	repeat forever
		put random(1111,9999) into num
		if character 1 of num is not equal to character 2 of num
			if character 1 of num is not equal to character 3 of num
				if character 1 of num is not equal to character 4 of num
					if character 2 of num is not equal to character 3 of num
						if character 2 of num is not equal to character 4 of num
							if character 3 of num is not equal to character 4 of num
								if num does not contain 0
									exit repeat
								end if
							end if
						end if
					end if
				end if
			end if
		end if
	end repeat
	set description to "Guess the 4 digit number" & newline & "- zero's excluded" & newline & "- each digit is unique" & newline & newline & "Receive 1 Bull for each digit that equals the corresponding digit in the random number." & newline & newline & "Receive 1 Cow for each digit that appears in the wrong position." & newline
	repeat forever
		repeat forever
			Ask "Guess the number" title "Bulls & Cows" message description
			put it into guess
			if number of characters in guess is equal to 4
				exit repeat
			else if guess is ""
				Answer "" with "Play" or "Quit" title "Quit Bulls & Cows?"
				put it into myAnswer
				if myAnswer is "Quit"
					exit all
				end if
			end if
		end repeat
		set score to {
			bulls: {
				qty: 0,
				values: []
			},
			cows: {
				qty: 0,
				values: []
			}
		}
		repeat the number of characters in num times
			if character the counter of guess is equal to character the counter of num
				add 1 to score.bulls.qty
				insert character the counter of guess into score.bulls.values
			else
				if num contains character the counter of guess
					if character the counter of guess is not equal to character the counter of num
						if score.bulls.values does not contain character the counter of guess and score.cows.values does not contain character the counter of guess
							add 1 to score.cows.qty
							insert character the counter of guess into score.cows.values
						end if
					end if
				end if
			end if
		end repeat
		set showScores to "Your score is:" & newline & newline & "Bulls:" && score.bulls.qty & newline & newline & "Cows:" && score.cows.qty
		if guess is not equal to num
			Answer showScores with "Guess Again" or "Quit" title "Score"
			put it into myAnswer
			if myAnswer is "Quit"
				exit all
			end if
		else
			set winShowScores to showScores & newline & newline & "Your Guess:" && guess & newline & "Random Number:" && num & newline
			Answer winShowScores with "Play Again" or "Quit" title "You Win!"
			put it into myAnswer
			if myAnswer is "Quit"
				exit all
			end if
			exit repeat
		end if
	end repeat
end repeat


#!/usr/local/bin/shale

maths library
file library
string library

n0 var
n1 var
n2 var
n3 var
g0 var
g1 var
g2 var
g3 var

init dup var {
  c guess:: var
} =

getNum dup var {
  random maths::() 15 >> 9 % 1 +
} =

game dup var {
  haveWon dup var false =
  ans var
  i var
  c var
  b var

  c guess:: 0 =

  n0 getNum() =
  n1 getNum() =
  { n1 n0 == } {
    n1 getNum() =
  } while
  n2 getNum() =
  { n2 n0 == n2 n1 == or } {
    n2 getNum() =
  } while
  n3 getNum() =
  { n3 n0 == n3 n1 == n3 n2 == or or } {
    n3 getNum() =
  } while

  "New game" println
  { haveWon not } {
    "> " print
    stdin file:: fgets file::() {
      ans swap atoi string::() =
      g3 ans 10 % =
      g2 ans 10 / 10 % =
      g1 ans 100 / 10 % =
      g0 ans 1000 / 10 % =
      g0 0 > g0 10 < and g1 0 > g1 10 < and g2 0 > g2 10 < and g3 0 > g3 10 < and and and and {
        c 0 =
        b 0 =

        g0 n0 == {
          b++
        } {
          g0 n1 == g0 n2 == g0 n3 == or or { c++ } ifthen
        } if

        g1 n1 == {
          b++
        } {
          g1 n0 == g1 n2 == g1 n3 == or or { c++ } ifthen
        } if

        g2 n2 == {
          b++
        } {
          g2 n0 == g2 n1 == g2 n3 == or or { c++ } ifthen
        } if

        g3 n3 == {
          b++
        } {
          g3 n0 == g3 n1 == g3 n2 == or or { c++ } ifthen
        } if

        i c guess:: =
        i.value guess:: guess:: defined not {
          i.value guess:: guess:: var
          i.value cow:: guess:: var
          i.value bull:: guess:: var
        } ifthen
        i.value guess:: guess:: ans =
        i.value cow:: guess:: c =
        i.value bull:: guess:: b =
        c guess::++

        "Go  Guess Cows Bulls" println
        i 0 =
        { i c guess:: < } {
          i.value bull:: guess:: i.value cow:: guess:: i.value guess:: guess:: i 1 + "%2d  %d  %4d %5d\n" printf
          i++
        } while

        b 4 == { haveWon true = } ifthen
      } {
        "Illegal input" println
      } if
    } {
      0 exit
    } if
  } while

} =

play dup var {
  { true } {
    game()
  } while
} =

init()
play()


without js -- (file i/o)
enum FN, V, BITS -- fields of a bitwiseioreader/writer

function new_bitwiseio(string filename, mode)
    integer fn = open(filename,mode)
    return {fn,0,0}     -- ie {FN,V=0,BITS=0}
end function

function new_bitwiseiowriter(string filename)
    return new_bitwiseio(filename,"wb")
end function

function new_bitwiseioreader(string filename)
    return new_bitwiseio(filename,"rb")
end function

function write_bits(sequence writer, integer v, bits)
    integer {fn,wv,wb} = writer,
            p2 = power(2,bits), ch
    if v!=and_bits(v,p2*2-1) then ?9/0 end if
    wv = wv*p2+v
    wb += bits
    while wb>=8 do
        wb -= 8
        p2 = power(2,wb)
        ch = floor(wv/p2)
        puts(fn,ch)
        wv -= ch*p2
    end while
    if wv>=#100 then ?9/0 end if
    if wb>=8 then ?9/0 end if
    writer[V]= wv
    writer[BITS]= wb
    return writer
end function

function close_bitwiseiowriter(sequence writer)
    integer {fn,wv,wb} = writer
    if wb then
        if wb>=8 then ?9/0 end if -- sanity check
        writer = write_bits(writer,0,8-wb)
    end if
    if writer[V]!=0 then ?9/0 end if
    if writer[BITS]!=0 then ?9/0 end if
    close(fn)
    writer[FN]=-1
    return writer
end function

function read_bits(sequence reader, integer bits)
    integer {fn,rv,rb} = reader, ch, p2
    while bits>rb do
        ch = getc(fn)
        if ch=-1 then return {-1,reader} end if
        rv = rv*#100+ch
        rb += 8
    end while
    rb -= bits
    p2 = power(2,rb)
    ch = floor(rv/p2)
    rv -= ch*p2
    reader[V]= rv
    reader[BITS]= rb
    return {ch,reader}
end function

function as_hexb(string s, fmt="%02x ")
-- helper funtion, returns hex string, or binary if fmt="%08b "
    string res = ""
    for i=1 to length(s) do
        res &= sprintf(fmt,s[i])
    end for
    return trim(res)
end function

constant test = "This is a test."
--constant test = "This is a test"
--constant test = "abcdefghijk"
--constant test = "STRING"
--constant test = "This is an ascii string that will be crunched, written, read and expanded."
printf(1,"\"%s\" as bytes: %s (length %d)\n",{test,as_hexb(test),length(test)})
printf(1,"    original bits: %s\n",{as_hexb(test,"%08b ")})

sequence writer = new_bitwiseiowriter("test.bin")
for i=1 to length(test) do
    writer = write_bits(writer,test[i],7)
end for
writer = close_bitwiseiowriter(writer)

integer fn = open("test.bin","rb")
string bytes = get_text(fn,GT_WHOLE_FILE)
printf(1,"Written bitstream: %s\n",{as_hexb(bytes,"%08b ")})
printf(1,"Written bytes: %s (length %d)\n",{as_hexb(bytes),length(bytes)})
close(fn)

sequence reader = new_bitwiseioreader("test.bin")
bytes = ""
integer ch
while true do
    {ch,reader} = read_bits(reader,7)
    if ch=-1 then exit end if
    bytes &= ch
end while
printf(1,"\"%s\" as bytes: %s (length %d)\n",{bytes,as_hexb(bytes),length(bytes)})


INCLUDE "H6:RGB2GRAY.ACT" ;from task Grayscale image

PROC DecodeSize(CHAR ARRAY s BYTE POINTER width,height)
  BYTE i

  width^=ValB(s)
  i=1
  WHILE i<=s(0) AND s(i)#32
  DO
    s(i)=32
    i==+1
  OD
  height^=ValB(s)
RETURN

PROC LoadHeader(RgbImage POINTER img
  CHAR ARRAY format BYTE dev)
  CHAR ARRAY line(255)
  BYTE header,size,max,width,height

  header=0 size=0 max=0
  WHILE max=0
  DO
    InputSD(dev,line)
    IF line(0)>0 AND line(1)#'# THEN
      IF header=0 THEN
        IF SCompare(format,format)#0 THEN
          Break()
        FI
        header=1
      ELSEIF size=0 THEN
        DecodeSize(line,@width,@height)
        IF width=0 OR height=0 THEN
          Break()
        FI
        img.w=width img.h=height
        size=1
      ELSEIF max=0 THEN
        max=ValB(line)
        IF max#255 THEN
          Break()
        FI
      FI
    FI
  OD
RETURN

PROC LoadPPM6(RgbImage POINTER img CHAR ARRAY path)
  BYTE dev=[1],x,y
  RGB c

  Close(dev)
  Open(dev,path,4)
  LoadHeader(img,"P6",dev)
  FOR y=0 TO img.h-1
  DO
    FOR x=0 TO img.w-1
    DO
      c.r=GetD(dev)
      c.g=GetD(dev)
      c.b=GetD(dev)
      SetRgbPixel(img,x,y,c)
    OD
  OD
  Close(dev)
RETURN

PROC SaveHeader(GrayImage POINTER img
  CHAR ARRAY format BYTE dev)

  PrintDE(dev,format)
  PrintBD(dev,img.w)
  PutD(dev,32)
  PrintBDE(dev,img.h)
  PrintBDE(dev,255)
RETURN

PROC SavePPM2(RgbImage POINTER img CHAR ARRAY path)
  BYTE dev=[1],x,y,c

  Close(dev)
  Open(dev,path,8)
  SaveHeader(img,"P2",dev)
  FOR y=0 TO img.h-1
  DO
    FOR x=0 TO img.w-1
    DO
      c=GetGrayPixel(img,x,y)
      PrintBD(dev,c)
      IF x=img.w-1 THEN
        PutDE(dev)
      ELSE
        PutD(dev,32)
      FI
    OD
  OD
  Close(dev)
RETURN

PROC Load(CHAR ARRAY path)
  CHAR ARRAY line(255)
  BYTE dev=[1]

  Close(dev)
  Open(dev,path,4)
  WHILE Eof(dev)=0
  DO
    InputSD(dev,line)
    PrintE(line)
  OD
  Close(dev)
RETURN

PROC Main()
  BYTE ARRAY rgbdata(300),graydata(100)
  RgbImage rgbimg
  GrayImage grayimg
  CHAR ARRAY path2="D:PPM2.PPM"
  CHAR ARRAY path6="D:PPM6.PPM"

  Put(125) PutE() ;clear the screen
  InitRgbImage(rgbimg,0,0,rgbdata)
  InitRgbToGray()

  PrintF("Loading %S...%E%E",path6)
  LoadPPM6(rgbimg,path6)

  PrintF("Converting RGB to grayscale...%E%E")
  InitGrayImage(grayimg,rgbimg.w,rgbimg.h,graydata)
  RgbToGray(rgbimg,grayimg)

  PrintF("Saving %S...%E%E",path2)
  SavePPM2(grayimg,path2)
  PrintF("Loading %S...%E%E",path2)
  Load(path2)
RETURN


with Ada.Characters.Latin_1;  use Ada.Characters.Latin_1;
with Ada.Integer_Text_IO;     use Ada.Integer_Text_IO;
with Ada.Streams.Stream_IO;   use Ada.Streams.Stream_IO;

function Get_PPM (File : File_Type) return Image is
   use Ada.Characters.Latin_1;
   use Ada.Integer_Text_IO;

   function Get_Line return String is -- Skips comments
      Byte   : Character;
      Buffer : String (1..80);
   begin
      loop
         for I in Buffer'Range loop
            Character'Read (Stream (File), Byte);
            if Byte = LF then
               exit when Buffer (1) = '#';
               return Buffer (1..I - 1);
            end if;
            Buffer (I) := Byte;
         end loop;
         if Buffer (1) /= '#' then
            raise Data_Error;
         end if;
      end loop;
   end Get_Line;

   Height : Integer;
   Width  : Integer;
begin
   if Get_Line /= "P6" then
      raise Data_Error;
   end if;
   declare
      Line  : String  := Get_Line;
      Start : Integer := Line'First;
      Last  : Positive;
   begin
      Get (Line, Width, Last);                     Start := Start + Last;
      Get (Line (Start..Line'Last), Height, Last); Start := Start + Last;
      if Start <= Line'Last then
         raise Data_Error;
      end if;
      if Width < 1 or else Height < 1 then
         raise Data_Error;
      end if;
   end;
   if Get_Line /= "255" then
      raise Data_Error;
   end if;
   declare
      Result : Image (1..Height, 1..Width);
      Buffer : String (1..Width * 3);
      Index  : Positive;
   begin
      for I in Result'Range (1) loop
         String'Read (Stream (File), Buffer);
         Index := Buffer'First;
         for J in Result'Range (2) loop
            Result (I, J) :=
               (  R => Luminance (Character'Pos (Buffer (Index))),
                  G => Luminance (Character'Pos (Buffer (Index + 1))),
                  B => Luminance (Character'Pos (Buffer (Index + 2)))
               );
            Index := Index + 3;
         end loop;
      end loop;
      return Result;
   end;
end Get_PPM;


Procedure SaveImageAsPPM(Image, file$, Binary = 1)
  ; Author Roger Rösch (Nickname Macros)
  IDFiIe = CreateFile(#PB_Any, file$)
  If IDFiIe
    If StartDrawing(ImageOutput(Image))
      WriteStringN(IDFiIe, "P" + Str(3 + 3*Binary))
      WriteStringN(IDFiIe, "#Created with PureBasic using a Function created from Macros for Rosettacode.org ")
      width  = ImageWidth(Image)
      height = ImageHeight(Image)
      WriteStringN(IDFiIe, Str(width) + " " + Str(height))
      WriteStringN(IDFiIe, "255")
      If Binary = 0
        For y = 0 To height - 1
          For x = 0 To width - 1
            color = Point(x, y)
            WriteString(IDFiIe, Str(Red(color)) + " " + Str(Green(color)) + " " + Str(Blue(color)) + "  ")
          Next
          WriteStringN(IDFiIe, "")
        Next
      Else  ; Save in Binary Format
        For y = 0 To height - 1
          For x = 0 To width - 1
            color = Point(x, y)
            WriteByte(IDFiIe, Red(color))
            WriteByte(IDFiIe, Green(color))
            WriteByte(IDFiIe, Blue(color))
          Next
        Next
      EndIf
      StopDrawing()
    EndIf
    CloseFile(IDFiIe)
  EndIf
EndProcedure


var size = 4
var num = @(1..9).shuffle.first(size)

for (var guesses = 1; true; guesses++) {

    var bulls = 0
    var cows  = 0

    var input =
        read("Input: ", String).chars           \
                               .uniq            \
                               .grep(/^[1-9]$/) \
                               .map{.to_n}

    if (input.len != size) {
        warn "Invalid input!\n"
        guesses--
        next
    }

    if (input == num) {
        printf("You did it in %d attempts!\n", guesses)
        break
    }

    for i (^num) {
        if (num[i] == input[i]) {
            bulls++
        }
        elsif (num.contains(input[i])) {
            cows++
        }
    }

    "Bulls: %d; Cows: %d\n".printf(bulls, cows)
}


Object subclass: BullsCows [
  |number|
  BullsCows class >> new: secretNum [ |i|
    i := self basicNew.
    (self isValid: secretNum)
       ifFalse: [ SystemExceptions.InvalidArgument
                    signalOn: secretNum
                    reason: 'You need 4 unique digits from 1 to 9' ].
    i setNumber: secretNum.
    ^ i
  ]
  BullsCows class >> new [ |b| b := Set new.
     [ b size < 4 ]
       whileTrue: [ b add: ((Random between: 1 and: 9) displayString first) ].
     ^ self new: (b asString)
  ]
  BullsCows class >> isValid: num [
    ^ (num asSet size = 4) & ((num asSet includes: $0) not)
  ]
  setNumber: num [ number := num ]
  check: guess [ |bc| bc := Bag new.
     1 to: 4 do: [ :i |
       (number at: i) = (guess at: i)
         ifTrue: [ bc add: 'bulls' ]
         ifFalse: [
             (number includes: (guess at: i))
               ifTrue: [ bc add: 'cows' ]
         ]
     ].
     ^ bc
  ]
].

'Guess the 4-digits number (digits from 1 to 9, no repetition)' displayNl.

|guessMe d r tries|
[
  tries := 0.
  guessMe := BullsCows new.
  [
    [
      'Write 4 digits: ' display.
      d := stdin nextLine.
      (BullsCows isValid: d)
    ] whileFalse: [
         'Insert 4 digits, no repetition, exclude the digit 0' displayNl
    ].
    r := guessMe check: d.
    tries := tries + 1.
    (r occurrencesOf: 'bulls') = 4
  ] whileFalse: [
    ('%1 cows, %2 bulls' % { r occurrencesOf: 'cows'. r occurrencesOf: 'bulls' })
      displayNl.
  ].
  ('Good, you guessed it in %1 tries!' % { tries }) displayNl.
  'Do you want to play again? [y/n]' display.
  ( (stdin nextLine) = 'y' )
] whileTrue: [ Character nl displayNl ].


(de write7bitwise (Lst)
   (let (Bits 0  Byte)
      (for N Lst
         (if (=0 Bits)
            (setq Bits 7  Byte (* 2 N))
            (wr (| Byte (>> (dec 'Bits) N)))
            (setq Byte (>> (- Bits 8) N)) ) )
      (unless (=0 Bits)
         (wr Byte) ) ) )

(de read7bitwise ()
   (make
      (let (Bits 0  Byte)
         (while (rd 1)
            (let N @
               (link
                  (if (=0 Bits)
                     (>> (one Bits) N)
                     (| Byte (>> (inc 'Bits) N)) ) )
               (setq Byte (& 127 (>> (- Bits 7) N))) ) )
         (when (= 7 Bits)
            (link Byte) ) ) ) )


declare onebit bit(1) aligned, bs bit (1000) varying aligned;
on endfile (sysin) go to ending;
bs = ''b;
do forever;
   get edit (onebit) (F(1));
   bs = bs || onebit;
end;
ending:
bs = bs || copy('0'b, mod(length(bs), 8) );
                                 /* pad length to a multiple of 8 */
put edit (bs) (b);


Structure fileDataBits
  bitsToWrite.i
  bitsToRead.i
  outputByte.i
  inputByte.i
EndStructure
#BitsPerByte = SizeOf(Byte) * 8
#BitsPerInteger = SizeOf(Integer) * 8

Global Dim fileBitMask(8)
Define i, x
For i = 0 To 8
  fileBitMask(i) = x
  x = (x << 1) + 1
Next

Global NewMap fileDataBits.fileDataBits()
Procedure flushBits(fileID)
  If FindMapElement(fileDataBits(), Str(fileID))
    If fileDataBits()\bitsToWrite > 0
      WriteByte(fileID, fileDataBits()\outputByte << (#BitsPerByte - fileDataBits()\bitsToWrite))
      fileDataBits()\bitsToWrite = 0
      fileDataBits()\outputByte = 0
    EndIf
    DeleteMapElement(fileDataBits())
  EndIf
EndProcedure

Procedure writeBits(fileID, Value.i, bitCount)
  Protected *fileData.fileDataBits = FindMapElement(fileDataBits(), Str(fileID))
  If Not *fileData
    *fileData = AddMapElement(fileDataBits(), Str(fileID))
    If Not *fileData: End: EndIf ;simple error check for lack of memory
  EndIf

  Value << (#BitsPerInteger - bitCount) ;shift value so it's first bit (HSB) is in the highest position
  While bitCount > 0
    If bitCount > #BitsPerByte - *fileData\bitsToWrite
      bitGroupSize = #BitsPerByte - *fileData\bitsToWrite
    Else
      bitGroupSize = bitCount
    EndIf

    *fileData\outputByte << bitGroupSize
    *fileData\outputByte + (Value >> (#BitsPerInteger - bitGroupSize)) & fileBitMask(bitGroupSize)
    Value << bitGroupSize
    *fileData\bitsToWrite + bitGroupSize
    If *fileData\bitsToWrite = #BitsPerByte
      WriteByte(fileID, *fileData\outputByte)
      *fileData\bitsToWrite = 0
      *fileData\outputByte = 0
    EndIf
    bitCount - bitGroupSize
  Wend
EndProcedure

Procedure.i readBits(fileID, bitCount)
  Protected *fileData.fileDataBits = FindMapElement(fileDataBits(), Str(fileID))
  If Not *fileData
    *fileData = AddMapElement(fileDataBits(), Str(fileID))
    If Not *fileData: End: EndIf ;simple error check for lack of memory
  EndIf

  Protected Value.i, bitGroupSize
  While bitCount > 0
    If *fileData\bitsToRead = 0
      If Not Eof(fileID)
        *fileData\inputByte = ReadByte(fileID)
        *fileData\bitsToRead = #BitsPerByte
      Else
        flushBits(fileID)
        Break ;simple error check aborts if nothing left to read
      EndIf
    EndIf

    If bitCount > *fileData\bitsToRead
      bitGroupSize = *fileData\bitsToRead
    Else
      bitGroupSize = bitCount
    EndIf
    Value << bitGroupSize
    Value + (*fileData\inputByte >> (#BitsPerByte - bitGroupSize)) & fileBitMask(bitGroupSize) ;shift last bit being read in byte to the lowest position
    *fileData\inputByte << bitGroupSize
    *fileData\bitsToRead - bitGroupSize
    bitCount - bitGroupSize
  Wend
  ProcedureReturn Value
EndProcedure

;test
Define testWriteString.s, testReadString.s, fileNum, result.s
testWriteString = "This is an ascii string that will be crunched, written, read and expanded."
fileNum = CreateFile(#PB_Any, "BitIO_Test.dat")
If fileNum
  For i = 1 To Len(testWriteString)
    writeBits(fileNum, Asc(Mid(testWriteString, i, 1)), 7)
  Next
  flushBits(fileNum)
  CloseFile(fileNum)
EndIf

fileNum = ReadFile(#PB_Any, "BitIO_Test.dat")
If fileNum
  For i = 1 To Len(testWriteString)
    testReadString + Chr(readBits(fileNum, 7))
  Next
  flushBits(fileNum)
  CloseFile(fileNum)
EndIf

result = "Original ascii string is " + Str(Len(testWriteString)) + " bytes." + #LF$
result + "Filesize written is " + Str(FileSize("test.xxx")) + " bytes." + #LF$
If testReadString = testWriteString
  result + "The expanded string is the same as the original." + #LF$
Else
  result + "The expanded string is not the same as the original." + #LF$
EndIf
result + "Expanded string = '" + testReadString + "'"

MessageRequester("Results", result)


img := ppm_read("lena50.ppm") ;
x := img[4,4] ; get pixel(4,4)
y := img[24,24] ; get pixel(24,24)
msgbox % x.rgb() " " y.rgb()
img.write("lena50copy.ppm")
return

ppm_read(filename, ppmo=0) ; only ppm6 files supported
{
if !ppmo  ; if image not already in memory, read from filename
  fileread, ppmo, % filename

  index := 1
  pos := 1

  loop, parse, ppmo, `n, `r
  {
    if (substr(A_LoopField, 1, 1) == "#")
      continue
loop,
{
 if !pos := regexmatch(ppmo, "\d+", pixel, pos)
break
    bitmap%A_Index% := pixel
    if (index == 4)
      Break
    pos := regexmatch(ppmo, "\s", x, pos)
    index ++
}
  }

  type := bitmap1
  width := bitmap2
  height := bitmap3
  maxcolor := bitmap4
  bitmap := Bitmap(width, height, color(0,0,0))
  index := 1
  i := 1
  j := 1
 bits := pos
loop % width * height
  {
      bitmap[i, j, "r"]  := numget(ppmo, 3 * A_Index + bits, "uchar")
      bitmap[i, j, "g"]  := numget(ppmo, 3 * A_Index + bits + 1, "uchar")
      bitmap[i, j, "b"]  := numget(ppmo, 3 * A_Index + bits + 2, "uchar")

      if (j == width)
{
	j := 1
	i += 1
}
      else
	j++
}
 return bitmap
  }
#include bitmap_storage.ahk ; from http://rosettacode.org/wiki/Basic_bitmap_storage/AutoHotkey


# String masquerading as ppm file (version P3)
import io
ppmfileout = io.StringIO('')

def writeppmp3(self, f):
    self.writeppm(f, ppmformat='P3')

def writeppm(self, f, ppmformat='P6'):
    assert ppmformat in ['P3', 'P6'], 'Format wrong'
    magic = ppmformat + '\n'
    comment = '# generated from Bitmap.writeppm\n'
    maxval = max(max(max(bit) for bit in row) for row in self.map)
    assert ppmformat == 'P3' or 0 <= maxval < 256, 'R,G,B must fit in a byte'
    if ppmformat == 'P6':
        fwrite = lambda s: f.write(bytes(s, 'UTF-8'))
        maxval = 255
    else:
        fwrite = f.write
        numsize=len(str(maxval))
    fwrite(magic)
    fwrite(comment)
    fwrite('%i %i\n%i\n' % (self.width, self.height, maxval))
    for h in range(self.height-1, -1, -1):
        for w in range(self.width):
            r, g, b = self.get(w, h)
            if ppmformat == 'P3':
                fwrite('   %*i %*i %*i' % (numsize, r, numsize, g, numsize, b))
            else:
                fwrite('%c%c%c' % (r, g, b))
        if ppmformat == 'P3':
            fwrite('\n')

Bitmap.writeppmp3 = writeppmp3
Bitmap.writeppm = writeppm

# Draw something simple
bitmap = Bitmap(4, 4, black)
bitmap.fillrect(1, 0, 1, 2, white)
bitmap.set(3, 3, Colour(127, 0, 63))
# Write to the open 'file' handle
bitmap.writeppmp3(ppmfileout)
# Whats in the generated PPM file
print(ppmfileout.getvalue())

'''
The print statement above produces the following output :

P3
# generated from Bitmap.writeppmp3
4 4
255
     0   0   0     0   0   0     0   0   0   127   0  63
     0   0   0     0   0   0     0   0   0     0   0   0
     0   0   0   255 255 255     0   0   0     0   0   0
     0   0   0   255 255 255     0   0   0     0   0   0

'''

# Write a P6 file
ppmfileout = open('tmp.ppm', 'wb')
bitmap.writeppm(ppmfileout)
ppmfileout.close()


'by rbytes, January 2017
OPTION BASE 1
P("  B U L L S   A N D    C O W S")!l
P("A secret 4-digit number has been created, with")
P("no repeats and no zeros. You must guess the number.")
P("After each guess, you will be shown how many of your")
P("digits are correct and in the matching location (bulls),")
P("and how many are correct but in a different location (cows).")
p("See how many tries it takes you to get the right answer.")
' generate a 4-digit number with no repeats
guesses  =   0
1 WHILE LEN(sec$) <4
  c$ =CHR$( INTEG(RND(1) *9) +49)
  IF INSTR(sec$, c$)=-1 THEN sec$&=c$
ENDWHILE!l
2 PRINT "Your guess: "
INPUT "FOUR DIGITS": guess$!l
IF guess$="" THEN       ' check if entry is null
  P("Please enter something!")!l
  GOTO 2
ENDIF
P(guess$)!l
IF LEN(guess$)<>4 THEN  ' check if entry is exactly 4 characters
  P("Please enter exactly 4 digits.")!l
  GOTO 2
ENDIF
FOR t=1 TO 4            ' check if all characters are digits 1 - 9
  IF INSTR("123456789",MID$(guess$,t,1))=-1 THEN
    P("You have entered at least one illegal character")!l
    GOTO 2
  ENDIF
NEXT t
rep = check(guess$)     ' check if any digits are repeated
IF check.chk THEN
  P("Please enter a number with no repeated digits.")!l
  GOTO 2
ENDIF

guesses+=1
r$=score$(guess$,sec$)
P(r$)!l

IF guess$=sec$ THEN
  P("W I N N E R ! ! !")!l
  IF guesses>1 THEN gs$="guesses!" ELSE gs$="guess!"
  P("You won after "&guesses&" "&gs$)
  P("Thanks for playing!")!l
  PAUSE 2
  P("A G A I N  with a new secret number")!l
  guesses=0
END IF
GOTO 1
END '   _____________________________________________________________

DEF P(p$)              ' function to print a string
  PRINT p$
END DEF

DEF L()                ' function to print an empty line
  PRINT
END DEF

DEF check(i$)          ' check=0 if digit is not repeated, else=1
  chk=0
  FOR i =1 TO 3
    FOR j =i +1 TO 4
      IF MID$( i$, i, 1)=MID$( i$, j, 1) THEN chk =1
    NEXT j
  NEXT i
END DEF

DEF score$(a$,b$)      ' calculate the numbers of bulls & cows.
  bulls=0!cows=0
  FOR i = 1 TO 4
    c$ = MID$( a$, i, 1)
    IF MID$( b$, i, 1)=c$ THEN
      bulls+=1
    ELSE
      IF INSTR( b$, c$) <>-1 AND INSTR( b$, c$) <>i THEN
        cows+=1
      END IF
    END IF
  NEXT i
  r$ ="Bulls: "&STR$( bulls)& ", "& "Cows: " &STR$( cows)
  RETURN r$
END DEF
END


import Foundation

func generateRandomNumArray(numDigits: Int = 4) -> [Int] {
  guard numDigits > 0 else {
    return []
  }

  let needed =  min(9, numDigits)
  var nums = Set<Int>()

  repeat {
    nums.insert(.random(in: 1...9))
  } while nums.count != needed

  return Array(nums)
}

func parseGuess(_ guess: String) -> [Int]? {
  guard guess.count == 4 else {
    return nil
  }

  let guessArray = guess.map(String.init).map(Int.init).compactMap({ $0 })

  guard Set(guessArray).count == 4 else {
    return nil
  }

  return guessArray
}

while true {
  let num = generateRandomNumArray()
  var bulls = 0
  var cows = 0

  print("Please enter a 4 digit number with digits between 1-9, no repetitions: ")

  guard let guessStr = readLine(strippingNewline: true), let guess = parseGuess(guessStr) else {
    print("Invalid input")
    continue
  }

  for (guess, actual) in zip(guess, num) {
    if guess == actual {
      bulls += 1
    } else if num.contains(guess) {
      cows += 1
    }
  }

  print("Actual number: \(num.map(String.init).joined())")
  print("Your score: \(bulls) bulls and \(cows) cows\n")
  print("Would you like to play again? (y): ")

  guard readLine(strippingNewline: true)!.lowercased() == "y" else {
    exit(0)
  }
}


class BitWriter(object):
    def __init__(self, f):
        self.accumulator = 0
        self.bcount = 0
        self.out = f

    def __enter__(self):
        return self

    def __exit__(self, exc_type, exc_val, exc_tb):
        self.flush()

    def __del__(self):
        try:
            self.flush()
        except ValueError:   # I/O operation on closed file.
            pass

    def _writebit(self, bit):
        if self.bcount == 8:
            self.flush()
        if bit > 0:
            self.accumulator |= 1 << 7-self.bcount
        self.bcount += 1

    def writebits(self, bits, n):
        while n > 0:
            self._writebit(bits & 1 << n-1)
            n -= 1

    def flush(self):
        self.out.write(bytearray([self.accumulator]))
        self.accumulator = 0
        self.bcount = 0

class BitReader(object):
    def __init__(self, f):
        self.input = f
        self.accumulator = 0
        self.bcount = 0
        self.read = 0

    def __enter__(self):
        return self

    def __exit__(self, exc_type, exc_val, exc_tb):
        pass

    def _readbit(self):
        if not self.bcount:
            a = self.input.read(1)
            if a:
                self.accumulator = ord(a)
            self.bcount = 8
            self.read = len(a)
        rv = (self.accumulator & (1 << self.bcount-1)) >> self.bcount-1
        self.bcount -= 1
        return rv

    def readbits(self, n):
        v = 0
        while n > 0:
            v = (v << 1) | self._readbit()
            n -= 1
        return v

if __name__ == '__main__':
    import os
    import sys
    # Determine this module's name from it's file name and import it.
    module_name = os.path.splitext(os.path.basename(__file__))[0]
    bitio = __import__(module_name)

    with open('bitio_test.dat', 'wb') as outfile:
        with bitio.BitWriter(outfile) as writer:
            chars = '12345abcde'
            for ch in chars:
                writer.writebits(ord(ch), 7)

    with open('bitio_test.dat', 'rb') as infile:
        with bitio.BitReader(infile) as reader:
            chars = []
            while True:
                x = reader.readbits(7)
                if not reader.read:  # End-of-file?
                    break
                chars.append(chr(x))
            print(''.join(chars))


      f% = OPENIN("c:\lena.ppm")
      IF f%=0 ERROR 100, "Failed to open input file"

      IF GET$#f% <> "P6" ERROR 101, "File is not in P6 format"
      REPEAT
        in$ = GET$#f%
      UNTIL LEFT$(in$,1) <> "#"
      size$ = in$
      max$ = GET$#f%

      Width% = VAL(size$)
      space% = INSTR(size$, " ")
      Height% = VALMID$(size$, space%)

      VDU 23,22,Width%;Height%;8,16,16,128

      FOR y% = Height%-1 TO 0 STEP -1
        FOR x% = 0 TO Width%-1
          r% = BGET#f% : g% = BGET#f% : b% = BGET#f%
          l% = INT(0.3*r% + 0.59*g% + 0.11*b% + 0.5)
          PROCsetpixel(x%,y%,l%,l%,l%)
        NEXT
      NEXT y%
      END

      DEF PROCsetpixel(x%,y%,r%,g%,b%)
      COLOUR 1,r%,g%,b%
      GCOL 1
      LINE x%*2,y%*2,x%*2,y%*2
      ENDPROC


using System.IO;
class PPMReader
{
    public static Bitmap ReadBitmapFromPPM(string file)
    {
        var reader = new BinaryReader(new FileStream(file, FileMode.Open));
        if (reader.ReadChar() != 'P' || reader.ReadChar() != '6')
            return null;
        reader.ReadChar(); //Eat newline
        string widths = "", heights = "";
        char temp;
        while ((temp = reader.ReadChar()) != ' ')
            widths += temp;
        while ((temp = reader.ReadChar()) >= '0' && temp <= '9')
            heights += temp;
        if (reader.ReadChar() != '2' || reader.ReadChar() != '5' || reader.ReadChar() != '5')
            return null;
        reader.ReadChar(); //Eat the last newline
        int width = int.Parse(widths),
            height = int.Parse(heights);
        Bitmap bitmap = new Bitmap(width, height);
        //Read in the pixels
        for (int y = 0; y < height; y++)
            for (int x = 0; x < width; x++)
                bitmap.SetPixel(x, y, new Bitmap.Color()
                {
                    Red = reader.ReadByte(),
                    Green = reader.ReadByte(),
                    Blue = reader.ReadByte()
                });
        return bitmap;
    }
}


# View the existing code in the library
library(pixmap)
pixmap::write.pnm

#Usage
write.pnm(theimage, filename)


;P3
(define (bitmap->ppm bitmap output-port)
  (define height (send bitmap get-height))
  (define width (send bitmap get-width))
  (define buffer (make-bytes (* width height 4))) ;buffer for storing argb data
  (send bitmap get-argb-pixels 0 0 width height buffer) ;copy pixels
  (parameterize ([current-output-port output-port])
    (printf "P3\n~a ~a\n255" width height) ;header
    (for ([i (* width height)])
      (define pixel-position (* 4 i))
      (when (= (modulo i width) 0) (printf "\n")) ;end of row
      (printf "~s ~s ~s "
              (bytes-ref buffer (+ pixel-position 1)) ;r
              (bytes-ref buffer (+ pixel-position 2)) ;g
              (bytes-ref buffer (+ pixel-position 3)))))) ;b

(call-with-output-file "image.ppm" #:exists 'replace #:mode 'text
  (lambda (out)
    (bitmap->ppm bm out)))

; P6
(define (bitmap->ppm bitmap output-port)
  (define height (send bitmap get-height))
  (define width (send bitmap get-width))
  (define buffer (make-bytes (* width height 4))) ;buffer for storing argb data
  (send bitmap get-argb-pixels 0 0 width height buffer) ;copy pixels
  (parameterize ([current-output-port output-port])
    (printf "P6\n~a ~a\n255\n" width height) ;header
    (for ([i (* width height)])
      (define pixel-position (* 4 i))
      (write-byte (bytes-ref buffer (+ pixel-position 1))) ; r
      (write-byte (bytes-ref buffer (+ pixel-position 2))) ; g
      (write-byte (bytes-ref buffer (+ pixel-position 3)))))) ;b

(call-with-output-file "image.ppm" #:exists 'replace #:mode 'binary
  (lambda (out)
    (bitmap->ppm bm out)))

;or any other output port


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

    method fill(Pixel $p) {
        @!data = $p.clone xx ($!width*$!height)
    }
    method pixel(
	  $i where ^$!width,
	  $j where ^$!height
	  --> Pixel
      ) is rw { @!data[$i*$!height + $j] }

    method data { @!data }
}

role PPM {
    method P6 returns Blob {
	"P6\n{self.width} {self.height}\n255\n".encode('ascii')
	~ Blob.new: flat map { .R, .G, .B }, self.data
    }
}

my Bitmap $b = Bitmap.new(width => 125, height => 125) but PPM;
for flat ^$b.height X ^$b.width -> $i, $j {
    $b.pixel($i, $j) = Pixel.new: :R($i*2), :G($j*2), :B(255-$i*2);
}

$*OUT.write: $b.P6;


proc main {} {
    fconfigure stdout -buffering none
    set length 4

    puts "I have chosen a number from $length unique digits from 1 to 9 arranged in a random order.
You need to input a $length digit, unique digit number as a guess at what I have chosen
    "

    while true {
        set word [generateWord $length]
        set count 1
        while {[set guess [getGuess $length]] ne $word} {
            printScore $length $word $guess
            incr count
        }
        puts "You guessed correctly in $count tries."
        if {[yn "Play again?"] eq "n"} break
    }
}

proc generateWord {length} {
    set chars 123456789
    for {set i 1} {$i <= $length} {incr i} {
        set idx [expr {int(rand() * [string length $chars])}]
        append word [string index $chars $idx]
        set chars [string replace $chars $idx $idx]
    }
    return $word

    # here's another way to generate word with no duplications
    set word ""
    while {[string length $word] < $length} {
        set char [expr {int(1 + 9*rand())}]
        if {[string first $char $word] == -1} {
            append word $char
        }
    }
}

proc getGuess {length} {
    puts -nonewline "Enter your guess: "
    while true {
        gets stdin guess
        if {[string match [string repeat {[1-9]} $length] $guess]} {
            return $guess
        }
        if {[string tolower [string trim $guess]] eq "quit"} {
            puts Bye
            exit
        }
        puts "The word must be $length digits between 1 and 9 inclusive.  Try again."
    }
}

proc printScore {length word guess} {
    set bulls 0
    set cows 0
    for {set i 0} {$i < $length} {incr i} {
        if {[string index $word $i] eq [string index $guess $i]} {
            incr bulls
            set word [string replace $word $i $i +]
        }
    }
    puts "  $bulls bulls"
    for {set i 0} {$i < $length} {incr i} {
        if {[set j [string first [string index $guess $i] $word]] != -1} {
            incr cows
            set word [string replace $word $j $j -]
        }
    }
    puts "  $cows cows"
}

proc yn {msg} {
    while true {
        puts -nonewline "$msg \[y/n] "
        gets stdin ans
        set char [string tolower [string index [string trim $ans] 0]]
        if {$char eq "y" || $char eq "n"} {
            return $char
        }
    }
}

main


#lang racket

(require racket/fixnum)

(define (make-bit-writer file)
  (define o (open-output-file file #:exists 'truncate))
  (define b+len (cons 0 0))
  (define (write-some-bits! n len)
    (if (<= 8 len)
      (begin (write-byte (fxand n #xFF) o)
             (write-some-bits! (fxrshift n 8) (- len 8)))
      (set! b+len (cons n len))))
  (define write-bits
    (case-lambda
      [(n) (if (eof-object? n)
             (begin (when (positive? (cdr b+len)) (write-byte (car b+len) o))
                    (close-output-port o))
             (write-bits n (integer-length n)))]
      [(n nbits)
       (when (< nbits (integer-length n))
         (error 'write-bits "integer bigger than number of bits"))
       (write-some-bits! (fxior (car b+len) (fxlshift n (cdr b+len)))
                         (+ (cdr b+len) nbits))]))
  write-bits)

(define (make-bit-reader file)
  (define i (open-input-file file))
  (define b+len (cons 0 0))
  (define (read-some-bits wanted n len)
    (if (<= wanted len)
      (begin0 (fxand n (sub1 (expt 2 wanted)))
        (set! b+len (cons (fxrshift n wanted) (- len wanted))))
      (read-some-bits wanted (+ n (fxlshift (read-byte i) len)) (+ len 8))))
  (define (read-bits n)
    (if (eof-object? n)
      (close-input-port i)
      (read-some-bits n (car b+len) (cdr b+len))))
  read-bits)

(define (crunch str file)
  (define out (make-bit-writer file))
  (for ([b (in-bytes (string->bytes/utf-8 str))]) (out b 7))
  (out eof))

(define (decrunch file)
  (define in (make-bit-reader file))
  (define bs (for/list ([i (in-range (quotient (* 8 (file-size file)) 7))])
               (in 7)))
  (in eof)
  (bytes->string/utf-8 (list->bytes bs)))

(define orig
  (string-append "This is an ascii string that will be"
                 " crunched, written, read and expanded."))

(crunch orig "crunched.out")

(printf "Decrunched string ~aequal to original.\n"
        (if (equal? orig (decrunch "crunched.out")) "" "NOT "))


sub encode-ascii(Str $s) {
    my @b = flat $s.ords».fmt("%07b")».comb;
    @b.push(0) until @b %% 8;   # padding
    Buf.new: gather while @b { take reduce * *2+*, (@b.pop for ^8) }
}

sub decode-ascii(Buf $b) {
    my @b = flat $b.list».fmt("%08b")».comb;
    @b.shift until @b %% 7;   # remove padding
    @b = gather while @b { take reduce * *2+*, (@b.pop for ^7) }
    return [~] @b».chr;
}
say my $encode = encode-ascii 'STRING';
say decode-ascii $encode;


(in-package #:rgb-pixel-buffer)

(defparameter *whitespaces-chars* '(#\SPACE #\RETURN #\TAB #\NEWLINE #\LINEFEED))

(defun read-header-chars (stream &optional (delimiter-list *whitespaces-chars*))
  (do ((c (read-char stream nil :eof)
          (read-char stream nil :eof))
       (vals nil (if (or (null c) (char= c  #\#)) vals (cons c vals))))   ;;don't collect comment chars
       ((or (eql c :eof) (member c delimiter-list)) (map 'string #'identity (nreverse vals)))   ;;return strings
    (when (char= c #\#)   ;;skip comments
      (read-line stream))))

(defun read-ppm-file-header (file)
  (with-open-file (s file :direction :input)
    (do ((failure-count 0 (1+ failure-count))
	 (tokens nil (let ((t1 (read-header-chars s)))
		       (if (> (length t1) 0)
			   (cons t1 tokens)
			   tokens))))
	((>= (length tokens) 4) (values (nreverse tokens)
			      (file-position s)))
      (when (>= failure-count 10)
	(error (format nil "File ~a does not seem to be a proper ppm file - maybe too many comment lines" file)))
      (when (= (length tokens) 1)
	(when (not (or (string= (first tokens) "P6") (string= (first tokens) "P3")))
	  (error (format nil "File ~a is not a ppm file - wrong magic-number. Read ~a instead of P6 or P3 " file (first tokens))))))))

(defun read-ppm-image (file)
  (flet ((image-data-reader (stream start-position width height image-build-function read-function)
	   (file-position stream start-position)
	   (dotimes (row height)
	     (dotimes (col width)
	       (funcall image-build-function row col (funcall read-function stream))))))
    (multiple-value-bind (header file-pos) (read-ppm-file-header file)
      (let* ((image-type (first header))
	     (width (parse-integer (second header) :junk-allowed t))
	     (height (parse-integer (third header) :junk-allowed t))
	     (max-value (parse-integer (fourth header) :junk-allowed t))
	     (image (make-rgb-pixel-buffer width height)))
	(when (> max-value 255)
	  (error "unsupported depth - convert to 1byte depth with pamdepth"))
	(cond ((string= "P6" image-type)
	       (with-open-file (stream file :direction :input :element-type '(unsigned-byte 8))
		 (image-data-reader stream
				    file-pos
				    width
				    height
				    #'(lambda (w h val)
					(setf (rgb-pixel image w h) val))
				    #'(lambda (stream)
					(make-rgb-pixel (read-byte stream)
							(read-byte stream)
							(read-byte stream))))
		 image))
	      ((string= "P3" image-type)
	       (with-open-file (stream file :direction :input)
		 (image-data-reader stream
				    file-pos
				    width
				    height
				    #'(lambda (w h val)
					(setf (rgb-pixel image w h) val))
				    #'(lambda (stream)
					(make-rgb-pixel (read stream)
							(read stream)
							(read stream))))
		 image))
	      (t 'unsupported))
      image))))

(export 'read-ppm-image)


/*REXX program writes a  PPM  formatted image file, also known as a  P6  (binary) file. */
green  = 00ff00                                  /*define a pixel with the color green. */
parse arg oFN width height color .               /*obtain optional arguments from the CL*/
if    oFN=='' |    oFN==","  then    oFN='IMAGE' /*Not specified?  Then use the default.*/
if  width=='' |  width==","  then  width=   20   /* "      "         "   "   "     "    */
if height=='' | height==","  then height=   20   /* "      "         "   "   "     "    */
if  color=='' |  color==","  then  color= green  /* "      "         "   "   "     "    */
oFID= oFN'.PPM'                                  /*define  oFID  by adding an extension.*/
 @. = x2c(color)                                 /*set all pixels of image a hex color. */
 $  = '9'x                                       /*define the separator (in the header).*/
 #  = 255                                        /*  "     "  max value for all colors. */
call charout oFID, ,  1                          /*set the position of the file's output*/
call charout oFID,'P6'width || $ || height || $ || # || $     /*write file header info. */
_=
       do j     =1  for width
            do k=1  for height;  _= _ || @.j.k   /*write the PPM file, 1 pixel at a time*/
            end   /*k*/                          /* ↑    a pixel contains three bytes,  */
       end        /*j*/                          /* └────which defines the pixel's color*/
call charout oFID, _                             /*write the image's raster to the file.*/
call charout oFID                                /*close the output file just to be safe*/
                                                 /*stick a fork in it,  we're all done. */


class RGBColour
  def values
    [@red, @green, @blue]
  end
end

class Pixmap
  def save(filename)
    File.open(filename, 'w') do |f|
      f.puts "P6", "#{@width} #{@height}", "255"
      f.binmode
      @height.times do |y|
        @width.times do |x|
          f.print @data[x][y].values.pack('C3')
        end
      end
    end
  end
  alias_method :write, :save
end


#lang transd

MainModule: {

contains-duplicates: (λ s String() -> Bool()
    (with str String(s) (sort str)
        (ret (neq (find-adjacent str) (end str))))
),

play: (λ
    syms "0123456789"
    len 4
    thenum String()
    guess String()

    (shuffle syms)
    (= thenum (substr syms 0 len))
    (textout "Your guess: ")
    (while (getline guess)
        (if (eq guess "q") break)
        (if (or (neq (size guess) len)
                (neq (find-first-not-of guess syms) -1)
                (contains-duplicates guess))
            (lout guess " is not valid guess")
            (textout "Your guess: ")
            continue
        )
        (with bulls 0 cows 0 pl 0
            (for i in Range(len) do
                (= pl (find thenum (subn guess i)))
                (if (eq pl i) (+= bulls 1)
                elsif (neq pl -1) (+= cows 1))
            )
            (lout "bulls: " bulls ", cows: " cows)
            (if (eq bulls len)
                (lout "Congratulations! You have found out the number!")
                (ret null)
            else (textout "Your guess: "))
        )
    )
    (lout "You quit the game.")
),

_start: (λ s String()
    (lout "Welcome to \"Bulls and cows\"!")
    (while true
        (while true
            (textout "Do you want to play? (yes|no) : ")
            (textin s 3)
            (if (not (size s))
                (lout "Didn't receive an answer. Exiting.") (exit)
            elsif (== (sub (tolower s) 0 1) "n") (lout "Bye!")(exit)
            elsif (== (sub (tolower s) 0 1) "y") break
            else (lout "(Hint: \"yes\" or \"no\".)"))
        )
        (play)
        (lout "Another game?")
    )
)
}


Red [
    Title:      "Bitwise IO"
    Link:       http://rosettacode.org/wiki/Bitwise_IO
    Source:     https://github.com/vazub/rosetta-red
    File:       "%bitwiseio.red"
    Rights:     "Copyright (C) 2020 Vasyl Zubko. All rights reserved."
    License:    "Blue Oak Model License - https://blueoakcouncil.org/license/1.0.0"
    Tabs:       4
]

str-compress: function [
    "Compressesor"
    str [string!]
][
    buf: copy ""
    bit-str: enbase/base str 2
    foreach [bit1 bit2 bit3 bit4 bit5 bit6 bit7 bit8] bit-str [
        append buf rejoin [bit2 bit3 bit4 bit5 bit6 bit7 bit8]
    ]
    if (pad-bits: (length? buf) // 8) <> 0 [
        loop (8 - pad-bits) [append buf "0"]
    ]
    debase/base buf 2
]

str-expand: function [
    "Decompressor"
    bin-hex [binary!]
][
    bit-str: enbase/base bin-hex 2
    filled: 0
    buf: copy []
    acc: copy ""
    foreach bit bit-str [
        append acc bit
        filled: filled + 1
        if filled = 7 [
            append buf debase/base rejoin ["0" acc] 2
            clear acc
            filled: 0
        ]
    ]
    if (last buf) = #{00} [take/last buf]
    rejoin buf
]

; DEMO
in-string: "Red forever!"
compressed: str-compress in-string
expanded: str-expand compressed
prin [
    pad "Input (string): " 20 mold in-string newline newline
    pad "Input (bits): " 20 enbase/base in-string 2 newline
    pad "Compressed (bits): " 20 enbase/base compressed 2 newline newline
    pad "Input (hex): " 20 to-binary in-string newline
    pad "Compressed (hex): " 20 compressed newline newline
    pad "Expanded (string): " 20 mold to-string expanded
]


/* REXX ****************************************************************
* 01.11.2012 Walter Pachl
***********************************************************************/
s='STRING'                             /* Test input                  */
Say 's='s
ol=''                                  /* initialize target           */
Do While s<>''                         /* loop through input          */
  Parse Var s c +1 s                   /* pick a character            */
  cx=c2x(c)                            /* convert to hex              */
  cb=x2b(cx)                           /* convert to bits             */
  ol=ol||substr(cb,2)                  /* append to target            */
  End
l=length(ol)                           /* current length              */
lm=l//8
ol=ol||copies('0',8-lm)                /* pad to multiple of 8        */
pd=copies(' ',l)||copies('0',8-lm)
Say 'b='ol                             /* show target                 */
Say '  'pd 'padding'
r=''                                   /* initialize result           */
Do While length(ol)>6                  /* loop through target         */
  Parse Var ol b +7 ol                 /* pick 7 bits                 */
  b='0'||b                             /* add a leading '0'           */
  x=b2x(b)                             /* convert to hex              */
  r=r||x2c(x)                          /* convert to character        */
  End                                  /* and append to result        */
Say 'r='r                              /* show result                 */


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.


use std::path::Path;
use std::io::Write;
use std::fs::File;

pub struct RGB {
    r: u8,
    g: u8,
    b: u8,
}

pub struct PPM {
    height: u32,
    width: u32,
    data: Vec<u8>,
}

impl PPM {
    pub fn new(height: u32, width: u32) -> PPM {
        let size = 3 * height * width;
        let buffer = vec![0; size as usize];
        PPM { height: height, width: width, data: buffer }
    }

    fn buffer_size(&self) -> u32 {
        3 * self.height * self.width
    }

    fn get_offset(&self, x: u32, y: u32) -> Option<usize> {
        let offset = (y * self.width * 3) + (x * 3);
        if offset < self.buffer_size() {
            Some(offset as usize)
        } else {
            None
        }
    }

    pub fn get_pixel(&self, x: u32, y: u32) -> Option<RGB> {
        match self.get_offset(x, y) {
            Some(offset) => {
                let r = self.data[offset];
                let g = self.data[offset + 1];
                let b = self.data[offset + 2];
                Some(RGB {r: r, g: g, b: b})
            },
            None => None
        }
    }

    pub fn set_pixel(&mut self, x: u32, y: u32, color: RGB) -> bool {
        match self.get_offset(x, y) {
            Some(offset) => {
                self.data[offset] = color.r;
                self.data[offset + 1] = color.g;
                self.data[offset + 2] = color.b;
                true
            },
            None => false
        }
    }

    pub fn write_file(&self, filename: &str) -> std::io::Result<()> {
        let path = Path::new(filename);
        let mut file = File::create(&path)?;
        let header = format!("P6 {} {} 255\n", self.width, self.height);
        file.write(header.as_bytes())?;
        file.write(&self.data)?;
        Ok(())
    }
}


object Pixmap {
   def save(bm:RgbBitmap, filename:String)={
      val out=new DataOutputStream(new FileOutputStream(filename))

      out.writeBytes("P6\u000a%d %d\u000a%d\u000a".format(bm.width, bm.height, 255))

      for(y <- 0 until bm.height; x <- 0 until bm.width; c=bm.getPixel(x, y)){
         out.writeByte(c.getRed)
         out.writeByte(c.getGreen)
         out.writeByte(c.getBlue)
      }
   }
}


$$ MODE tuscript
SET nr1=RANDOM_NUMBERS (1,9,1)
LOOP
  SET nr2=RANDOM_NUMBERS (1,9,1)
  IF (nr2!=nr1) EXIT
ENDLOOP
LOOP
  SET nr3=RANDOM_NUMBERS (1,9,1)
  IF (nr3!=nr1,nr2) EXIT
ENDLOOP
LOOP
  SET nr4=RANDOM_NUMBERS (1,9,1)
  IF (nr4!=nr1,nr2,nr3) EXIT
ENDLOOP
SET nr=JOIN(nr1,"'",nr2,nr3,nr4), limit=10
LOOP r=1,limit
SET bulls=cows=0
ASK "round {r} insert a number":guessnr=""
SET length=LENGTH(guessnr), checknr=STRINGS (guessnr,":>/:")
 LOOP n=nr,y=checknr
  IF (length!=4) THEN
   PRINT "4-letter digit required"
   EXIT
  ELSEIF (n==y) THEN
   SET bulls=bulls+1
  ELSEIF (nr.ct.":{y}:") THEN
   SET cows=cows+1
  ENDIF
 ENDLOOP
PRINT "bulls=",bulls," cows=",cows
 IF (bulls==4) THEN
  PRINT "BINGO"
  EXIT
 ELSEIF (r==limit) THEN
  PRINT "BETTER NEXT TIME"
  EXIT
 ENDIF
ENDLOOP


Local(2)                               ' Let's use no globals

Proc _Initialize                       ' Get our secret number

Do                                     ' Repeat until it's guessed
  Do
    Input "Enter your guess: ";[email protected]      ' Enter your guess
    While FUNC(_Invalid([email protected]))           ' but make sure it's a valid guess
  Loop

  [email protected] = FUNC(_Bulls)                    ' Count the number of bulls
  [email protected] = FUNC(_Cows)                     ' Count the number of cows
                                       ' Now give some feedback
  Print : Print "\tThere were ";[email protected];" bulls and ";[email protected];" cows." : Print
  Until [email protected] = 4                         ' Until the secret is guessed
Loop

Print "You win!"                       ' Yes, you guessed it

End

_Initialize                            ' Make a secret
  Local (1)

  Do
    [email protected] = 1234 + RND(8643)              ' Get a valid number
    While FUNC(_Invalid([email protected]))           ' and accept it unless invalid
  Loop

  For [email protected] = 0 to 3                      ' Now save it at the proper place
    @([email protected]+4) = @([email protected])
  Next
Return

_Invalid Param(1)                      ' Check whether a number is valid
  Local(2)
                                       ' Ok, these can't be right at all
  If ([email protected] < 1234) + ([email protected] > 9876) Then Return (1)
                                       ' Now break 'em up in different digits
  For [email protected] = 3 To 0 Step -1
    @([email protected]) = [email protected] % 10                    ' A digit of zero can't be right
    If @([email protected]) = 0 Then Unloop : Return (1)
    [email protected] = [email protected] / 10
  Next

  For [email protected] = 0 To 2                      ' Now compare all digits
    For [email protected] = [email protected] + 1 To 3               ' The others were already compared
      If @([email protected]) = @([email protected]) Then Unloop : Unloop : Return (1)
    Next                               ' Wrong, we found similar digits
  Next
Return (0)                             ' All digits are different

_Bulls                                 ' Count the number of valid guesses
  Local (2)

  [email protected] = 0                               ' Start with zero

  For [email protected] = 0 to 3                      ' Increment with each valid guess
    If @([email protected]) = @([email protected]+4) Then [email protected] = [email protected] + 1
  Next
Return ([email protected])                            ' Return number of valid guesses

_Cows
  Local (3)                            ' Count the number of proper digits

  [email protected] = 0                               ' Start with zero

  For [email protected] = 0 To 3                      ' All the players guesses
    For [email protected] = 4 To 7                    ' All the computers secrets
      If ([email protected]+4) = [email protected] Then Continue     ' Skip the bulls
      If @([email protected]) = @([email protected]) Then [email protected] = [email protected] + 1
    Next                               ' Increment with valid digits
  Next
Return ([email protected])                            ' Return number of valid digits