package require Tcl 8.6

proc combine {cases1 cases2 {insert ""}} {
    set result {}
    foreach c1 $cases1 {
	foreach c2 $cases2 {
	    lappend result $c1$insert$c2
	}
    }
    return $result
}
proc expand {string *expvar} {
    upvar 1 ${*expvar} expanded
    set a {}
    set result {}
    set depth 0
    foreach token [regexp -all -inline {(?:[^\\{},]|\\.)+|[\\{},]} $string] {
	switch $token {
	    "," {
		if {$depth == 0} {
		    lappend result {*}[commatize $a]
		    set a {}
		    set expanded 1
		    continue
		}
	    }
	    "\{" {incr depth  1}
	    "\}" {incr depth -1}
	}
	append a $token
    }
    lappend result {*}[commatize $a]
    return $result
}
proc commatize {string} {
    set current {{}}
    set depth 0
    foreach token [regexp -all -inline {(?:[^\\{},]|\\.)+|[\\{},]} $string] {
	switch $token {
	    "\{" {
		if {[incr depth] == 1} {
		    set collect {}
		    continue
		}
	    }
	    "\}" {
		if {[incr depth -1] == 0} {
		    set foundComma 0
		    set exp [expand $collect foundComma]
		    if {!$foundComma} {
			set exp [lmap c [commatize $collect] {set c \{$c\}}]
		    }
		    set current [combine $current $exp]
		    continue
		} elseif {$depth < 0} {
		    set depth 0
		}
	    }
	}
	if {$depth} {
	    append collect $token
	} else {
	    set current [lmap s $current {set s $s$token}]
	}
    }
    if {$depth} {
	set current [combine $current [commatize $collect] "\{"]
    }
    return $current
}


import random, strutils, strformat, sequtils
randomize()

const
  Digits = "123456789"
  DigitSet = {Digits[0]..Digits[^1]}
  Size = 4

proc sample(s: string; n: Positive): string =
  ## Return a random sample of "n" characters extracted from string "s".
  var s = s
  s.shuffle()
  result = s[0..<n]

proc plural(n: int): string =
  if n > 1: "s" else: ""

let chosen = Digits.sample(Size)

echo &"I have chosen a number from {Size} unique digits from 1 to 9 arranged in a random order."
echo &"You need to input a {Size} digit, unique digit number as a guess at what I have chosen."

var guesses = 0
while true:
  inc guesses
  var guess = ""
  while true:
    stdout.write(&"\nNext guess {guesses}: ")
    guess = stdin.readLine().strip()
    if guess.len == Size and allCharsInSet(guess, DigitSet) and guess.deduplicate.len == Size:
      break
    echo &"Problem, try again. You need to enter {Size} unique digits from 1 to 9."
  if guess == chosen:
    echo &"\nCongratulations! You guessed correctly in {guesses} attempts."
    break
  var bulls, cows = 0
  for i in 0..<Size:
    if guess[i] == chosen[i]: inc bulls
    elif guess[i] in chosen: inc cows
  echo &"  {bulls} Bull{plural(bulls)}\n  {cows} Cow{plural(cows)}"


let rec input () =
  let s = read_line () in
  try
    if String.length s <> 4 then raise Exit;
    String.iter (function
      | '1'..'9' -> ()
      | _ -> raise Exit
    ) s;
    let t = [ s.[0]; s.[1]; s.[2]; s.[3] ] in
    let _ = List.fold_left  (* reject entry with duplication *)
              (fun ac b -> if List.mem b ac then raise Exit; (b::ac))
              [] t in
    List.map (fun c -> int_of_string (String.make 1 c)) t
  with Exit ->
    prerr_endline "That is an invalid entry. Please try again.";
    input ()
;;

let print_score g t =
  let bull = ref 0 in
  List.iter2 (fun x y ->
    if x = y then incr bull
  ) g t;
  let cow = ref 0 in
  List.iter (fun x ->
    if List.mem x t then incr cow
  ) g;
  cow := !cow - !bull;
  Printf.printf "%d bulls, %d cows\n%!" !bull !cow
;;

let () =
  Random.self_init ();
  let rec mkgoal acc = function 4 -> acc
  | i ->
      let n = succ(Random.int 9) in
      if List.mem n acc
      then mkgoal acc i
      else mkgoal (n::acc) (succ i)
  in
  let g = mkgoal [] 0 in
  let found = ref false in
  while not !found do
    let t = input () in
    if t = g
    then found := true
    else print_score g t
  done;
  print_endline "Congratulations you guessed correctly";
;;


func is_Brazilian_prime(q) {

    static L = Set()
    static M = 0

    return true  if L.has(q)
    return false if (q < M)

    var N = (q<1000 ? 1000 : 2*q)

    for K in (primes(3, ilog2(N+1))) {
        for n in (2 .. iroot(N-1, K-1)) {
            var p = (n**K - 1)/(n-1)
            L << p if (p<N && p.is_prime)
        }
    }

    M = (L.max \\ 0)
    return L.has(q)
}

func is_Brazilian(n) {

    if (!n.is_prime) {
        n.is_square || return (n>6)
        var m = n.isqrt
        return (m>3 && (!m.is_prime || m==11))
    }

    is_Brazilian_prime(n)
}

with (20) {|n|
    say "First #{n} Brazilian numbers:"
    say (^Inf -> lazy.grep(is_Brazilian).first(n))

    say "\nFirst #{n} odd Brazilian numbers:"
    say (^Inf -> lazy.grep(is_Brazilian).grep{.is_odd}.first(n))

    say "\nFirst #{n} prime Brazilian numbers"
    say (^Inf -> lazy.grep(is_Brazilian).grep{.is_prime}.first(n))
}


Module Module1

    Function sameDigits(ByVal n As Integer, ByVal b As Integer) As Boolean
        Dim f As Integer = n Mod b : n \= b : While n > 0
            If n Mod b <> f Then Return False Else n \= b
        End While : Return True
    End Function

    Function isBrazilian(ByVal n As Integer) As Boolean
        If n < 7 Then Return False
        If n Mod 2 = 0 Then Return True
        For b As Integer = 2 To n - 2
            If sameDigits(n, b) Then Return True
        Next : Return False
    End Function

    Function isPrime(ByVal n As Integer) As Boolean
        If n < 2 Then Return False
        If n Mod 2 = 0 Then Return n = 2
        If n Mod 3 = 0 Then Return n = 3
        Dim d As Integer = 5
        While d * d <= n
            If n Mod d = 0 Then Return False Else d += 2
            If n Mod d = 0 Then Return False Else d += 4
        End While : Return True
    End Function

    Sub Main(args As String())
        For Each kind As String In {" ", " odd ", " prime "}
            Console.WriteLine("First 20{0}Brazilian numbers:", kind)
            Dim Limit As Integer = 20, n As Integer = 7
            Do
                If isBrazilian(n) Then Console.Write("{0} ", n) : Limit -= 1
                Select Case kind
                    Case " " : n += 1
                    Case " odd " : n += 2
                    Case " prime " : Do : n += 2 : Loop Until isPrime(n)
                End Select
            Loop While Limit > 0
            Console.Write(vbLf & vbLf)
        Next
    End Sub

End Module


cyan := color(0,255,255) ; r,g,b
cyanppm := Bitmap(10, 10, cyan) ; width, height, background-color
Bitmap_write_ppm3(cyanppm, "cyan.ppm")
run, cyan.ppm
return

#include bitmap_storage.ahk  ; see basic bitmap storage task

Bitmap_write_ppm3(bitmap, filename)
{
file := FileOpen(filename, 0x11) ; utf-8, write
file.seek(0,0) ; overwrite BOM created with fileopen()
file.write("P3`n"  ;  `n = \n in ahk
. bitmap.width . " " . bitmap.height . "`n"
. "255`n")
  loop % bitmap.height
  {
    height := A_Index
    loop % bitmap.width
    {
      width := A_Index
      color := bitmap[height, width]
      file.Write(color.R . " ")
      file.Write(color.G . " ")
      file.Write(color.B . " ")
    }
    file.write("`n")
  }
  file.close()
 return 0
}


Module Module1

    Function GetGroup(s As String, depth As Integer) As Tuple(Of List(Of String), String)
        Dim out As New List(Of String)
        Dim comma = False
        While Not String.IsNullOrEmpty(s)
            Dim gs = GetItem(s, depth)
            Dim g = gs.Item1
            s = gs.Item2
            If String.IsNullOrEmpty(s) Then
                Exit While
            End If
            out.AddRange(g)

            If s(0) = "}" Then
                If comma Then
                    Return Tuple.Create(out, s.Substring(1))
                End If
                Return Tuple.Create(out.Select(Function(a) "{" + a + "}").ToList(), s.Substring(1))
            End If

            If s(0) = "," Then
                comma = True
                s = s.Substring(1)
            End If
        End While
        Return Nothing
    End Function

    Function GetItem(s As String, Optional depth As Integer = 0) As Tuple(Of List(Of String), String)
        Dim out As New List(Of String) From {""}
        While Not String.IsNullOrEmpty(s)
            Dim c = s(0)
            If depth > 0 AndAlso (c = "," OrElse c = "}") Then
                Return Tuple.Create(out, s)
            End If
            If c = "{" Then
                Dim x = GetGroup(s.Substring(1), depth + 1)
                If Not IsNothing(x) Then
                    Dim tout As New List(Of String)
                    For Each a In out
                        For Each b In x.Item1
                            tout.Add(a + b)
                        Next
                    Next
                    out = tout
                    s = x.Item2
                    Continue While
                End If
            End If
            If c = "\" AndAlso s.Length > 1 Then
                c += s(1)
                s = s.Substring(1)
            End If
            out = out.Select(Function(a) a + c).ToList()
            s = s.Substring(1)
        End While
        Return Tuple.Create(out, s)
    End Function

    Sub Main()
        For Each s In {
            "It{{em,alic}iz,erat}e{d,}, please.",
            "~/{Downloads,Pictures}/*.{jpg,gif,png}",
            "{,{,gotta have{ ,\, again\, }}more }cowbell!",
            "{}} some }{,{\\{ edge, edge} \,}{ cases, {here} \\\\\}"
        }
            Dim fmt = "{0}" + vbNewLine + vbTab + "{1}"
            Dim parts = GetItem(s)
            Dim res = String.Join(vbNewLine + vbTab, parts.Item1)
            Console.WriteLine(fmt, s, res)
        Next
    End Sub

End Module


: bullsAndCows
| numbers guess digits bulls cows |

   ListBuffer new ->numbers
   while(numbers size 4 <>) [ 9 rand dup numbers include ifFalse: [ numbers add ] else: [ drop ] ]

   while(true) [
      "Enter a number of 4 different digits between 1 and 9 : " print
      System.Console askln ->digits
      digits asInteger isNull digits size 4 <> or ifTrue: [ "Number of four digits needed" println continue ]
      digits map(#asDigit) ->guess

      guess numbers zipWith(#==) occurrences(true) ->bulls
      bulls 4 == ifTrue: [ "You won !" println return ]

      guess filter(#[numbers include]) size bulls - ->cows
      System.Out "Bulls = " << bulls << ", cows = " << cows << cr
      ] ;


declare
  proc {Main}
     Solution = {PickNUnique 4 {List.number 1 9 1}}

     proc {Loop}
        Guess = {EnterGuess}
     in
        {System.showInfo
         {Bulls Guess Solution}#" bulls and "#
         {Cows Guess Solution}#" cows"}
        if Guess \= Solution then {Loop} end
     end
  in
     {Loop}
     {System.showInfo "You have won!"}
  end

  fun {Bulls Xs Sol}
     {Length {Filter {List.zip Xs Sol Value.'=='} Id}}
  end

  fun {Cows Xs Sol}
     {Length {Intersection Xs Sol}}
  end

  local
     class TextFile from Open.file Open.text end
     StdIn = {New TextFile init(name:stdin)}
  in
     fun {EnterGuess}
        try
           {System.printInfo "Enter your guess (e.g. \"1234\"): "}
           S = {StdIn getS($)}
        in
           %% verify
           {Length S} = 4
           {All S Char.isDigit} = true
           {FD.distinct S} %% assert there is no duplicate digit
           %% convert from digits to numbers
           {Map S fun {$ D} D-&0 end}
        catch _ then
           {EnterGuess}
        end
     end
  end

  fun {PickNUnique N Xs}
     {FoldL {MakeList N}
      fun {$ Z _}
         {Pick {Diff Xs Z}}|Z
      end
      nil}
  end

  fun {Pick Xs}
     {Nth Xs {OS.rand} mod {Length Xs} + 1}
  end

  fun {Diff Xs Ys}
     {FoldL Ys List.subtract Xs}
  end

  fun {Intersection Xs Ys}
     {Filter Xs fun {$ X} {Member X Ys} end}
  end

  fun {Id X} X end
in
  {Main}


fn same_digits(nn int, b int) bool {
    f := nn % b
    mut n := nn/b
    for n > 0 {
        if n%b != f {
            return false
        }
        n /= b
    }
    return true
}

fn is_brazilian(n int) bool {
    if n < 7 {
        return false
    }
    if n%2 == 0 && n >= 8 {
        return true
    }
    for b in 2..n-1 {
        if same_digits(n, b) {
            return true
        }
    }
    return false
}

fn is_prime(n int) bool {
    match true {
		n < 2 {
			return false
		}
		n%2 == 0 {
			return n == 2
		}
		n%3 == 0 {
			return n == 3
		}
		else {
			mut d := 5
			for d*d <= n {
				if n%d == 0 {
					return false
				}
				d += 2
				if n%d == 0 {
					return false
				}
				d += 4
			}
			return true
		}
    }
}

fn main() {
    kinds := [" ", " odd ", " prime "]
    for kind in kinds {
        println("First 20${kind}Brazilian numbers:")
        mut c := 0
        mut n := 7
        for {
            if is_brazilian(n) {
                print("$n ")
                c++
                if c == 20 {
                    println("\n")
                    break
                }
            }
            match kind {
				" " {
					n++
				}
				" odd " {
					n += 2
				}
				" prime "{
					for {
						n += 2
						if is_prime(n) {
							break
						}
					}
				}
				else{}
            }
        }
    }

    mut n := 7
    for c := 0; c < 100000; n++ {
        if is_brazilian(n) {
            c++
        }
    }
    println("The 100,000th Brazilian number: ${n-1}")
}


import "/math" for Int

var sameDigits = Fn.new { |n, b|
    var f = n % b
    n = (n/b).floor
    while (n > 0) {
        if (n%b != f) return false
        n = (n/b).floor
    }
    return true
}

var isBrazilian = Fn.new { |n|
    if (n < 7) return false
    if (n%2 == 0 && n >= 8) return true
    for (b in 2...n-1) {
        if (sameDigits.call(n, b)) return true
    }
    return false
}

for (kind in [" ", " odd ", " prime "]) {
    System.print("First 20%(kind)Brazilian numbers:")
    var c = 0
    var n = 7
    while (true) {
        if (isBrazilian.call(n)) {
            System.write("%(n) ")
            c = c + 1
            if (c == 20) {
                System.print("\n")
                break
            }
        }
        if (kind == " ") {
            n = n + 1
        } else if (kind == " odd ") {
            n = n + 2
        } else {
            while (true) {
                n = n + 2
                if (Int.isPrime(n)) break
            }
        }
    }
}

var c = 0
var n = 7
while (c < 1e5) {
    if (isBrazilian.call(n)) c = c + 1
    n = n + 1
}
System.print("The 100,000th Brazilian number: %(n-1)")


T BitWriter
   File out
   accumulator = 0
   bcount = 0

   F (fname)
      .out = File(fname, ‘w’)

   F _writebit(bit)
      I .bcount == 8
         .flush()
      I bit > 0
         .accumulator [|]= 1 << (7 - .bcount)
      .bcount++

   F writebits(bits, =n)
      L n > 0
         ._writebit(bits [&] 1 << (n - 1))
         n--

   F flush()
      .out.write_bytes([Byte(.accumulator)])
      .accumulator = 0
      .bcount = 0

   F close()
      .flush()
      .out.close()

T BitReader
   File input
   accumulator = 0
   bcount = 0
   read = 0

   F (fname)
      .input = File(fname, ‘r’)

   F _readbit()
      I .bcount == 0
         V a = .input.read_bytes(1)
         I !a.empty
            .accumulator = a[0]
         .bcount = 8
         .read = a.len
      V rv = (.accumulator [&] (1 << (.bcount - 1))) >> (.bcount - 1)
      .bcount--
      R rv

   F readbits(=n)
      V v = 0
      L n > 0
         v = (v << 1) [|] ._readbit()
         n--
      R v

V writer = BitWriter(‘bitio_test.dat’)
V chars = ‘12345abcde’
L(ch) chars
   writer.writebits(ch.code, 7)
writer.close()

V reader = BitReader(‘bitio_test.dat’)
[Char] charsa
L
   V x = reader.readbits(7)
   I reader.read == 0
      L.break
   charsa.append(Char(code' x))
print(charsa.join(‘’))


      Width% = 200
      Height% = 200

      VDU 23,22,Width%;Height%;8,16,16,128
      *display c:\lena

      f% = OPENOUT("c:\lena.ppm")
      IF f%=0 ERROR 100, "Failed to open output file"
      BPUT #f%, "P6"
      BPUT #f%, "# Created using BBC BASIC"
      BPUT #f%, STR$(Width%) + " " +STR$(Height%)
      BPUT #f%, "255"

      FOR y% = Height%-1 TO 0 STEP -1
        FOR x% = 0 TO Width%-1
          rgb% = FNgetpixel(x%,y%)
          BPUT #f%, rgb% >> 16
          BPUT #f%, (rgb% >> 8) AND &FF
          BPUT #f%, rgb% AND &FF
        NEXT
      NEXT y%
      CLOSE#f%

      END

      DEF FNgetpixel(x%,y%)
      LOCAL col%
      col% = TINT(x%*2,y%*2)
      SWAP ?^col%,?(^col%+2)
      = col%


#include <stdlib.h>
#include <stdio.h>

int main(void)
{
  const int dimx = 800, dimy = 800;
  int i, j;
  FILE *fp = fopen("first.ppm", "wb"); /* b - binary mode */
  (void) fprintf(fp, "P6\n%d %d\n255\n", dimx, dimy);
  for (j = 0; j < dimy; ++j)
  {
    for (i = 0; i < dimx; ++i)
    {
      static unsigned char color[3];
      color[0] = i % 256;  /* red */
      color[1] = j % 256;  /* green */
      color[2] = (i * j) % 256;  /* blue */
      (void) fwrite(color, 1, 3, fp);
    }
  }
  (void) fclose(fp);
  return EXIT_SUCCESS;
}


var getGroup // forward declaration

var getItem = Fn.new { |s, depth|
    var out = [""]
    while (s != "") {
        var c = s[0]
        if (depth > 0 && (c == "," || c == "}")) return [out, s]
        var cont = false
        if (c == "{") {
            var x = getGroup.call(s[1..-1], depth+1)
            if (!x[0].isEmpty) {
                var t = []
                for (a in out) {
                    for (b in x[0]) {
                        t.add(a + b)
                    }
                }
                out = t
                s = x[1]
                cont = true
            }
        }
        if (!cont) {
            if (c == "\\" && s.count > 1) {
                c = c + s[1]
                s = s[1..-1]
            }
            out = out.map { |a| a + c }.toList
            s = s[1..-1]
        }
    }
    return [out, s]
}

getGroup = Fn.new { |s, depth|
    var out = []
    var comma = false
    while (s != "") {
        var t = getItem.call(s, depth)
        var g = t[0]
        s = t[1]
        if (s == "") break
        out.addAll(g)
        if (s[0] == "}") {
            if (comma) return [out, s[1..-1]]
            return [out.map { |a| "{" + a + "}" }.toList, s[1..-1]]
        }
        if (s[0] == ",") {
            comma = true
            s = s[1..-1]
       }
    }
    return [[], ""]
}

var inputs = [
     "~/{Downloads,Pictures}/*.{jpg,gif,png}",
    "It{{em,alic}iz,erat}e{d,}, please.",
    "{,{,gotta have{ ,\\, again\\, }}more }cowbell!",
    "{}} some }{,{\\\\{ edge, edge} \\,}{ cases, {here} \\\\\\\\\\}"
]
for (input in inputs) {
    System.print(input)
    for (s in getItem.call(input, 0)[0]) System.print("    " + s)
    System.print()
}


/* interface */
void print_jpg(image img, int qual);


package main

// Files required to build supporting package raster are found in:
// * Bitmap
// * Write a PPM file

import (
    "fmt"
    "math/rand"
    "os/exec"
    "raster"
)

func main() {
    b := raster.NewBitmap(400, 300)
    // a little extravagant, this draws a design of dots and lines
    b.FillRgb(0xc08040)
    for i := 0; i < 2000; i++ {
        b.SetPxRgb(rand.Intn(400), rand.Intn(300), 0x804020)
    }
    for x := 0; x < 400; x++ {
        for y := 240; y < 245; y++ {
            b.SetPxRgb(x, y, 0x804020)
        }
        for y := 260; y < 265; y++ {
            b.SetPxRgb(x, y, 0x804020)
        }
    }
    for y := 0; y < 300; y++ {
        for x := 80; x < 85; x++ {
            b.SetPxRgb(x, y, 0x804020)
        }
        for x := 95; x < 100; x++ {
            b.SetPxRgb(x, y, 0x804020)
        }
    }

    // pipe logic
    c := exec.Command("cjpeg", "-outfile", "pipeout.jpg")
    pipe, err := c.StdinPipe()
    if err != nil {
        fmt.Println(err)
        return
    }
    err = c.Start()
    if err != nil {
        fmt.Println(err)
        return
    }
    err = b.WritePpmTo(pipe)
    if err != nil {
        fmt.Println(err)
        return
    }
    err = pipe.Close()
    if err != nil {
        fmt.Println(err)
    }
}


fcn isBrazilian(n){
   foreach b in ([2..n-2]){
      f,m := n%b, n/b;
      while(m){
	 if((m % b)!=f) continue(2);
	 m/=b;
      }
      return(True);
   }
   False
}
fcn isBrazilianW(n){ isBrazilian(n) and n or Void.Skip }


define StringRam $1200                    ;not actually used in the code, but it's here for clarity.
define z_BC $00                           ;fake Z80-style register for pseudo-16-bit operations.
define z_C $00                            ;6502 uses the low byte as the reference point for indirect lookups.
define z_B $01                            ;high byte
define tempMath $02                       ;temp storage of input
define tempBitMask $03                    ;temp storage of the bit filter

lda #$12
sta z_B
lda #$00
sta z_C                                   ;load address $1200 into zero page memory for an indirect lookup.

lda #$0F                                  ;test value
LDY #0                                    ;initialize offset to zero

jsr Hex2BinAscii
brk                                       ;on easy6502 this terminates the program.

Hex2BinAscii:
sta tempMath                              ;store our input, in this case #$0F
lda #%10000000
sta tempBitMask

loop_Hex2BinAscii:
lda tempMath                              ;load input into accumulator.
and tempBitMask                           ;filter out all bits except the one we are checking this pass of the loop
bne bitIsOne
	lda #$30                          ;ascii for zero
	bne StoreBit
bitIsOne:
	lda #$31                          ;ascii for one
StoreBit:
	sta (z_BC),y                      ;store in StringRam+Y
loopOverhead:
	iny                               ;y++
	lsr tempBitMask                   ;shift to next bit in sequence
	beq loop_Hex2BinAscii             ;if mask is zero, we are done. BCC would have worked here as well.
lda #$00                                  ;load the null terminator
sta (z_BC),y	                          ;store the null terminator after the string
rts


with Ada.Streams;  use Ada.Streams;
with Ada.Finalization;

package Bit_Streams is
   type Bit is range 0..1;
   type Bit_Array is array (Positive range <>) of Bit;
   type Bit_Stream (Channel : not null access Root_Stream_Type'Class) is limited private;
   procedure Read (Stream : in out Bit_Stream; Data : out Bit_Array);
   procedure Write (Stream : in out Bit_Stream; Data : Bit_Array);
private
   type Bit_Stream (Channel : not null access Root_Stream_Type'Class) is
      new Ada.Finalization.Limited_Controlled with
   record
      Read_Count  : Natural := 0;
      Write_Count : Natural := 0;
      Input       : Stream_Element_Array (1..1);
      Output      : Stream_Element_Array (1..1);
   end record;
   overriding procedure Finalize (Stream : in out Bit_Stream);
end Bit_Streams;


using System;
using System.IO;
class PPMWriter
{
    public static void WriteBitmapToPPM(string file, Bitmap bitmap)
        {
            //Use a streamwriter to write the text part of the encoding
            var writer = new StreamWriter(file);
            writer.WriteLine("P6");
            writer.WriteLine($"{bitmap.Width}  {bitmap.Height}");
            writer.WriteLine("255");
            writer.Close();
            //Switch to a binary writer to write the data
            var writerB = new BinaryWriter(new FileStream(file, FileMode.Append));
            for (int x = 0; x < bitmap.Height; x++)
                for (int y = 0; y < bitmap.Width; y++)
                {
                    Color color = bitmap.GetPixel(y, x);
                    writerB.Write(color.R);
                    writerB.Write(color.G);
                    writerB.Write(color.B);
                }
            writerB.Close();
        }
}


#include <fstream>
#include <cstdio>

int main() {
    constexpr auto dimx = 800u, dimy = 800u;

    using namespace std;
    ofstream ofs("first.ppm", ios_base::out | ios_base::binary);
    ofs << "P6" << endl << dimx << ' ' << dimy << endl << "255" << endl;

    for (auto j = 0u; j < dimy; ++j)
        for (auto i = 0u; i < dimx; ++i)
            ofs << (char) (i % 256) << (char) (j % 256) << (char) ((i * j) % 256);       // red, green, blue

    ofs.close();

    return EXIT_SUCCESS;
}


fcn eyeball(code,ps=L(),brace=False){ //-->indexes of valid braces & commas
   cs:=L();
   foreach c in (code){ // start fresh or continue (if recursing)
      switch(c){
	 case("\\"){ __cWalker.next(); }
	 case(",") { if(brace) cs.append(__cWalker.n); } // maybe valid
	 case("{") {  // this is real only if there is matching } and a comma
	    n:=__cWalker.n;
	    _,cz:=self.fcn(__cWalker,ps,True);
	    if(cz){ ps.append(n,__cWalker.n); ps.extend(cz) } // valid {} pair
	 }
	 case("}"){ if(brace) return(ps,cs); }
      }
   }
   return(ps,False)
}

fcn expando(code,strings=T("")){
   reg [const] stack=List(); reg roots,cs; bs,_:=eyeball(code);
   foreach c in (code){
      if(bs.holds(__cWalker.n)){
         if     (c=="{") { stack.append(cs); cs=0; roots=strings;       }
	 else if(c==",") { stack.append(strings); strings=roots; cs+=1; }
	 else if(c=="}") { do(cs){ strings=stack.pop().extend(strings); } cs=stack.pop(); }
      }else   if(c=="\\"){
	 c="\\"+__cWalker.next();
	 strings=strings.apply('+(c));
      }
      else strings=strings.apply('+(c));
   }
   strings
}


using Images, FileIO

ppmimg = load("data/bitmapInputTest.ppm")
save("data/bitmapOutputTest.jpg", ppmimg)


// Version 1.2.40

import java.awt.Color
import java.awt.Graphics
import java.awt.image.BufferedImage

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

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

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

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

fun main(args: Array<String>) {
    // create BasicBitmapStorage object
    val width = 640
    val height = 640
    val bbs = BasicBitmapStorage(width, height)
    for (y in 0 until height) {
        for (x in 0 until width) {
            val c = Color(x % 256, y % 256, (x * y) % 256)
            bbs.setPixel(x, y, c)
        }
    }

    // now write the object in PPM format to ImageMagick's STDIN via a pipe
    // so it can be converted to a .jpg file and written to disk
    val pb = ProcessBuilder("convert", "-", "output_piped.jpg")
    pb.directory(null)
    pb.redirectInput(ProcessBuilder.Redirect.PIPE)
    val buffer = ByteArray(width * 3) // write one line at a time
    val proc = pb.start()
    val pStdIn = proc.outputStream
    pStdIn.use {
        val header = "P6\n$width $height\n255\n".toByteArray()
        with (it) {
            write(header)
            for (y in 0 until height) {
                for (x in 0 until width) {
                    val c = bbs.getPixel(x, y)
                    buffer[x * 3] = c.red.toByte()
                    buffer[x * 3 + 1] = c.green.toByte()
                    buffer[x * 3 + 2] = c.blue.toByte()
                }
                write(buffer)
            }
        }
    }
}


bc()={
  my(u,v,bulls,cows);
  while(#vecsort(v=vector(4,i,random(9)+1),,8)<4,);
  while(bulls<4,
    u=input();
    if(type(u)!="t_VEC"|#u!=4,next);
    bulls=sum(i=1,4,u[i]==v[i]);
    cows=sum(i=1,4,sum(j=1,4,i!=j&v[i]==u[j]));
    print("You have "bulls" bulls and "cows" cows")
  )
};


Program BullCow;

{$mode objFPC}

uses Math, SysUtils;

type
   TFourDigit = array[1..4] of integer;

Procedure WriteFourDigit(fd: TFourDigit);
{ Write out a TFourDigit with no line break following. }
var
   i: integer;
begin
   for i := 1 to 4 do
   begin
      Write(fd[i]);
   end;
end;

Function WellFormed(Tentative: TFourDigit): Boolean;
{ Does the TFourDigit avoid repeating digits? }
var
   current, check: integer;
begin

   Result := True;

   for current := 1 to 4 do
   begin
      for check := current + 1 to 4 do
      begin
         if Tentative[check] = Tentative[current] then
         begin
            Result := False;
         end;
      end;
   end;

end;

Function MakeNumber(): TFourDigit;
{ Make a random TFourDigit, keeping trying until it is well-formed. }
var
   i: integer;
begin
   for i := 1 to 4 do
   begin
      Result[i] := RandomRange(1, 9);
   end;
   if not WellFormed(Result) then
   begin
      Result := MakeNumber();
   end;
end;

Function StrToFourDigit(s: string): TFourDigit;
{ Convert an (input) string to a TFourDigit. }
var
   i: integer;
begin
   for i := 1 to Length(s) do
   begin
      StrToFourDigit[i] := StrToInt(s[i]);
   end;
end;

Function Wins(Num, Guess: TFourDigit): Boolean;
{ Does the guess win? }
var
   i: integer;
begin
   Result := True;
   for i := 1 to 4 do
   begin
      if Num[i] <> Guess[i] then
      begin
         Result := False;
         Exit;
      end;
   end;
end;

Function GuessScore(Num, Guess: TFourDigit): string;
{ Represent the score of the current guess as a string. }
var
   i, j, bulls, cows: integer;
begin

   bulls := 0;
   cows := 0;

   { Count the cows and bulls. }
   for i := 1 to 4 do
   begin
      for j := 1 to 4 do
      begin
         if  (Num[i] = Guess[j]) then
         begin
            { If the indices are the same, that would be a bull. }
            if (i = j) then
            begin
               bulls := bulls + 1;
            end
            else
            begin
               cows := cows + 1;
            end;
         end;
      end;
   end;

   { Format the result as a sentence. }
   Result := IntToStr(bulls) + ' bulls, ' + IntToStr(cows) + ' cows.';

end;

Function GetGuess(): TFourDigit;
{ Get a well-formed user-supplied TFourDigit guess. }
var
   input: string;
begin

   WriteLn('Enter a guess:');
   ReadLn(input);

   { Must be 4 digits. }
   if Length(input) = 4 then
   begin

      Result := StrToFourDigit(input);

      if not WellFormed(Result) then
      begin
         WriteLn('Four unique digits, please.');
         Result := GetGuess();
      end;

   end
   else
   begin
      WriteLn('Please guess a four-digit number.');
      Result := GetGuess();
   end;

end;

var
   Num, Guess: TFourDigit;
   Turns: integer;
begin

   { Initialize the randymnity. }
   Randomize();

   { Make the secred number. }
   Num := MakeNumber();

   WriteLn('I have a secret number. Guess it!');

   Turns := 0;

   { Guess until the user gets it. }
   While True do
   begin

      Guess := GetGuess();

      { Count each guess as a turn. }
      Turns := Turns + 1;

      { If the user won, tell them and ditch. }
      if Wins(Num, Guess) then
      begin
         WriteLn('You won in ' + IntToStr(Turns) + ' tries.');
         Write('The number was ');
         WriteFourDigit(Num);
         WriteLn('!');
         Exit;
      end
      else { Otherwise, score it and get a new guess. }
      begin
         WriteLn(GuessScore(Num, Guess));
      end;

   end;

end.


# NIBBLEs are of any width, eg 1-bit OR 4-bits etc. #
MODE NIBBLE = STRUCT(INT width, BITS bits);

PRIO << = 8, >> = 8; # define C style shift opertors #
OP << = (BITS bits, INT shift)BITS: bits SHL shift;
OP >> = (BITS bits, INT shift)BITS: bits SHR shift;

# define nibble opertors for left/right shift and append #
OP << = (NIBBLE nibble, INT shift)NIBBLE:
  (width OF nibble + shift, bits OF nibble << shift);

OP >> = (NIBBLE nibble, INT shift)NIBBLE:
  (width OF nibble - shift, bits OF nibble >> shift);

OP +:= = (REF NIBBLE lhs, NIBBLE rhs)REF NIBBLE: (
  BITS rhs mask := BIN(ABS(2r1 << width OF rhs)-1);
  lhs := ( width OF lhs + width OF rhs, bits OF lhs << width OF rhs OR bits OF rhs AND rhs mask)
);

# define MODEs for generating NIBBLE streams and yielding NIBBLEs #
MODE YIELDNIBBLE = PROC(NIBBLE)VOID;
MODE GENNIBBLE = PROC(YIELDNIBBLE)VOID;

PROC gen resize nibble = (
  INT out width,
  GENNIBBLE gen nibble,
  YIELDNIBBLE yield
)VOID:(
     NIBBLE buf := (0, 2r0), out;
     BITS out mask := BIN(ABS(2r1 << out width)-1);
# FOR NIBBLE nibble IN # gen nibble( # ) DO #
##   (NIBBLE in nibble)VOID:(
    buf +:= in nibble;
    WHILE width OF buf >= out width DO
      out := buf >> ( width OF buf - out width);
      width OF buf -:= out width; # trim 'out' from buf #
      yield((out width, bits OF out AND out mask))
    OD
# OD # ))
);

# Routines for joining strings and generating a stream of nibbles #

PROC gen nibble from 7bit chars = (STRING string, YIELDNIBBLE yield)VOID:
  FOR key FROM LWB string TO UPB string DO yield((7, BIN ABS string[key])) OD;

PROC gen nibble from 8bit chars = (STRING string, YIELDNIBBLE yield)VOID:
  FOR key FROM LWB string TO UPB string DO yield((8,BIN ABS string[key])) OD;

PROC gen join = ([]STRING strings, STRING new line, YIELDNIBBLE yield)VOID:
   FOR key FROM LWB strings TO UPB strings DO
     gen nibble from 8bit chars(strings[key]+new line, yield)
   OD;

# Two tables for uuencoding 6bits in printable ASCII chacters #

[0:63]CHAR encode uue 6bit:= # [0:63] => CHAR64 #
  "`!""#$%&'()*+,-./0123456789:;<=>[email protected][\]^_"[@0];

[0:255]BITS decode uue 6bit; # CHAR64 => [0:63] #
  FOR key FROM LWB encode uue 6bit TO UPB encode uue 6bit DO
    decode uue 6bit[ABS encode uue 6bit[key]] := BIN key
  OD;
  decode uue 6bit[ABS " "] := 2r0; # extra #

# Some basic examples #

PROC example uudecode nibble stream = VOID:(

  []STRING encoded uue 6bit hello world = (
    ":&5L;&\L('=O<FQD""DAE;&QO+""!W;W)L9""$*1V]O9&)[email protected])[email protected]=V]R",
    ";&0*22=M(&QE879I;F<@>6]U('1O9&%Y""D=O;V1B>64L(&=O;V1B>64L(&=O",
    ";V1B>[email protected]""@``"
  );

  PROC gen join hello world = (YIELDNIBBLE yield)VOID:
  # FOR NIBBLE nibble IN # gen join(encoded uue 6bit hello world, "", # ) DO #
  ##   (NIBBLE nibble)VOID:(
    yield((6, decode uue 6bit[ABS bits OF nibble]))
  # OD # ));

  print(("Decode uue 6bit NIBBLEs into 8bit CHARs:", new line));

# FOR NIBBLE nibble IN # gen resize nibble(8, gen join hello world, # ) DO ( #
##   (NIBBLE nibble)VOID:(
    print(REPR ABS bits OF nibble)
# OD # ))
);

PROC example uuencode nibble stream = VOID: (
  []STRING hello world = (
    "hello, world",
    "Hello, world!",
    "Goodbye, cruel world",
    "I'm leaving you today",
    "Goodbye, goodbye, goodbye "
  );

  PROC gen join hello world = (YIELDNIBBLE yield)VOID:
    gen join(hello world, REPR ABS 8r12, yield); # 8r12 = ASCII new line #

  print((new line, "Encode 8bit CHARs into uue 6bit NIBBLEs:", new line));
  INT count := 0;
# FOR NIBBLE nibble IN # gen resize nibble(6, gen join hello world, # ) DO ( #
##   (NIBBLE nibble)VOID:(
    print(encode uue 6bit[ABS bits OF nibble]);
    count+:=1;
    IF count MOD 60 = 0 THEN print(newline) FI
# OD # ));
    print(new line); print(new line)
);

PROC example compress 7bit chars = VOID: (
  STRING example 7bit string = "STRING & ABACUS";

  print(("Convert 7bit ASCII CHARS to a 1bit stream: ",new line,
          example 7bit string + " => "));

  PROC gen example 7bit string = (YIELDNIBBLE yield)VOID:
    gen nibble from 7bit chars(example 7bit string,yield);

# FOR NIBBLE nibble IN # gen resize nibble(1, gen example 7bit string, # ) DO ( #
##   (NIBBLE nibble)VOID: (
    print(whole(ABS bits OF nibble,0))
# OD # ));
  print(new line)
);

example uudecode nibble stream;
example uuencode nibble stream;
example compress 7bit chars


(defun write-rgb-buffer-to-ppm-file (filename buffer)
  (with-open-file (stream filename
			  :element-type '(unsigned-byte 8)
			  :direction :output
			  :if-does-not-exist :create
			  :if-exists :supersede)
    (let* ((dimensions (array-dimensions buffer))
	   (width (first dimensions))
	   (height (second dimensions))
	   (header (format nil "P6~A~D ~D~A255~A"
			   #\newline
			   width height #\newline
			   #\newline)))
      (loop
	 :for char :across header
	 :do (write-byte (char-code char) stream)) #| Assumes char-codes match ASCII |#

      (loop
	 :for x :upfrom 0 :below width
	 :do (loop :for y :upfrom 0 :below height
		:do (let ((pixel (rgb-pixel buffer x y)))
		      (let ((red (rgb-pixel-red pixel))
			    (green (rgb-pixel-green pixel))
			    (blue (rgb-pixel-blue pixel)))
			(write-byte red stream)
			(write-byte green stream)
			(write-byte blue stream)))))))
  filename)


program btm2ppm;

{$APPTYPE CONSOLE}

{$R *.res}

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

type
  TBitmapHelper = class helper for TBitmap
  public
    procedure SaveAsPPM(FileName: TFileName);
  end;

{ TBitmapHelper }

procedure TBitmapHelper.SaveAsPPM(FileName: TFileName);
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
        color := ColorToRGB(Self.Canvas.Pixels[i, j]);
        ppm.Write(color, 3);
      end;
    ppm.SaveToFile(FileName);
  finally
    ppm.Free;
  end;
end;

begin
  with TBitmap.Create do
  begin
    LoadFromFile('Input.bmp');
    SaveAsPPM('Output.ppm');
    Free;
  end;
end.


import bitmap
import ppm_write
import osproc

# Build an image.
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)

# Launch ImageMagick "convert".
# Input is taken from stdin and result written in "output1.jpeg".
var p = startProcess("convert", args = ["ppm:-", "output1.jpeg"], options = {poUsePath})
var stream = p.inputStream()
image.writePPM(stream)
p.close()

# Launch Netpbm "pnmtojpeg".
# Input is taken from stdin and output sent to "output2.jpeg".
p = startProcess("pnmtojpeg >output2.jpeg", options = {poUsePath, poEvalCommand})
stream = p.inputStream()
image.writePPM(stream)
p.close()


let print_jpeg ~img ?(quality=96) () =
  let cmd = Printf.sprintf "cjpeg -quality %d" quality in
  (*
  let cmd = Printf.sprintf "ppmtojpeg -quality %d" quality in
  let cmd = Printf.sprintf "convert ppm:- -quality %d jpg:-" quality in
  *)
  let ic, oc = Unix.open_process cmd in
  output_ppm ~img ~oc;
  try
    while true do
      let c = input_char ic in
      print_char c
    done
  with End_of_file -> ()
;;


# 20211224 Perl programming solution

use strict;
use warnings;

use Imager;
use Imager::Test 'test_image_raw';

my $img = test_image_raw();
my $IO  = Imager::io_new_bufchain();
Imager::i_writeppm_wiol($img, $IO) or die;
my $raw = Imager::io_slurp($IO) or die;

open my $fh, '|-', '/usr/local/bin/convert - -compress none output.jpg' or die;
binmode $fh;
syswrite $fh, $raw or die;
close $fh;


-- demo\rosetta\Bitmap_PPM_conversion_through_a_pipe.exw
without js -- file i/o, system_exec(), pipes[!!]
include builtins\pipeio.e
include builtins\serialize.e
include ppm.e -- read_ppm()

sequence pipes = repeat(0,3)
pipes[PIPEIN] = create_pipe(INHERIT_WRITE)

-- Create the child process, with replacement stdin.
string cmd = sprintf("%s viewppm -save test.jpg",{get_interpreter(true)})
atom hProc = system_exec(cmd, 12, pipes),
     hPipe = pipes[PIPEIN][WRITE_PIPE]

sequence img = serialize(read_ppm("Lena.ppm",bFlat:=true))
if not write_to_pipe(hPipe,img) then crash("error") end if

-- Close the pipe handle so the child process stops reading.
--hPipe = close_handles(hPipe)
pipes = close_handles(pipes) -- (may as well do the lot)

?"done"
{} = wait_key()


use Data::Random qw(rand_set);
use List::MoreUtils qw(uniq);

my $size = 4;
my $chosen = join "", rand_set set => ["1".."9"], size => $size;

print "I've chosen a number from $size unique digits from 1 to 9; you need
to input $size unique digits to guess my number\n";

for ( my $guesses = 1; ; $guesses++ ) {
    my $guess;
    while (1) {
        print "\nNext guess [$guesses]: ";
        $guess = <STDIN>;
        chomp $guess;
        checkguess($guess) and last;
        print "$size digits, no repetition, no 0... retry\n";
    }
    if ( $guess eq $chosen ) {
        print "You did it in $guesses attempts!\n";
        last;
    }
    my $bulls = 0;
    my $cows = 0;
    for my $i (0 .. $size-1) {
        if ( substr($guess, $i, 1) eq substr($chosen, $i, 1) ) {
            $bulls++;
        } elsif ( index($chosen, substr($guess, $i, 1)) >= 0 ) {
            $cows++;
        }
    }
    print "$cows cows, $bulls bulls\n";
}

sub checkguess
{
    my $g = shift;
    return uniq(split //, $g) == $size && $g =~ /^[1-9]{$size}$/;
}


file = %A_WorkingDir%\z.dat
IfExist, %A_WorkingDir%\z.dat
    FileDelete %file%
IfNotEqual ErrorLevel,0, MsgBox Can't delete file "%file%"`nErrorLevel = "%ErrorLevel%"

res := BinWrite(file,"000102030405060708090a0b0c0d0e0f00")
MsgBox ErrorLevel = %ErrorLevel%`nBytes Written = %res%
res := BinRead(file,data)
MsgBox ErrorLevel = %ErrorLevel%`nBytes Read = %res%`nData = "%data%"

res := BinWrite(file,"aa00bb",0,2)
MsgBox ErrorLevel = %ErrorLevel%`nBytes Written = %res%
res := BinRead(file,data)
MsgBox ErrorLevel = %ErrorLevel%`nBytes Read = %res%`nData = "%data%"

res := BinRead(file,data,3,-2)
MsgBox ErrorLevel = %ErrorLevel%`nBytes Read = %res%`nData = "%data%"
ExitApp

/* ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BinWrite ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|  - Open binary file
|  - (Over)Write n bytes (n = 0: all)
|  - From offset (offset < 0: counted from end)
|  - Close file
|  data -> file[offset + 0..n-1], rest of file unchanged
|  Return #bytes actually written
*/ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

BinWrite(file, data, n=0, offset=0)
{
   ; Open file for WRITE (0x40..), OPEN_ALWAYS (4): creates only if it does not exists
   h := DllCall("CreateFile","str",file,"Uint",0x40000000,"Uint",0,"UInt",0,"UInt",4,"Uint",0,"UInt",0)
   IfEqual h,-1, SetEnv, ErrorLevel, -1
   IfNotEqual ErrorLevel,0,Return,0 ; couldn't create the file

   m = 0                            ; seek to offset
   IfLess offset,0, SetEnv,m,2
   r := DllCall("SetFilePointerEx","Uint",h,"Int64",offset,"UInt *",p,"Int",m)
   IfEqual r,0, SetEnv, ErrorLevel, -3
   IfNotEqual ErrorLevel,0, {
      t = %ErrorLevel%              ; save ErrorLevel to be returned
      DllCall("CloseHandle", "Uint", h)
      ErrorLevel = %t%              ; return seek error
      Return 0
   }

   TotalWritten = 0
   m := Ceil(StrLen(data)/2)
   If (n <= 0 or n > m)
       n := m
   Loop %n%
   {
      StringLeft c, data, 2         ; extract next byte
      StringTrimLeft data, data, 2  ; remove  used byte
      c = 0x%c%                     ; make it number
      result := DllCall("WriteFile","UInt",h,"UChar *",c,"UInt",1,"UInt *",Written,"UInt",0)
      TotalWritten += Written       ; count written
      if (!result or Written < 1 or ErrorLevel)
         break
   }

   IfNotEqual ErrorLevel,0, SetEnv,t,%ErrorLevel%

   h := DllCall("CloseHandle", "Uint", h)
   IfEqual h,-1, SetEnv, ErrorLevel, -2
   IfNotEqual t,,SetEnv, ErrorLevel, %t%

   Return TotalWritten
}

/* ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BinRead ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|  - Open binary file
|  - Read n bytes (n = 0: all)
|  - From offset (offset < 0: counted from end)
|  - Close file
|  data (replaced) <- file[offset + 0..n-1]
|  Return #bytes actually read
*/ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

BinRead(file, ByRef data, n=0, offset=0)
{
   h := DllCall("CreateFile","Str",file,"Uint",0x80000000,"Uint",3,"UInt",0,"UInt",3,"Uint",0,"UInt",0)
   IfEqual h,-1, SetEnv, ErrorLevel, -1
   IfNotEqual ErrorLevel,0,Return,0 ; couldn't open the file

   m = 0                            ; seek to offset
   IfLess offset,0, SetEnv,m,2
   r := DllCall("SetFilePointerEx","Uint",h,"Int64",offset,"UInt *",p,"Int",m)
   IfEqual r,0, SetEnv, ErrorLevel, -3
   IfNotEqual ErrorLevel,0, {
      t = %ErrorLevel%              ; save ErrorLevel to be returned
      DllCall("CloseHandle", "Uint", h)
      ErrorLevel = %t%              ; return seek error
      Return 0
   }

   TotalRead = 0
   data =
   IfEqual n,0, SetEnv n,0xffffffff ; almost infinite

   format = %A_FormatInteger%       ; save original integer format
   SetFormat Integer, Hex           ; for converting bytes to hex

   Loop %n%
   {
      result := DllCall("ReadFile","UInt",h,"UChar *",c,"UInt",1,"UInt *",Read,"UInt",0)
      if (!result or Read < 1 or ErrorLevel)
         break
      TotalRead += Read             ; count read
      c += 0                        ; convert to hex
      StringTrimLeft c, c, 2        ; remove 0x
      c = 0%c%                      ; pad left with 0
      StringRight c, c, 2           ; always 2 digits
      data = %data%%c%              ; append 2 hex digits
   }

   IfNotEqual ErrorLevel,0, SetEnv,t,%ErrorLevel%

   h := DllCall("CloseHandle", "Uint", h)
   IfEqual h,-1, SetEnv, ErrorLevel, -2
   IfNotEqual t,,SetEnv, ErrorLevel, %t%

   SetFormat Integer, %format%      ; restore original format
   Totalread += 0                   ; convert to original format
   Return TotalRead
}


# Create an empty image of 120 x 90 pixels
(setq *Ppm (make (do 90 (link (need 120)))))

# Fill background with green color
(ppmFill *Ppm 0 255 0)

# Draw a diagonal line
(for I 80 (ppmSetPixel *Ppm I I 0 0 0))

# Write to "img.jpg" through a pipe
(ppmWrite *Ppm '("convert" "-" "img.jpg"))


"""
Adapted from https://stackoverflow.com/questions/26937143/ppm-to-jpeg-jpg-conversion-for-python-3-4-1
Requires pillow-5.3.0 with Python 3.7.1 32-bit on Windows.
Sample ppm graphics files from http://www.cs.cornell.edu/courses/cs664/2003fa/images/
"""

from PIL import Image

im = Image.open("boxes_1.ppm")
im.save("boxes_1.jpg")


(define (ppm->jpeg bitmap [jpg-file "output"] [quality 75])
  (define command (format "convert ppm:- -quality ~a jpg:~a.jpg" quality jpg-file))
  (match-define (list in out pid err ctrl)  (process command))
  (bitmap->ppm bitmap out)
  (close-input-port in)
  (close-output-port out))

(ppm->jpeg bm)


# Reference:
# https://rosettacode.org/wiki/Bitmap/Write_a_PPM_file#Raku

use v6;

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);
}

my $proc = run '/usr/bin/convert','-','output_piped.jpg', :in;
$proc.in.write: $b.P6;
$proc.in.close;


--
-- demo\rosetta\BullsAndCows.exw
-- =============================
--
with javascript_semantics -- (DEV lots of resizing issues)
constant N = 4

function mask(integer ch)
    return power(2,ch-'1')
end function

function score(string guess, goal)
    integer bits = 0, bulls = 0, cows = 0, b
    for i=1 to N do
        b = goal[i]
        if guess[i]=b then
            bulls += 1
        else
            bits += mask(b)
        end if
    end for
    for i=1 to N do
        b = mask(guess[i])
        if and_bits(bits,b)!=0 then
            cows += 1
            bits -= b
        end if
    end for
    return {bulls, cows}
end function

include pGUI.e

Ihandle label, guess, res, dlg

string fmt = "   Guess %-2d  (%s)  bulls:%d  cows:%d\n",
       tgt = shuffle("123456789")[1..N]
integer attempt = 1

function valuechanged_cb(Ihandle /*guess*/)
    string g = IupGetAttribute(guess,"VALUE")
    if length(g)=4 and length(unique(g))=4 then
        integer {bulls, cows} = score(g,tgt)
        string title = IupGetAttribute(res,"TITLE") &
                       sprintf(fmt,{attempt,g,bulls,cows})
        if bulls=N then
            title &= "\nWell done!"
            IupSetInt(guess,"ACTIVE",false)
        else
            IupSetAttribute(guess,"VALUE","")
        end if
        IupSetStrAttribute(res,"TITLE",title)
        attempt += 1
        IupSetAttribute(dlg,"SIZE",NULL)
        IupRefresh(dlg)
    end if
    return IUP_DEFAULT
end function

procedure main()
    IupOpen()
    label = IupLabel(sprintf("Enter %d digits 1 to 9 without duplication",{N}))
    guess = IupText("VALUECHANGED_CB", Icallback("valuechanged_cb"))
    res = IupLabel("")
    dlg = IupDialog(IupVbox({IupHbox({label,guess},"GAP=10,NORMALIZESIZE=VERTICAL"),
                             IupHbox({res})},"MARGIN=5x5"),`TITLE="Bulls and Cows"`)
    IupShow(dlg)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


      file$ = @tmp$ + "bitwise.tmp"
      test$ = "Hello, world!"

      REM Write to file, 7 bits per character:
      file% = OPENOUT(file$)
      FOR i% = 1 TO LEN(test$)
        PROCwritebits(file%, ASCMID$(test$,i%), 7)
      NEXT
      PROCwritebits(file%, 0, 0)
      CLOSE #file%

      REM Read from file, 7 bits per character:
      file% = OPENIN(file$)
      REPEAT
        ch% = FNreadbits(file%, 7)
        VDU ch%
      UNTIL ch% = 0
      PRINT
      CLOSE #file%
      END

      REM Write n% bits from b% to file f% (n% = 0 to flush):
      DEF PROCwritebits(f%, b%, n%)
      PRIVATE a%, c%
      IF n% = 0 BPUT #f%,a% : a% = 0 : c% = 0
      WHILE n%
        IF c% = 8 BPUT #f%,a% : a% = 0 : c% = 0
        n% -= 1
        c% += 1
        IF b% AND 1 << n% THEN a% OR= 1 << (8 - c%)
      ENDWHILE
      ENDPROC

      REM Read n% bits from file f%:
      DEF FNreadbits(f%, n%)
      PRIVATE a%, c% : LOCAL v%
      WHILE n%
        IF c% = 0 a% = BGET#f% : c% = 8
        n% -= 1
        c% -= 1
        v% = v% << 1 OR (a% >> c%) AND 1
      ENDWHILE
      = v%


#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
#include <string.h>

typedef uint8_t byte;
typedef struct {
    FILE *fp;
    uint32_t accu;
    int bits;
} bit_io_t, *bit_filter;

bit_filter b_attach(FILE *f)
{
    bit_filter b = malloc(sizeof(bit_io_t));
    b->bits = b->accu = 0;
    b->fp = f;
    return b;
}

void b_write(byte *buf, size_t n_bits, size_t shift, bit_filter bf)
{
    uint32_t accu = bf->accu;
    int bits = bf->bits;

    buf += shift / 8;
    shift %= 8;

    while (n_bits || bits >= 8) {
        while (bits >= 8) {
            bits -= 8;
            fputc(accu >> bits, bf->fp);
            accu &= (1 << bits) - 1;
        }
        while (bits < 8 && n_bits) {
            accu = (accu << 1) | (((128 >> shift) & *buf) >> (7 - shift));
            --n_bits;
            bits++;
            if (++shift == 8) {
                shift = 0;
                buf++;
            }
        }
    }
    bf->accu = accu;
    bf->bits = bits;
}

size_t b_read(byte *buf, size_t n_bits, size_t shift, bit_filter bf)
{
    uint32_t accu = bf->accu;
    int bits = bf->bits;
    int mask, i = 0;

    buf += shift / 8;
    shift %= 8;

    while (n_bits) {
        while (bits && n_bits) {
            mask = 128 >> shift;
            if (accu & (1 << (bits - 1))) *buf |= mask;
            else *buf &= ~mask;

            n_bits--;
            bits--;

            if (++shift >= 8) {
                shift = 0;
                buf++;
            }
        }
        if (!n_bits) break;
        accu = (accu << 8) | fgetc(bf->fp);
        bits += 8;
    }
    bf->accu = accu;
    bf->bits = bits;

    return i;
}

void b_detach(bit_filter bf)
{
    if (bf->bits) {
        bf->accu <<= 8 - bf->bits;
        fputc(bf->accu, bf->fp);
    }
    free(bf);
}

int main()
{
    unsigned char s[] = "abcdefghijk";
    unsigned char s2[11] = {0};
    int i;

    FILE *f = fopen("test.bin", "wb");
    bit_filter b = b_attach(f);
    /* for each byte in s, write 7 bits skipping 1 */
    for (i = 0; i < 10; i++) b_write(s + i, 7, 1, b);
    b_detach(b);
    fclose(f);

    /* read 7 bits and expand to each byte of s2 skipping 1 bit */
    f = fopen("test.bin", "rb");
    b = b_attach(f);
    for (i = 0; i < 10; i++) b_read(s2 + i, 7, 1, b);
    b_detach(b);
    fclose(f);

    printf("%10s\n", s2); /* should be the same first 10 bytes as in s */

    return 0;
}


-module(ppm).

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

-define(WHITESPACE, <<10>>).
-define(SPACE, <<32>>).

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

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

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

%%%%%%%%%%%% four parts of ppm file %%%%%%%%%%%%%%%%%%%%%%
header() ->
    [<<"P6">>, ?WHITESPACE].

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

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

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

%%%%%%%%%%%% Internals %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
encode_decimal(Number) ->
    integer_to_list(Number).


class Pixmap
  PIXMAP_FORMATS = ["P3", "P6"]   # implemented output formats
  PIXMAP_BINARY_FORMATS = ["P6"]  # implemented output formats which are binary

  def write_ppm(ios, format="P6")
    if not PIXMAP_FORMATS.include?(format)
      raise NotImplementedError, "pixmap format #{format} has not been implemented"
    end
    ios.puts format, "#{@width} #{@height}", "255"
    ios.binmode if PIXMAP_BINARY_FORMATS.include?(format)
    @height.times do |y|
      @width.times do |x|
        case format
        when "P3" then ios.print @data[x][y].values.join(" "),"\n"
        when "P6" then ios.print @data[x][y].values.pack('C3')
        end
      end
    end
  end

  def save(filename, opts={:format=>"P6"})
    File.open(filename, 'w') do |f|
      write_ppm(f, opts[:format])
    end
  end

  def print(opts={:format=>"P6"})
    write_ppm($stdout, opts[:format])
  end

  def save_as_jpeg(filename, quality=75)
    pipe = IO.popen("convert ppm:- -quality #{quality} jpg:#{filename}", 'w')
    write_ppm(pipe)
    pipe.close
  end
end

image = Pixmap.open('file.ppm')
image.save_as_jpeg('file.jpg')


val useOSConvert =  fn ppm =>
  let
   val img       =   String.translate (fn #"\"" => "\\\""|n=>str n )  ppm ;
   val app        = " convert  -  jpeg:- "
   val fname      = "/tmp/fConv" ^ (String.extract (Time.toString (Posix.ProcEnv.time()),7,NONE) );
   val shellCommand = " echo   \"" ^ img  ^ "\"  | "  ^  app  ;
   val me         = (  Posix.FileSys.mkfifo
                               (fname,
			        Posix.FileSys.S.flags [ Posix.FileSys.S.irusr,Posix.FileSys.S.iwusr ]
			       ) ;
                       Posix.Process.fork ()
		     ) ;
  in
   if (Option.isSome me) then
     let
        val fin =BinIO.openIn fname
     in
        ( Posix.Process.sleep (Time.fromReal 0.1) ;
          BinIO.inputAll fin  before
	  (BinIO.closeIn fin ; OS.FileSys.remove fname )
	)
     end
   else
     ( OS.Process.system (  shellCommand ^ " > " ^ fname  ^ " 2>&1 "     ) ;
       Word8Vector.fromList [] before OS.Process.exit OS.Process.success
     )
  end;


package require Tk

proc output_jpeg {image filename {quality 75}} {
    set f [open |[list convert ppm:- -quality $quality jpg:- > $filename] w]
    fconfigure $f -translation binary
    puts -nonewline $f [$image data -format ppm]
    close $f
}


/* gcc -O3 -std=c11 -shared -o pipeconv.so -fPIC  -I./include pipeconv.c */

#include <stdlib.h>
#include <string.h>
#include "dome.h"

static DOME_API_v0* core;
static WREN_API_v0* wren;

static const char* source =  ""
"class PipeConv {\n"
  "foreign static convert(from, to) \n"
"} \n";

void C_convert(WrenVM* vm) {
    const char *from = wren->getSlotString(vm, 1);
    const char *to = wren->getSlotString(vm, 2);
    char command[strlen(from) + strlen(to) + 10];
    strcpy(command, "convert ");
    strcat(command, from);
    strcat(command, " ");
    strcat(command, to);
    int res = system(command);
}

DOME_EXPORT DOME_Result PLUGIN_onInit(DOME_getAPIFunction DOME_getAPI, DOME_Context ctx) {
    core = DOME_getAPI(API_DOME, DOME_API_VERSION);
    wren = DOME_getAPI(API_WREN, WREN_API_VERSION);
    core->registerModule(ctx, "pipeconv", source);
    core->registerClass(ctx, "pipeconv", "PipeConv", NULL, NULL);
    core->registerFn(ctx, "pipeconv", "static PipeConv.convert(_,_)", C_convert);
    return DOME_RESULT_SUCCESS;
}

DOME_EXPORT DOME_Result PLUGIN_preUpdate(DOME_Context ctx) {
    return DOME_RESULT_SUCCESS;
}

DOME_EXPORT DOME_Result PLUGIN_postUpdate(DOME_Context ctx) {
    return DOME_RESULT_SUCCESS;
}

DOME_EXPORT DOME_Result PLUGIN_preDraw(DOME_Context ctx) {
    return DOME_RESULT_SUCCESS;
}

DOME_EXPORT DOME_Result PLUGIN_postDraw(DOME_Context ctx) {
    return DOME_RESULT_SUCCESS;
}

DOME_EXPORT DOME_Result PLUGIN_onShutdown(DOME_Context ctx) {
    return DOME_RESULT_SUCCESS;
}


<?php
$size = 4;

$chosen = implode(array_rand(array_flip(range(1,9)), $size));

echo "I've chosen a number from $size unique digits from 1 to 9; you need
to input $size unique digits to guess my number\n";

for ($guesses = 1; ; $guesses++) {
    while (true) {
        echo "\nNext guess [$guesses]: ";
        $guess = rtrim(fgets(STDIN));
        if (!checkguess($guess))
            echo "$size digits, no repetition, no 0... retry\n";
        else
            break;
    }
    if ($guess == $chosen) {
        echo "You did it in $guesses attempts!\n";
        break;
    } else {
        $bulls = 0;
        $cows = 0;
        foreach (range(0, $size-1) as $i) {
            if ($guess[$i] == $chosen[$i])
                $bulls++;
            else if (strpos($chosen, $guess[$i]) !== FALSE)
                $cows++;
        }
        echo "$cows cows, $bulls bulls\n";
    }
}

function checkguess($g)
{
  global $size;
  return count(array_unique(str_split($g))) == $size &&
    preg_match("/^[1-9]{{$size}}$/", $g);
}
?>


using System;
using System.IO;

public class BitReader
{
    uint readData = 0;
    int startPosition = 0;
    int endPosition = 0;

    public int InBuffer
    {
        get { return endPosition - startPosition; }
    }

    private Stream stream;

    public Stream BaseStream
    {
        get { return stream; }
    }

    public BitReader(Stream stream)
    {
        this.stream = stream;
    }

    void EnsureData(int bitCount)
    {
        int readBits = bitCount - InBuffer;
        while (readBits > 0)
        {
            int b = BaseStream.ReadByte();

            if (b < 0) throw new InvalidOperationException("Unexpected end of stream");

            readData |= checked((uint)b << endPosition);
            endPosition += 8;
            readBits -= 8;
        }
    }

    public bool ReadBit()
    {
        return Read(1) > 0;
    }

    public int Read(int bitCount)
    {
        EnsureData(bitCount);

        int result = (int)(readData >> startPosition) & ((1 << bitCount) - 1);
        startPosition += bitCount;
        if (endPosition == startPosition)
        {
            endPosition = startPosition = 0;
            readData = 0;
        }
        else if (startPosition >= 8)
        {
            readData >>= startPosition;
            endPosition -= startPosition;
            startPosition = 0;
        }

        return result;
    }

    public void Align()
    {
        endPosition = startPosition = 0;
        readData = 0;
    }
}

public class BitWriter
{
    uint data = 0;
    int dataLength = 0;
    Stream stream;

    public Stream BaseStream
    {
        get { return stream; }
    }

    public int BitsToAligment
    {
        get { return (32 - dataLength) % 8; }
    }

    public BitWriter(Stream stream)
    {
        this.stream = stream;
    }

    public void WriteBit(bool value)
    {
        Write(value ? 1 : 0, 1);
    }

    public void Write(int value, int length)
    {
        uint currentData = data | checked((uint)value << dataLength);
        int currentLength = dataLength + length;
        while (currentLength >= 8)
        {
            BaseStream.WriteByte((byte)currentData);
            currentData >>= 8;
            currentLength -= 8;
        }
        data = currentData;
        dataLength = currentLength;
    }

    public void Align()
    {
        if (dataLength > 0)
        {
            BaseStream.WriteByte((byte)data);

            data = 0;
            dataLength = 0;
        }
    }
}

class Program
{
    static void Main(string[] args)
    {
        MemoryStream ms = new MemoryStream();
        BitWriter writer = new BitWriter(ms);
        writer.WriteBit(true);
        writer.Write(5, 3);
        writer.Write(0x0155, 11);
        writer.Align();

        ms.Position = 0;
        BitReader reader = new BitReader(ms);
        Console.WriteLine(reader.ReadBit());
        Console.WriteLine(reader.Read(3));
        Console.WriteLine(reader.Read(11).ToString("x4"));
        reader.Align();
    }
}


img:=PPM.readPPMFile("fractal.ppm");
p:=System.popen(0'|convert ppm:- jpg:"fractal.jpg"|,"w");
img.write(p); p.close();


main =>
    Digits = to_array("123456789"),
    Size = 4,
    random_sample(Size,Size,[],ChosenIndecies),
    Chosen = {Digits[I] : I in ChosenIndecies},
    printf("I have chosen a number from %d unique digits from 1 to 9 arranged in a random order.\n", Size),
    printf("You need to input a %d digit, unique digit number as a guess at what I have chosen.\n", Size),
    guess(Chosen,Size,1).

guess(Chosen,Size,NGuess) =>
    Input = read_line(),
    Guess = Input.to_array(),
    if len(Guess) != Size || len(sort_remove_dups(Input)) != Size || (member(D, Input), (D @< '1' || D @> '9'))  then
        printf("Problem, try again. You need to enter %d unique digits from 1 to 9\n", Size),
        guess(Chosen,Size,NGuess)
    elseif Guess == Chosen then
        printf("\nCongratulations you guessed correctly in %d attempts\n", NGuess)
    else
        Bulls = sum([cond(Chosen[I] == Guess[I], 1, 0) : I in 1..Size]),
        Cows = sum([cond(member(Chosen[I], Input), 1, 0) : I in 1..Size]),
        printf("%d Bulls\n%d Cows\n", Bulls, Cows),
        guess(Chosen, Size, NGuess+1)
    end.

random_sample(_N,0,Chosen0,Chosen) => Chosen = Chosen0.
random_sample(N,I,Chosen0,Chosen) =>
    R = random() mod N + 1,
    (not member(R, Chosen0) ->
        random_sample(N,I-1,[R|Chosen0],Chosen)
    ;
        random_sample(N,I,Chosen0,Chosen)
    ).


(de ok? (N)
   (let D (mapcar 'format (chop N))
      (and (num? N)
           (not (member 0 D))
           (= 4 (length D))
           (= D (uniq D))
           D )) )

(de init-cows ()
   (until (setq *Hidden (ok? (rand 1234 9876)))) )

(de guess (N)
   (let D (ok? N)
      (if D
         (let Bulls (cnt '= D *Hidden)
            (if (= 4 Bulls)
               " You guessed it!"
               (let Cows (- (cnt '((N) (member N *Hidden)) D) Bulls)
                  (pack Bulls " bulls, " Cows " cows") ) ) )
         " Bad guess! (4 unique digits, 1-9)" ) ) )


(defpackage :rosetta.bitwise-i/o
  (:use :common-lisp)
  (:export :bitwise-i/o-demo))
(in-package :rosetta.bitwise-i/o)

(defun byte->bit-vector (byte byte-bits)
  "Convert one BYTE into a bit-vector of BYTE-BITS length."
  (let ((vector (make-array byte-bits :element-type 'bit))
        (bit-value 1))
    (declare (optimize (speed 3)))
    (dotimes (bit-index byte-bits vector)
      (setf (aref vector bit-index)
            (if (plusp (logand byte (the (unsigned-byte 8) bit-value)))
                1 0))
      (setq bit-value (ash bit-value 1)))))

(defun bytes->bit-vector (byte-vector byte-bits)
  "Convert a BYTE-VECTOR into a bit-vector, with each byte taking BYTE-BITS.

For  optimization's sake,  I  limit the  size of  the  vector to  (FLOOR
MOST-POSITIVE-FIXNUM  BYTE-BITS), which  is somewhat  ridiculously long,
but allows the compiler to trust that indices will fit in a FIXNUM."
  (reduce (lambda (a b) (concatenate 'bit-vector a b))
          (map 'list (lambda (byte) (byte->bit-vector byte byte-bits)) byte-vector)))

(defun ascii-char-p (char)
  "True if CHAR is an ASCII character"
  (< (char-code char) #x80))

(defun assert-ascii-string (string)
  "`ASSERT' that STRING is an ASCII string."
  (assert (every #'ascii-char-p string)
          (string)
          "STRING must contain only ASCII (7-bit) characters;~%“~a”
…contains non-ASCII character~p~:*: ~{~% • ~c ~:*— [email protected] ~}"
          string (coerce (remove-duplicates (remove-if #'ascii-char-p string)
                                            :test #'char=)
                         'list)))

(defun ascii-string->bit-vector (string)
  "Convert a STRING consisting only  of characters in the ASCII \(7-bit)
range into a bit-vector of 7 bits per character.

This assumes \(as is now, in  2017, I believe universally the case) that
the local character code system \(as for `CHAR-CODE' and `CODE-CHAR') is
Unicode, or at least, a superset of ASCII \(eg: ISO-8859-*)
"
  (check-type string simple-string)
  (assert-ascii-string string)
  (bytes->bit-vector (map 'vector #'char-code string) 7))

(defun pad-bit-vector-to-8 (vector)
  "Ensure that VECTOR is a multiple of 8 bits in length."
  (adjust-array vector (* 8 (ceiling (length vector) 8))))

(defun bit-vector->byte (vector)
  "Convert VECTOR into a single byte."
  (declare (optimize (speed 3)))
  (check-type vector bit-vector)
  (assert (<= (length vector) 8))
  (reduce (lambda (x y)
            (logior (the (unsigned-byte 8)
                         (ash (the (unsigned-byte 8) x) 1))
                    (the bit y)))
          (reverse vector) :initial-value 0))

(defun bit-vector->bytes (vector byte-size &key (truncatep nil))
  "Convert a bit vector VECTOR into a vector of bytes of BYTE-SIZE bits each.

If TRUNCATEP, then discard any trailing bits."
  (let* ((out-length (funcall (if truncatep 'floor 'ceiling)
                              (length vector)
                              byte-size))
         (output (make-array out-length
                             :element-type (list 'unsigned-byte byte-size))))
    (loop for byte from 0 below out-length
          for start-bit = 0 then end-bit
          for end-bit = byte-size then (min (+ byte-size end-bit)
                                            (length vector))
          do (setf (aref output byte)
                   (bit-vector->byte (subseq vector start-bit end-bit))))
    output))

(defun ascii-pack-to-8-bit (string)
  "Pack an ASCII STRING into 8-bit bytes (7→8 bit packing)"
  (bit-vector->bytes (ascii-string->bit-vector string)
                     8))

(defun unpack-ascii-from-8-bits (byte-vector)
  "Convert an 8-bit BYTE-VECTOR into an array of (unpacked) 7-bit bytes."
  (map 'string #'code-char
       (bit-vector->bytes
        (pad-bit-vector-to-8 (bytes->bit-vector byte-vector 8))
        7
        :truncatep t)))

(defun write-7->8-bit-string-to-file (string pathname)
  "Given a string of 7-bit character STRING, create a new file at PATHNAME
with the contents of that string packed into 8-bit bytes."
  (format *trace-output* "~&Writing string to ~a in packed 7→8 bits…~%“~a”"
          pathname string)
  (assert-ascii-string string)
  (with-open-file (output pathname
                          :direction :output
                          :if-exists :supersede
                          :element-type '(unsigned-byte 8))
    (write-sequence (ascii-pack-to-8-bit string) output)
    (finish-output output)
    (let ((expected-length (ceiling (* (length string) 7) 8)))
      (assert (= (file-length output) expected-length) ()
              "The file written was ~:d byte~:p in length, ~
but the string supplied should have written ~:d byte~:p."
              (file-length output) expected-length))))

(defun read-file-into-byte-array (pathname)
  "Read a binary file into a byte array"
  (with-open-file (input pathname
                         :direction :input
                         :if-does-not-exist :error
                         :element-type '(unsigned-byte 8))
    (let ((buffer (make-array (file-length input)
                              :element-type '(unsigned-byte 8))))
      (read-sequence buffer input)
      buffer)))

(defun read-8->7-bit-string-from-file (pathname)
  "Read   8-bit   packed  data   from   PATHNAME   and  return   it   as
a 7-bit string."
  (unpack-ascii-from-8-bits (read-file-into-byte-array pathname)))

(defun bitwise-i/o-demo (&key (string "Hello, World.")
                              (pathname #p"/tmp/demo.bin"))
  "Writes STRING  to PATHNAME after  7→8 bit  packing, then reads  it back
to validate."
  (write-7->8-bit-string-to-file string pathname)
  (let ((read-back (read-8->7-bit-string-from-file pathname)))
    (assert (equal string read-back) ()
            "Reading back string got:~%“~a”~%…expected:~%“~a”" read-back string)
    (format *trace-output* "~&String read back matches:~%“~a”" read-back))
  (finish-output *trace-output*))


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


#ESCAPECHARS ON

DIM bmpin = ".\\LenaClr.bmp", ppmout = ".\\Lena.ppm", bmpblob = 54 ' Size of BMP file headers
FILEGET(FILEOPEN(bmpin, BINARY), FILELEN(bmpin)): FILECLOSE(FILEOPEN) ' Fill buffer

DIM ppmheader AS STRING * 256, breadth, height
LET(breadth, height) = 128 ' Image width and height
SPRINTF(ppmheader, "P6\n%d %d\n255\n", breadth, height) ' Create PPM file header

DIM ppmdata AS STRING * (STRLEN(ppmheader) + FILELEN - bmpblob)
DIM head = @ppmdata + STRLEN, tail = @FILEGET + FILELEN - breadth * 3 - 2 ' Start of last scanline
ppmdata = ppmheader ' Copy PPM file header

WHILE tail >= @FILEGET + bmpblob ' Flip upside down
	FOR DIM w = 0 TO (breadth - 1) * 3 STEP 3
		POKE(head + 0 + w, CHR(PEEK(tail + 2 + w, 1))) ' Swap R
		POKE(head + 1 + w, CHR(PEEK(tail + 1 + w, 1))) ' Keep G
		POKE(head + 2 + w, CHR(PEEK(tail + 0 + w, 1))) ' Swap B
	NEXT
	INCR(head, breadth * 3): DECR(tail, breadth * 3) ' Next scanline
WEND

FILEPUT(FILEOPEN(ppmout, BINARY_NEW), ppmdata): FILECLOSE(FILEOPEN)


[int]$guesses = $bulls = $cows = 0
[string]$guess = "none"
[string]$digits = ""

while ($digits.Length -lt 4)
{
    $character = [char](49..57 | Get-Random)

    if ($digits.IndexOf($character) -eq -1) {$digits += $character}
}

Write-Host "`nGuess four digits (1-9) using no digit twice.`n" -ForegroundColor Cyan

while ($bulls -lt 4)
{
    do
    {
        $prompt = "Guesses={0:0#}, Last='{1,4}', Bulls={2}, Cows={3}; Enter your guess" -f $guesses, $guess, $bulls, $cows
        $guess = Read-Host $prompt

        if ($guess.Length -ne 4)                     {Write-Host "`nMust be a four-digit number`n" -ForegroundColor Red}
        if ($guess -notmatch "[1-9][1-9][1-9][1-9]") {Write-Host "`nMust be numbers 1-9`n"         -ForegroundColor Red}
    }
    until ($guess.Length -eq 4)

    $guesses += 1
    $bulls = $cows = 0

    for ($i = 0; $i -lt 4; $i++)
    {
        $character = $digits.Substring($i,1)

        if ($guess.Substring($i,1) -eq $character)
        {
            $bulls += 1
        }
        else
        {
            if ($guess.IndexOf($character) -ge 0)
            {
                $cows += 1
            }
        }
    }
}

Write-Host "`nYou won after $($guesses - 1) guesses." -ForegroundColor Cyan


import std.stdio: File;
import core.stdc.stdio: FILE, fputc, fgetc;
import std.string: representation;

/***********
Bitwise I/O, the file must be in binary mode, and its FILE*
must be kept open during the usage of BitwiseFile.
*/
struct BitwiseFile {
    FILE* fp;
    uint accu;
    int bits;

    this(File f)
    in {
        assert(f.isOpen);
        //assert(f.isBinary);
    } body {
        this.fp = f.getFP();
    }

    void write(const(ubyte)[] buf, size_t nBits, size_t shift)
    nothrow {
        auto accu = this.accu;
        auto bits = this.bits;
        auto bufPtr = buf.ptr;

        bufPtr += shift / 8;
        shift %= 8;

        while (nBits || bits >= 8) {
            while (bits >= 8) {
                bits -= 8;
                fputc(accu >> bits, this.fp);
                accu &= (1 << bits) - 1;
            }
            while (bits < 8 && nBits) {
                accu = (accu << 1) |
                       (((128 >> shift) & *bufPtr) >> (7 - shift));
                nBits--;
                bits++;
                shift++;
                if (shift == 8) {
                    shift = 0;
                    bufPtr++;
                }
            }
        }

        this.accu = accu;
        this.bits = bits;
    }

    size_t read(ubyte[] buf, size_t nBits, size_t shift) nothrow {
        auto accu = this.accu;
        auto bits = this.bits;
        auto bufPtr = buf.ptr;
        int i = 0;

        bufPtr += shift / 8;
        shift %= 8;

        while (nBits) {
            while (bits && nBits) {
                immutable mask = 128u >> shift;
                if (accu & (1 << (bits - 1)))
                    *bufPtr |= mask;
                else
                    *bufPtr &= ~mask;

                nBits--;
                bits--;
                shift++;

                if (shift >= 8) {
                    shift = 0;
                    bufPtr++;
                }
            }
            if (!nBits)
                break;
            accu = (accu << 8) | fgetc(this.fp);
            bits += 8;
        }

        this.accu = accu;
        this.bits = bits;
        return i;
    }

    void detach() nothrow {
        if (this.bits) {
            this.accu <<= 8 - this.bits;
            fputc(this.accu, this.fp);
        }
        this.fp = null;
        this.accu = 0;
        this.bits = 0;
    }

    nothrow ~this() {
        detach;
    }
}

void main() { // Demo code.
    import core.stdc.stdio: fopen, fclose;
    import std.string: assumeUTF;
    import std.stdio: writeln;

    immutable data = "abcdefghijk".representation;
    enum n = data.length;

    // For each ubyte in data, write 7 bits skipping 1.
    auto fout = File("bitwise_io_test.bin", "wb");
    auto bf1 = BitwiseFile(fout);
    foreach (immutable i; 0 .. n)
        bf1.write(data[i .. $], 7, 1);
    bf1.detach();
    fout.close();

    // Read 7 bits and expand to each ubyte of result skipping 1 bit.
    ubyte[n + 1] result = '\0';
    auto fin = File("bitwise_io_test.bin", "rb");
    auto bf2 = BitwiseFile(fin);
    foreach (immutable i; 0 .. n)
        bf2.read(result[i .. $], 7, 1);
    bf2.detach();
    fin.close();

    // Should be the same chars as 'data'.
    result.assumeUTF.writeln;
}


: write-ppm { bmp fid -- }
  s" P6"             fid write-line throw
  bmp bdim swap
  0 <# bl hold #s #> fid write-file throw
  0 <#         #s #> fid write-line throw
  s" 255"            fid write-line throw
  bmp bdata  bmp bdim * pixels
  bounds do
    i 3              fid write-file throw
  pixel +loop ;

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


program main

  use rgbimage_m

  implicit none

  integer :: nx, ny, i, j, k

  type(rgbimage) :: im

  ! init image of height nx, width ny
  nx = 400
  ny = 300
  call im%init(nx, ny)

  ! set some random pixel data
  do i = 1, nx
    do j = 1, ny
      call im%set_pixel(i, j, [(nint(rand()*255), k=1,3)])
    end do
  end do

  ! output image into file
  call im%write('fig.ppm')

end program


# Dirty implementation
# Only P3 format, an image is a list of 3 matrices (r, g, b)
# Max color is always 255
WriteImage := function(name, img)
  local f, r, g, b, i, j, maxcolor, nrow, ncol, dim;
  f := OutputTextFile(name, false);
  r := img[1];
  g := img[2];
  b := img[3];
  dim := DimensionsMat(r);
  nrow := dim[1];
  ncol := dim[2];
  maxcolor := 255;
  WriteLine(f, "P3");
  WriteLine(f, Concatenation(String(ncol), " ", String(nrow), " ", String(maxcolor)));
  for i in [1 .. nrow] do
    for j in [1 .. ncol] do
      WriteLine(f, Concatenation(String(r[i][j]), " ", String(g[i][j]), " ", String(b[i][j])));
    od;
  od;
  CloseStream(f);
end;

PutPixel := function(img, i, j, color)
  img[1][i][j] := color[1];
  img[2][i][j] := color[2];
  img[3][i][j] := color[3];
end;

GetPixel := function(img, i, j)
  return [img[1][i][j], img[2][i][j], img[3][i][j]];
end;

NewImage := function(nrow, ncol, color)
  local r, g, b;
  r := color[1] + NullMat(nrow, ncol);
  g := color[2] + NullMat(nrow, ncol);
  b := color[3] + NullMat(nrow, ncol);
  return [r, g, b];
end;

# Reproducing the example from Wikipedia
black := [ 0, 0, 0 ];
g := NewImage(2, 3, black);
PutPixel(g, 1, 1, [255, 0, 0]);
PutPixel(g, 1, 2, [0, 255, 0]);
PutPixel(g, 1, 3, [0, 0, 255]);
PutPixel(g, 2, 1, [255, 255, 0]);
PutPixel(g, 2, 2, [255, 255, 255]);
PutPixel(g, 2, 3, [0, 0, 0]);
WriteImage("example.ppm", g);


IntDict score;
StringList choices;
StringList guess;
StringList secret;
int gamesWon = -1;

void setup() {
  choices = new StringList("0", "1", "2", "3", "4", "5", "6", "7", "8", "9");
  newGame();
}

void newGame() {
  gamesWon++;
  choices.shuffle();
  secret = new StringList();
  for (int i=0; i<4; i++) { // selections
    secret.append(choices.get(i));
  }
  newGuess();
  println("\nsecret:", secret, "\n");
}

void newGuess() {
  guess = new StringList();
  score = null;
}

void draw() {
  background(0);
  text("Bulls & Cows " + gamesWon, 5, 20);
  for (int i=0; i<guess.size(); i++) {
    text(guess.get(i), 20*i+10, height/2);
  }
  if (score!=null) {
    text("bulls:" + score.get("bulls") + " cows:" + score.get("cows"), 10, height-20);
  }
}

void keyReleased() {
  if (score!=null && score.get("bulls")==4) newGame();
  if (guess.size()==secret.size()) newGuess();
  if (guess.hasValue(str(key))) newGuess();
  if (key>=48 && key<=57) guess.append(str(key));
  if (guess.size()==secret.size()) {
    score = checkScore(secret, guess);
    println("guess: ", guess, "\n", score, "wins:", gamesWon);
  }
}

IntDict checkScore(StringList secret, StringList guess) {
  IntDict result = new IntDict();
  result.set("bulls", 0);
  result.set("cows", 0);
  for (int i=0; i<guess.size(); i++) {
    if (guess.get(i).equals(secret.get(i))) {
      result.add("bulls", 1);
    } else if (secret.hasValue(guess.get(i))) {
      result.add("cows", 1);
    }
  }
  return result;
}


:- use_module(library(lambda)).
:- use_module(library(clpfd)).

% Parameters of the server

% length of the guess
proposition(4).

% Numbers of digits
% 0 -> 8
digits(8).

bulls_and_cows_server :-
	proposition(LenGuess),
	length(Solution, LenGuess),
	choose(Solution),
	repeat,
	write('Your guess : '),
	read(Guess),
	(   study(Solution, Guess, Bulls, Cows)
	->  format('Bulls : ~w Cows : ~w~n', [Bulls, Cows]),
	    Bulls = LenGuess
	;   digits(Digits), Max is Digits + 1,
	    format('Guess must be of ~w digits between 1 and ~w~n',
		   [LenGuess, Max]),
	    fail).

choose(Solution) :-
	digits(Digits),
	Max is Digits + 1,
	repeat,
	maplist(\X^(X is random(Max) + 1), Solution),
	all_distinct(Solution),
	!.

study(Solution, Guess, Bulls, Cows) :-
	proposition(LenGuess),
	digits(Digits),

	% compute the transformation 1234 => [1,2,3,4]
	atom_chars(Guess, Chars),
	maplist(\X^Y^(atom_number(X, Y)), Chars, Ms),

	% check that the guess is well formed
	length(Ms, LenGuess),
	maplist(\X^(X > 0, X =< Digits+1), Ms),

	% compute the digit in good place
	foldl(\X^Y^V0^V1^((X = Y->V1 is V0+1; V1 = V0)),Solution, Ms, 0, Bulls),

	% compute the digits in bad place
	foldl(\Y1^V2^V3^(foldl(\X2^Z2^Z3^(X2 = Y1 -> Z3 is Z2+1; Z3 = Z2), Ms, 0, TT1),
			 V3 is V2+ TT1),
	      Solution, 0, TT),
	Cows is TT - Bulls.


program Bitwise_IO;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Classes;

type
  TBitReader = class
  private
    readData: Cardinal;
    startPosition: Integer;
    endPosition: Integer;
    Stream: TStream;
    procedure Align;
    function BaseStream: TStream;
    procedure EnsureData(bitCount: Integer);
    function GetInBuffer: Integer;
  public
    constructor Create(sm: TStream);
    function Read(bitCount: Integer): Integer;
    function ReadBit: Boolean;
  end;

  TBitWriter = class
  private
    data: Byte;
    dataLength: Integer;
    Stream: TStream;
    procedure Align;
    function BaseStream: TStream;
    function BitsToAligment: Integer;
  public
    constructor Create(sm: TStream);
    procedure Write(value, length: Integer);
    procedure WriteBit(value: Boolean);
  end;

function TBitReader.GetInBuffer: Integer;
begin
  result := endPosition - startPosition;
end;

function TBitReader.BaseStream: TStream;
begin
  result := stream;
end;

constructor TBitReader.Create(sm: TStream);
begin
  Stream := sm;
end;

procedure TBitReader.EnsureData(bitCount: Integer);
var
  readBits: Integer;
  b: Byte;
begin
  readBits := bitCount - GetInBuffer;
  while readBits > 0 do
  begin
    BaseStream.Read(b, 1);
    readData := readData or (b shl endPosition);
    endPosition := endPosition + 8;
    readBits := readBits - 8;
  end;
end;

function TBitReader.ReadBit: Boolean;
begin
  Exit(Read(1) > 0);
end;

function TBitReader.Read(bitCount: Integer): Integer;
begin
  EnsureData(bitCount);
  result := (readData shr startPosition) and ((1 shl bitCount) - 1);
  startPosition := startPosition + bitCount;
  if endPosition = startPosition then
  begin
    endPosition := ord(startPosition = 0);
    readData := 0;
  end
  else if (startPosition >= 8) then
  begin
    readData := readData shr startPosition;
    endPosition := endPosition - startPosition;
    startPosition := 0;
  end;
end;

procedure TBitReader.Align;
begin
  endPosition := ord(startPosition = 0);
  readData := 0;
end;

function TBitWriter.BaseStream: TStream;
begin
  Exit(stream);
end;

function TBitWriter.BitsToAligment: Integer;
begin
  Exit((32 - dataLength) mod 8);
end;

constructor TBitWriter.Create(sm: TStream);
begin
  Stream := sm;
end;

procedure TBitWriter.WriteBit(value: Boolean);
begin
  self.Write(ord(value), 1);
end;

procedure TBitWriter.Write(value, length: Integer);
var
  currentData: Cardinal;
  currentLength: Integer;
begin
  currentData := data or (value shl dataLength);
  currentLength := dataLength + length;
  while currentLength >= 8 do
  begin

    BaseStream.Write(currentData, 1);
    currentData := currentData shr 8;
    currentLength := currentLength - 8;
  end;
  data := currentData;
  dataLength := currentLength;
end;

procedure TBitWriter.Align;
begin
  if dataLength > 0 then
  begin
    BaseStream.Write(data, 1);
    data := 0;
    dataLength := 0;
  end;
end;

var
  ms: TMemoryStream;
  writer: TBitWriter;
  reader: TBitReader;

begin
  ms := TMemoryStream.create();
  writer := TBitWriter.create(ms);
  writer.WriteBit(true);
  writer.Write(5, 3);
  writer.Write($0155, 11);
  writer.Align();
  ms.Position := 0;
  reader := TBitReader.create(ms);
  writeln(reader.ReadBit());
  writeln(reader.Read(3));
  writeln(format('0x%.4x', [reader.Read(11)]));
  reader.Align();
  ms.Free;
  writer.Free;
  reader.Free;
  Readln;
end.


package raster

import (
    "fmt"
    "io"
    "os"
)

// WriteTo outputs 8-bit P6 PPM format to an io.Writer.
func (b *Bitmap) WritePpmTo(w io.Writer) (err error) {
    // magic number
    if _, err = fmt.Fprintln(w, "P6"); err != nil {
        return
    }

    // comments
    for _, c := range b.Comments {
        if _, err = fmt.Fprintln(w, c); err != nil {
            return
        }
    }

    // x, y, depth
    _, err = fmt.Fprintf(w, "%d %d\n255\n", b.cols, b.rows)
    if err != nil {
        return
    }

    // raster data in a single write
    b3 := make([]byte, 3*len(b.px))
    n1 := 0
    for _, px := range b.px {
        b3[n1] = px.R
        b3[n1+1] = px.G
        b3[n1+2] = px.B
        n1 += 3
    }
    if _, err = w.Write(b3); err != nil {
        return
    }
    return
}

// WriteFile writes to the specified filename.
func (b *Bitmap) WritePpmFile(fn string) (err error) {
    var f *os.File
    if f, err = os.Create(fn); err != nil {
        return
    }
    if err = b.WritePpmTo(f); err != nil {
        return
    }
    return f.Close()
}


{-# LANGUAGE ScopedTypeVariables #-}

module Bitmap.Netpbm(readNetpbm, writeNetpbm) where

import Bitmap
import Data.Char
import System.IO
import Control.Monad
import Control.Monad.ST
import Data.Array.ST

nil :: a
nil = undefined

readNetpbm :: forall c. Color c => FilePath -> IO (Image RealWorld c)
readNetpbm path = do
    let die = fail "readNetpbm: bad format"
    ppm <- readFile path
    let (s, rest) = splitAt 2 ppm
    unless (s == magicNumber) die
    let getNum :: String -> IO (Int, String)
        getNum ppm = do
            let (s, rest) = span isDigit $ skipBlanks ppm
            when (null s) die
            return (read s, rest)
    (width, rest) <- getNum rest
    (height, rest) <- getNum rest
    (_, c : rest) <-
        if getMaxval then getNum rest else return (nil, rest)
    unless (isSpace c) die
    i <- stToIO $ listImage width height $
        fromNetpbm $ map fromEnum rest
    return i
  where skipBlanks =
           dropWhile isSpace .
           until ((/= '#') . head) (tail . dropWhile (/= '\n')) .
           dropWhile isSpace
        magicNumber = netpbmMagicNumber (nil :: c)
        getMaxval = not $ null $ netpbmMaxval (nil :: c)

writeNetpbm :: forall c. Color c => FilePath -> Image RealWorld c -> IO ()
writeNetpbm path i = withFile path WriteMode $ \h -> do
    (width, height) <- stToIO $ dimensions i
    let w = hPutStrLn h
    w $ magicNumber
    w $ show width ++ " " ++ show height
    unless (null maxval) (w maxval)
    stToIO (getPixels i) >>= hPutStr h . toNetpbm
  where magicNumber = netpbmMagicNumber (nil :: c)
        maxval = netpbmMaxval (nil :: c)


Define.s secret, guess, c
Define.i bulls, cows, guesses, i

If OpenConsole()

  While Len(secret) < 4
    c = Chr(Random(8) + 49)
    If FindString(secret, c, 1) = 0
      secret + c
    EndIf
  Wend

  Repeat
    Print("Guess a 4-digit number with no duplicate digits: ")
    guess = Input()
    If Len(guess) = 0
      Break   ;break from loop
    EndIf

    isMalformedGuess = #False
    If Len(guess) <> 4
      ;guess is too short
      isMalformedGuess = #True
    Else
      For i = 1 To 4
        c = Mid(guess, i, 1)
        If Not FindString("123456789", c, 1) Or CountString(guess, c) <> 1
          ;guess contains either non-digits or duplicate digits
          isMalformedGuess = #True
          Break ;break from For/Next loop
        EndIf
      Next
    EndIf

    If isMalformedGuess
      PrintN("** You should enter 4 different numeric digits that are each from 1 to 9!")
      Continue ;continue loop
    EndIf

    bulls = 0: cows = 0: guesses = guesses + 1
    For i = 1 To 4
      c = Mid(secret, i, 1)
      If Mid(guess, i, 1) = c
        bulls + 1
      ElseIf FindString(guess, c, 1)
        cows + 1
      EndIf
    Next

    Print( Str(bulls) + " bull")
    If bulls <> 1
      Print( "s")
    EndIf
    Print( ", " + Str(cows) + " cow")
    If cows <> 1
      PrintN( "s")
    Else
      PrintN("")
    EndIf

    If guess = secret
      PrintN("You won after " + Str(guesses) + " guesses!")
      Break    ;break from loop
    EndIf
  ForEver

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
  Input()
  CloseConsole()
EndIf


-module(bitwise_io).
-compile([export_all]).

%% Erlang allows for easy manipulation of bitstrings. Here I'll
%% present a function that can take a message of 8-bit ASCII
%% characters and remove the MSB, leaving the same message in 7-bits.

compress(Message) ->
    << <<X:7>> || <<X:8>> <= Message >>.

%% Here we decompress the message.

decompress(Message) ->
    << <<X:8>> || <<X:7>> <= Message >>.

%% Now a test to demonstrate that this conversion works:

test_bitstring_conversion() ->
    Message = <<"Hello, Rosetta Code!">>,
    io:format("~p: ~B~n",[Message, bit_size(Message)]),
    Compressed = compress(Message),
    io:format("~p: ~B~n",[Compressed, bit_size(Compressed)]),
    Decompressed = decompress(Compressed),
    io:format("~p: ~B~n",[Decompressed, bit_size(Decompressed)]),
    io:format("~p = ~p ? ~p~n",[Message, Decompressed,
                                Message =:= Decompressed]).

%% Now to show this on file output, we'll write the compressed version
%% to a file. Now, erlang's file:write_file expects objects that are
%% multiples of 8bits. We'll add padding to allow the writing to
%% complete, and then discard the padding when reading the file back
%% in.

test_file_io() ->
    Message = <<"Hello, Rosetta Code!">>,
    FileName = "bitwise_io.dat",
    Compressed = compress(Message),
    PaddingSize = (8 - (bit_size(Compressed) rem 8)) rem 8,
    PaddedCompressed = <<Compressed:(bit_size(Compressed))/bitstring,
                         0:PaddingSize>>,
    file:write_file(FileName,PaddedCompressed),
    {ok, ReadIn} = file:read_file(FileName),
    UnpaddedSize = bit_size(ReadIn) - 7,
    Unpadded =
        case UnpaddedSize rem 7 =:= 0 of
            true ->
                <<T:(UnpaddedSize)/bitstring,_:7>> = ReadIn,
                T;
            false ->
                << <<X:7>> || <<X:7>> <= ReadIn >>
        end,
    Decompressed = decompress(Unpadded),
    io:format("~p~n",[Decompressed]).


require 'files'

NB. ($x) is height, width, colors per pixel
writeppm=:dyad define
  header=. 'P6',LF,(":1 0{$x),LF,'255',LF
  (header,,x{a.) fwrite y
)


import java.io.BufferedOutputStream;
import java.io.File;
import java.io.FileOutputStream;
import java.io.IOException;
import java.nio.charset.StandardCharsets;

public class PPMWriter {

    public void bitmapToPPM(File file, BasicBitmapStorage bitmap) throws IOException {
        file.delete();

        try (var os = new FileOutputStream(file, true);
             var bw = new BufferedOutputStream(os)) {
            var header = String.format("P6\n%d %d\n255\n",
                    bitmap.getWidth(), bitmap.getHeight());

            bw.write(header.getBytes(StandardCharsets.US_ASCII));

            for (var y = 0; y < bitmap.getHeight(); y++) {
                for (var x = 0; x < bitmap.getWidth(); x++) {
                    var pixel = bitmap.getPixel(x, y);
                    bw.write(pixel.getRed());
                    bw.write(pixel.getGreen());
                    bw.write(pixel.getBlue());
                }
            }
        }
    }
}


'''
 Bulls and cows. A game pre-dating, and similar to, Mastermind.
'''

import random

digits = '123456789'
size = 4
chosen = ''.join(random.sample(digits,size))
#print chosen # Debug
print '''I have chosen a number from %s unique digits from 1 to 9 arranged in a random order.
You need to input a %i digit, unique digit number as a guess at what I have chosen''' % (size, size)
guesses = 0
while True:
    guesses += 1
    while True:
        # get a good guess
        guess = raw_input('\nNext guess [%i]: ' % guesses).strip()
        if len(guess) == size and \
           all(char in digits for char in guess) \
           and len(set(guess)) == size:
            break
        print "Problem, try again. You need to enter %i unique digits from 1 to 9" % size
    if guess == chosen:
        print '\nCongratulations you guessed correctly in',guesses,'attempts'
        break
    bulls = cows = 0
    for i in range(size):
        if guess[i] == chosen[i]:
            bulls += 1
        elif guess[i] in chosen:
            cows += 1
    print '  %i Bulls\n  %i Cows' % (bulls, cows)


target <- sample(1:9,4)
bulls <- 0
cows <- 0
attempts <- 0
while (bulls != 4)
  {
  input <- readline("Guess a 4-digit number with no duplicate digits or 0s: ")
  if (nchar(input) == 4)
    {
    input <- as.integer(strsplit(input,"")[[1]])
    if ((sum(is.na(input)+sum(input==0))>=1) | (length(table(input)) != 4)) {print("Malformed input!")} else {
      bulls <- sum(input == target)
      cows <- sum(input %in% target)-bulls
      cat("\n",bulls," Bull(s) and ",cows, " Cow(s)\n")
      attempts <- attempts + 1
      }
    } else {print("Malformed input!")}
  }
print(paste("You won in",attempts,"attempt(s)!"))


\ writing

: init-write ( -- b m ) 0 128 ;

: flush-bits ( b m -- 0 128 ) drop emit init-write ;

: ?flush-bits ( b m -- b' m' ) dup 128 < if flush-bits then ;

: write-bit ( b m f -- b' m' )
  if tuck or swap then
  2/ dup 0= if flush-bits then ;

\ reading

: init-read ( -- b m ) key 128 ;

: eof? ( b m -- b m f ) dup if false else key? 0= then ;

: read-bit ( b m -- b' m' f )
  dup 0= if 2drop init-read then
  2dup and swap 2/ swap ;


// Package bit provides bit-wise IO to an io.Writer and from an io.Reader.
package bit

import (
    "bufio"
    "errors"
    "io"
)

// Order specifies the bit ordering within a byte stream.
type Order int

const (
    // LSB is for Least Significant Bits first
    LSB Order = iota
    // MSB is for Most  Significant Bits first
    MSB
)

// ==== Writing / Encoding ====

type writer interface {
    io.ByteWriter
    Flush() error
}

// Writer implements bit-wise writing to an io.Writer.
type Writer struct {
    w     writer
    order Order
    write func(uint32, uint) error // writeLSB or writeMSB
    bits  uint32
    nBits uint
    err   error
}

// writeLSB writes `width` bits of `c` in LSB order.
func (w *Writer) writeLSB(c uint32, width uint) error {
    w.bits |= c << w.nBits
    w.nBits += width
    for w.nBits >= 8 {
        if err := w.w.WriteByte(uint8(w.bits)); err != nil {
            return err
        }
        w.bits >>= 8
        w.nBits -= 8
    }
    return nil
}

// writeMSB writes `width` bits of `c` in MSB order.
func (w *Writer) writeMSB(c uint32, width uint) error {
    w.bits |= c << (32 - width - w.nBits)
    w.nBits += width
    for w.nBits >= 8 {
        if err := w.w.WriteByte(uint8(w.bits >> 24)); err != nil {
            return err
        }
        w.bits <<= 8
        w.nBits -= 8
    }
    return nil
}

// WriteBits writes up to 16 bits of `c` to the underlying writer.
// Even for MSB ordering the bits are taken from the lower bits of `c`.
// (e.g. WriteBits(0x0f,4) writes four 1 bits).
func (w *Writer) WriteBits(c uint16, width uint) error {
    if w.err == nil {
        w.err = w.write(uint32(c), width)
    }
    return w.err
}

var errClosed = errors.New("bit reader/writer is closed")

// Close closes the writer, flushing any pending output.
// It does not close the underlying writer.
func (w *Writer) Close() error {
    if w.err != nil {
        if w.err == errClosed {
            return nil
        }
        return w.err
    }
    // Write the final bits (zero padded).
    if w.nBits > 0 {
        if w.order == MSB {
            w.bits >>= 24
        }
        if w.err = w.w.WriteByte(uint8(w.bits)); w.err != nil {
            return w.err
        }
    }
    w.err = w.w.Flush()
    if w.err != nil {
        return w.err
    }

    // Make any future calls to Write return errClosed.
    w.err = errClosed
    return nil
}

// NewWriter returns a new bit Writer that writes completed bytes to `w`.
func NewWriter(w io.Writer, order Order) *Writer {
    bw := &Writer{order: order}
    switch order {
    case LSB:
        bw.write = bw.writeLSB
    case MSB:
        bw.write = bw.writeMSB
    default:
        bw.err = errors.New("bit writer: unknown order")
        return bw
    }
    if byteWriter, ok := w.(writer); ok {
        bw.w = byteWriter
    } else {
        bw.w = bufio.NewWriter(w)
    }
    return bw
}

// ==== Reading / Decoding ====

// Reader implements bit-wise reading from an io.Reader.
type Reader struct {
    r     io.ByteReader
    bits  uint32
    nBits uint
    read  func(width uint) (uint16, error) // readLSB or readMSB
    err   error
}

func (r *Reader) readLSB(width uint) (uint16, error) {
    for r.nBits < width {
        x, err := r.r.ReadByte()
        if err != nil {
            return 0, err
        }
        r.bits |= uint32(x) << r.nBits
        r.nBits += 8
    }
    bits := uint16(r.bits & (1<<width - 1))
    r.bits >>= width
    r.nBits -= width
    return bits, nil
}

func (r *Reader) readMSB(width uint) (uint16, error) {
    for r.nBits < width {
        x, err := r.r.ReadByte()
        if err != nil {
            return 0, err
        }
        r.bits |= uint32(x) << (24 - r.nBits)
        r.nBits += 8
    }
    bits := uint16(r.bits >> (32 - width))
    r.bits <<= width
    r.nBits -= width
    return bits, nil
}

// ReadBits reads up to 16 bits from the underlying reader.
func (r *Reader) ReadBits(width uint) (uint16, error) {
    var bits uint16
    if r.err == nil {
        bits, r.err = r.read(width)
    }
    return bits, r.err
}

// Close closes the reader.
// It does not close the underlying reader.
func (r *Reader) Close() error {
    if r.err != nil && r.err != errClosed {
        return r.err
    }
    r.err = errClosed
    return nil
}

// NewReader returns a new bit Reader that reads bytes from `r`.
func NewReader(r io.Reader, order Order) *Reader {
    br := new(Reader)
    switch order {
    case LSB:
        br.read = br.readLSB
    case MSB:
        br.read = br.readMSB
    default:
        br.err = errors.New("bit writer: unknown order")
        return br
    }
    if byteReader, ok := r.(io.ByteReader); ok {
        br.r = byteReader
    } else {
        br.r = bufio.NewReader(r)
    }
    return br
}


using Images, FileIO

h, w = 50, 70
img = zeros(RGB{N0f8}, h, w)
img[10:40, 5:35] = colorant"skyblue"
for i in 26:50, j in (i-25):40
    img[i, j] = colorant"sienna1"
end

save("data/bitmapWrite.ppm", img)
save("data/bitmapWrite.png", img)


// Version 1.2.40

import java.awt.Color
import java.awt.Graphics
import java.awt.image.BufferedImage
import java.io.FileOutputStream

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

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

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

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

fun main(args: Array<String>) {
    // create BasicBitmapStorage object
    val width = 640
    val height = 640
    val bbs = BasicBitmapStorage(width, height)
    for (y in 0 until height) {
        for (x in 0 until width) {
            val c = Color(x % 256, y % 256, (x * y) % 256)
            bbs.setPixel(x, y, c)
        }
    }

    // now write it to a PPM file
    val fos = FileOutputStream("output.ppm")
    val buffer = ByteArray(width * 3)  // write one line at a time
    fos.use {
        val header = "P6\n$width $height\n255\n".toByteArray()
        with (it) {
            write(header)
            for (y in 0 until height) {
                for (x in 0 until width) {
                    val c = bbs.getPixel(x, y)
                    buffer[x * 3] = c.red.toByte()
                    buffer[x * 3 + 1] = c.green.toByte()
                    buffer[x * 3 + 2] = c.blue.toByte()
                }
                write(buffer)
            }
        }
    }
}