dna$ = "CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG" +
       "CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG" +
       "AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT" +
       "GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT" +
       "CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG" +
       "TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA" +
       "TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT" +
       "CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG" +
       "TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC" +
       "GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT"

NewMap basecount.i()

If OpenConsole("")
  For i = 1 To Len(dna$)
    If (i % 50) = 1
      Print(~"\n" + RSet(Str(i - 1), 5) + " : ")
    EndIf
    t$ = Mid(dna$, i, 1)
    basecount(t$) + 1
    Print(t$)
  Next

  PrintN(~"\n\n" + Space(2) + "Base  count")
  PrintN(Space(2) + ~"----  -----")
  ForEach basecount()
    PrintN(RSet(MapKey(basecount()), 5) + " : " + RSet(Str(basecount()), 5))
    sigma + basecount()
  Next
  PrintN(~"\n" + "Total = " + RSet(Str(sigma), 5))
  Input()
EndIf


from collections import Counter

def basecount(dna):
    return sorted(Counter(dna).items())

def seq_split(dna, n=50):
    return [dna[i: i+n] for i in range(0, len(dna), n)]

def seq_pp(dna, n=50):
    for i, part in enumerate(seq_split(dna, n)):
        print(f"{i*n:>5}: {part}")
    print("\n  BASECOUNT:")
    tot = 0
    for base, count in basecount(dna):
        print(f"    {base:>3}: {count}")
        tot += count
    base, count = 'TOT', tot
    print(f"    {base:>3}= {count}")

if __name__ == '__main__':
    print("SEQUENCE:")
    sequence = '''\
CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG\
CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG\
AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT\
GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT\
CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG\
TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA\
TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT\
CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG\
TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC\
GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT'''
    seq_pp(sequence)


  [ over size -
    space swap of
    swap join ]                 is justify     ( $ n --> $ )

  [ 0 swap
    [ dup $ "" != while
      cr over number$
      4 justify echo$
      5 times
        [ dup $ "" = iff
            conclude done
          sp
          10 split swap echo$ ]
       dip [ 50 + ] again ]
      2drop ]                   is prettyprint (   $ -->   )

   [ stack ]                    is adenine     (     --> s )
   [ stack ]                    is cytosine    (     --> s )
   [ stack ]                    is guanine     (     --> s )
   [ stack ]                    is thymine     (     --> s )

   [ table
     adenine cytosine
     guanine thymine ]          is bases       (     --> [ )

  [ 4 times
      [ 0 i^ bases put ]
    witheach
      [ $ "ACGT" find bases
        1 swap tally ]
      4 times
        [ sp
          i^ bases dup echo
          sp share echo cr ]
      0 4 times
        [ i^ bases take + ]
      cr say " total " echo ]   is tallybases  (   [ -->   )

  $ "CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG"
  $ "CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG" join
  $ "AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT" join
  $ "GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT" join
  $ "CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG" join
  $ "TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA" join
  $ "TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT" join
  $ "CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG" join
  $ "TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC" join
  $ "GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT" join

 dup prettyprint cr cr tallybases


#Data
gene1 <- "CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG
CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG
AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT
GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT
CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG
TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA
TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT
CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG
TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC
GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT"

#Analysis:
gene2 <- gsub("\n", "", gene1) #remove \n chars
gene3 <- strsplit(gene2, split = character(0)) #split into list
gene4 <- gene3[[1]] #pull out character vector from list
basecounts <- as.data.frame(table(gene4)) #make table of base counts

#quick helper function to print table results
print_row <- function(df, row){paste0(df$gene[row],": ", df$Freq[row])}

#Print Function for Data with Results:
cat(" Data: \n",
    "  1:",substring(gene2, 1, 50),"\n",
    " 51:",substring(gene2, 51, 100),"\n",
    "101:",substring(gene2, 101, 150),"\n",
    "151:",substring(gene2, 151, 200),"\n",
    "201:",substring(gene2, 201, 250),"\n",
    "251:",substring(gene2, 251, 300),"\n",
    "301:",substring(gene2, 301, 350),"\n",
    "351:",substring(gene2, 351, 400),"\n",
    "401:",substring(gene2, 401, 450),"\n",
    "451:",substring(gene2, 451, 500),"\n",
    "\n",
    "Base Count Results: \n",
    print_row(basecounts,1), "\n",
    print_row(basecounts,2), "\n",
    print_row(basecounts,3), "\n",
    print_row(basecounts,4), "\n",
    "\n",
    "Total Base Count:", paste(length(gene4))
    )


#lang racket

(define (fold-sequence seq kons #:finalise (finalise (λ x (apply values x))) . k0s)
  (define (recur seq . ks)
    (if (null? seq)
      (call-with-values (λ () (apply finalise ks)) (λ vs (apply values vs)))
      (call-with-values (λ () (apply kons (car seq) ks)) (λ ks+ (apply recur (cdr seq) ks+)))))
  (apply recur (if (string? seq) (string->list (regexp-replace* #px"[^ACGT]" seq "")) seq) k0s))

(define (sequence->pretty-printed-string seq)
  (define (fmt idx cs-rev) (format "~a: ~a" (~a idx #:width 3 #:align 'right) (list->string (reverse cs-rev))))
  (fold-sequence
    seq
    (λ (b n start-idx lns-rev cs-rev)
       (if (zero? (modulo n 50))
	 (values (+ n 1) n (if (pair? cs-rev) (cons (fmt start-idx cs-rev) lns-rev) lns-rev) (cons b null))
	 (values (+ n 1) start-idx lns-rev (cons b cs-rev))))
    0 0 null null
    #:finalise (λ (n idx lns-rev cs-rev)
		(string-join (reverse (if (null? cs-rev) lns-rev (cons (fmt idx cs-rev) lns-rev))) "\n"))))

(define (count-bases b as cs gs ts n)
  (values (+ as (if (eq? b #\A) 1 0))
	  (+ cs (if (eq? b #\C) 1 0))
	  (+ gs (if (eq? b #\T) 1 0))
	  (+ ts (if (eq? b #\G) 1 0))
	  (add1 n)))

(define (bioinformatics-Base_count s)
  (define-values (as cs gs ts n) (fold-sequence s count-bases 0 0 0 0 0))
  (printf "SEQUENCE:~%~%~a~%~%" (sequence->pretty-printed-string s))
  (printf "BASE COUNT:~%-----------~%~%~a~%~%"
	  (string-join (map (λ (c n) (format " ~a :~a" c (~a #:width 4 #:align 'right n)))
			    '(A T C G)
			    (list as ts cs gs)) "\n"))
  (newline)
  (printf "TOTAL: ~a~%" n))

(module+
  main
  (define the-string
    #<<EOS
CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG
CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG
AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT
GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT
CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG
TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA
TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT
CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG
TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC
GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT
EOS
)
  (bioinformatics-Base_count the-string))


my $dna = join '', lines q:to/END/;
    CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG
    CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG
    AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT
    GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT
    CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG
    TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA
    TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT
    CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG
    TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC
    GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT
    END

put pretty($dna, 80);
put "\nTotal bases: ", +my $bases = $dna.comb.Bag;
put $bases.sort(~*.key).join: "\n";

sub pretty ($string, $wrap = 50) {
    $string.comb($wrap).map( { sprintf "%8d: %s", $++ * $wrap, $_ } ).join: "\n"
}


/*REXX program finds the number of each  base  in a  DNA  string  (along with a total). */
parse arg dna .
if dna==''   | dna==","  then dna= 'cgtaaaaaattacaacgtcctttggctatctcttaaactcctgctaaatg'  ,
                                   'ctcgtgctttccaattatgtaagcgttccgagacggggtggtcgattctg'  ,
                                   'aggacaaaggtcaagatggagcgcatcgaacgcaataaggatcatttgat'  ,
                                   'gggacgtttcgtcgacaaagtcttgtttcgagagtaacggctaccgtctt'  ,
                                   'cgattctgcttataacactatgttcttatgaaatggatgttctgagttgg'  ,
                                   'tcagtcccaatgtgcggggtttcttttagtacgtcgggagtggtattata'  ,
                                   'tttaatttttctatatagcgatctgtatttaagcaattcatttaggttat'  ,
                                   'cgccgcgatgctcggttcggaccgccaagcatctggctccactgctagtg'  ,
                                   'tcctaaatttgaatggcaaacacaaataagatttagcaattcgtgtagac'  ,
                                   'gaccggggacttgcatgatgggagcagctttgttaaactacgaacgtaat'
dna= space(dna, 0);  upper dna                   /*elide blanks from DNA; uppercase it. */
say '────────length of the DNA string: '   length(dna)
@.= 0                                            /*initialize the count for all bases.  */
w= 1                                             /*the maximum width of a base count.   */
$=                                               /*a placeholder for the names of bases.*/
       do j=1  for length(dna)                   /*traipse through the  DNA  string.    */
       _= substr(dna, j, 1)                      /*obtain a base name from the DNA str. */
       if pos(_, $)==0  then $= $  ||  _         /*if not found before, add it to list. */
       @._= @._ + 1                              /*bump the count of this base.         */
       w= max(w, length(@._) )                   /*compute the maximum width number.    */
       end   /*j*/
say
       do k=0  for 255;   z= d2c(k)              /*traipse through all possibilities.   */
       if pos(z, $)==0  then iterate             /*Was this base found?  No, then skip. */
       say '     base '   z    " has a basecount of: "   right(@.z, w)
       @.tot= @.tot + @.z                        /*add to a grand total to verify count.*/
       end   /*k*/                               /*stick a fork in it,  we're all done. */
say
say '────────total for all basecounts:'                  right(@.tot, w+1)


dna = "" +
      "CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG" +
      "CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG" +
      "AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT" +
      "GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT" +
      "CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG" +
      "TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA" +
      "TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT" +
      "CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG" +
      "TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC" +
      "GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT"

dnaBase = [:A=0, :C=0, :G=0, :T=0]
lenDna = len(dna)
for n = 1 to lenDna
    dnaStr = substr(dna,n,1)
    switch dnaStr
           on "A"
              strA = dnaBase["A"]
              strA++
              dnaBase["A"] = strA
           on "C"
              strC = dnaBase["C"]
              strC++
              dnaBase["C"] = strC
           on "G"
              strG = dnaBase["G"]
              strG++
              dnaBase["G"] = strG
           on "T"
              strT = dnaBase["T"]
              strT++
              dnaBase["T"] = strT
     off
next
? "A : " + dnaBase["A"]
? "T : " + dnaBase["T"]
? "C : " + dnaBase["C"]
? "G : " + dnaBase["G"]


dna = <<DNA_STR
CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG
CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG
AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT
GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT
CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG
TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA
TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT
CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG
TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC
GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT
DNA_STR

chunk_size = 60
dna        = dna.delete("\n")
size       = dna.size

0.step(size, chunk_size) do |pos|
  puts "#{pos.to_s.ljust(6)} #{dna[pos, chunk_size]}"
end

puts dna.chars.tally.sort.map{|ar| ar.join(" : ") }
puts "Total : #{dna.size}"


use std::collections::HashMap;

fn main() {
    let dna = "CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG\
CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG\
AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT\
GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT\
CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG\
TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA\
TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT\
CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG\
TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC\
GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT";

    let mut base_count = HashMap::new();
    let mut total_count = 0;
    print!("Sequence:");
    for base in dna.chars() {
        if total_count % 50 == 0 {
            print!("\n{:3}: ", total_count);
        }
        print!("{}", base);
        total_count += 1;
        let count = base_count.entry(base).or_insert(0); // Return current count for base or insert 0
        *count += 1;
    }
    println!("\n");
    println!("Base count:");
    println!("-----------");

    let mut base_count: Vec<_> = base_count.iter().collect(); // HashMaps can't be sorted, so collect into Vec
    base_count.sort_by_key(|bc| bc.0); // Sort bases alphabetically
    for (base, count) in base_count.iter() {
        println!("  {}: {:3}", base, count);
    }
    println!();
    println!("Total: {}", total_count);
}


import Foundation

let dna = """
          CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG
          CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG
          AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT
          GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT
          CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG
          TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA
          TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT
          CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG
          TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC
          GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT
          """

print("input:\n\(dna)\n")

let counts =
  dna.replacingOccurrences(of: "\n", with: "").reduce(into: [:], { $0[$1, default: 0] += 1 })

print("Counts: \(counts)")
print("Total: \(counts.values.reduce(0, +))")


namespace path ::tcl::mathop

proc process {data {width 50}} {
	set len [string length $data]
	set addrwidth [string length [* [/ $len $width] $width]]
	for {set i 0} {$i < $len} {incr i $width} {
		puts "[format %${addrwidth}u $i] [string range $data $i $i+[- $width 1]]"
	}
	puts "\nBase count:"
	foreach base {A C G T} {
		puts "$base     [regexp -all $base $data]"
	}
	puts "Total $len"
}

set test [string cat \
			  CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG \
			  CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG \
			  AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT \
			  GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT \
			  CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG \
			  TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA \
			  TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT \
			  CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG \
			  TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC \
			  GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT]
process $test 50


fn main() {
    dna := "" +
        "CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG" +
        "CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG" +
        "AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT" +
        "GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT" +
        "CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG" +
        "TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA" +
        "TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT" +
        "CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG" +
        "TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC" +
        "GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT"

    println("SEQUENCE:")
    le := dna.len
    for i := 0; i < le; i += 50 {
        mut k := i + 50
        if k > le {
            k = le
        }
        println("${i:5}: ${dna[i..k]}")
    }
    mut base_map := map[byte]int{} // allows for 'any' base
    for i in 0..le {
        base_map[dna[i]]++
    }
    mut bases := base_map.keys()
	bases.sort()

    println("\nBASE COUNT:")
    for base in bases {
        println("    $base: ${base_map[base]:3}")
    }
    println("    ------")
    println("    Σ: $le")
    println("    ======")
}


import "/fmt" for Fmt
import "/sort" for Sort
import "/trait" for Stepped

var dna = "CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG" +
          "CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG" +
          "AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT" +
          "GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT" +
          "CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG" +
          "TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA" +
          "TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT" +
          "CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG" +
          "TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC" +
          "GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT"

System.print("SEQUENCE:")
var le = dna.count
for (i in Stepped.new(0...le, 50)) {
    var k = i + 50
    if (k > le) k = le
    System.print("%(Fmt.d(5, i)): %(dna[i...k])")
}
var baseMap = {} // allows for 'any' base
for (i in 0...le) {
    var d = dna[i]
    var v = baseMap[d]
    baseMap[d] = !v ? 1 : v + 1
}
var bases = baseMap.keys.toList
Sort.quick(bases)

System.print("\nBASE COUNT:")
for (base in bases) {
    System.print("    %(base): %(Fmt.d(3, baseMap[base]))")
}
System.print("    ------")
System.print("    Σ: %(le)")
System.print("    ======")


char    Bases;
int     Counts(256), Cnt, I, Ch;
[Bases:= "
CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG
CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG
AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT
GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT
CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG
TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA
TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT
CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG
TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC
GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAATx ";

for I:= 0 to 255 do Counts(I):= 0;
Format(5, 0);
Cnt:= 0;
I:= 0;
loop    [repeat Ch:= Bases(I);
                I:= I+1;
                if Ch = ^x then quit;
                Counts(Ch):= Counts(Ch)+1;
                ChOut(0, Ch);
        until   Ch = \LF\$0A;
        RlOut(0, float(Cnt));  Text(0, ": ");
        Cnt:= Cnt + 50;
        ];
CrLf(0);  CrLf(0);
Text(0, "Base counts A: ");  IntOut(0, Counts(^A));
Text(0, " C: ");  IntOut(0, Counts(^C));
Text(0, " G: ");  IntOut(0, Counts(^G));
Text(0, " T: ");  IntOut(0, Counts(^T));
Text(0, "
Total: ");  IntOut(0, Cnt);  CrLf(0);
]


bases:=
#<<<"
CGTAAAAAATTACAACGTCCTTTGGCTATCTCTTAAACTCCTGCTAAATG
CTCGTGCTTTCCAATTATGTAAGCGTTCCGAGACGGGGTGGTCGATTCTG
AGGACAAAGGTCAAGATGGAGCGCATCGAACGCAATAAGGATCATTTGAT
GGGACGTTTCGTCGACAAAGTCTTGTTTCGAGAGTAACGGCTACCGTCTT
CGATTCTGCTTATAACACTATGTTCTTATGAAATGGATGTTCTGAGTTGG
TCAGTCCCAATGTGCGGGGTTTCTTTTAGTACGTCGGGAGTGGTATTATA
TTTAATTTTTCTATATAGCGATCTGTATTTAAGCAATTCATTTAGGTTAT
CGCCGCGATGCTCGGTTCGGACCGCCAAGCATCTGGCTCCACTGCTAGTG
TCCTAAATTTGAATGGCAAACACAAATAAGATTTAGCAATTCGTGTAGAC
GACCGGGGACTTGCATGATGGGAGCAGCTTTGTTAAACTACGAACGTAAT" - " \n";
#<<<

[0..*,50].zipWith(fcn(n,bases){ println("%6d: %s".fmt(n,bases.concat())) },
   bases.walker().walk.fp(50)).pump(Void);  // .pump forces the iterator

println("\nBase Counts: ", bases.counts().pump(String,Void.Read,"%s: %d  ".fmt));
println("Total: ",bases.len());


T Colour
   Byte r, g, b

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

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

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

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

   F (width = 40, height = 40, background = white)
      assert(width > 0 & height > 0)
      .width = width
      .height = height
      .background = background
      .map = [[background] * width] * height

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

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

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

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

V bitmap = Bitmap(20, 10)
bitmap.fillrect(4, 5, 6, 3)
assert(bitmap.get(5, 5) == black)
assert(bitmap.get(0, 1) == white)
bitmap.set(0, 1, black)
assert(bitmap.get(0, 1) == black)
bitmap.chardisplay()


INCLUDE "H6:RGBIMAGE.ACT" ;from task Bitmap

RGB black,yellow,violet,blue

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

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

PROC Main()
  RgbImage img
  BYTE CH=$02FC,width=[80],height=[60]
  BYTE ARRAY ptr(14400)
  BYTE i,x,y,c

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

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

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

  FOR i=1 TO 1000
  DO
    c=Rand(3)
    x=Rand(width)
    y=Rand(height)
    IF c=0 THEN
      SetRgbPixel(img,x,y,yellow)
    ELSEIF c=1 THEN
      SetRgbPixel(img,x,y,violet)
    ELSE
      SetRgbPixel(img,x,y,black)
    FI
  OD

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

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


// To import the BitmapData class:
import flash.display.BitmapData;

// Creates a new BitmapData object with a width of 500 pixels and a height of 300 pixels.
var bitmap:BitmapData = new BitmapData(500, 300);

// Create a BitmapData with transparency disallowed
var opaqueBitmap:BitmapData = new BitmapData(500, 300, false);

// Bitmap with initial fill colour, as 0xAARRGGBB (default is white)
var redFilledBitmap:BitmapData = new BitmapData(400, 300, true, 0xFFFF0000);

// Get the colour value of the pixel at point (200, 200)
bitmap.getPixel(200, 200)     // As 0xRRGGBB
bitmap.getPixel32(200, 200)   // As 0xAARRGGBB

// Set the colour value of the pixel at point (300, 200) to blue
bitmap.setPixel(300, 200, 0x0000FF);       // As 0xRRGGBB
bitmap.setPixel32(300, 200, 0xFF0000FF);   // As 0xAARRGGBB

// Fill the bitmap with a given colour (as 0xAARRGGBB) after construction
bitmap.fillRect(bitmap.rect, 0xFF44FF44);


package Bitmap_Store is
   type Luminance is mod 2**8;
   type Pixel is record
      R, G, B : Luminance := Luminance'First;
   end record;
   Black : constant Pixel := (others => Luminance'First);
   White : constant Pixel := (others => Luminance'Last);
   type Image is array (Positive range <>, Positive range <>) of Pixel;

   procedure Fill (Picture : in out Image; Color : Pixel);

   procedure Print (Picture : Image);

   type Point is record
      X, Y : Positive;
   end record;
end Bitmap_Store;


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

MODE PIXEL = STRUCT(#SHORT# BITS red,green,blue);
MODE POINT = STRUCT(INT x,y);

MODE IMAGE = [0,0]PIXEL; # instance attributes #

MODE CLASSIMAGE = STRUCT ( # class attributes #
  PIXEL black, red, green, blue, white,
  PROC (REF IMAGE)REF IMAGE init,
  PROC (REF IMAGE, PIXEL)VOID fill,
  PROC (REF IMAGE)VOID print,
# virtual: #
  REF PROC (REF IMAGE, POINT, POINT, PIXEL)VOID line,
  REF PROC (REF IMAGE, POINT, INT, PIXEL)VOID circle,
  REF PROC (REF IMAGE, POINT, POINT, POINT, POINT, PIXEL, UNION(INT, VOID))VOID cubic bezier
);

CLASSIMAGE class image = (
  # black = # (#SHORTEN# 16r00, #SHORTEN# 16r00, #SHORTEN# 16r00),
  # red   = # (#SHORTEN# 16rff, #SHORTEN# 16r00, #SHORTEN# 16r00),
  # green = # (#SHORTEN# 16r00, #SHORTEN# 16rff, #SHORTEN# 16r00),
  # blue  = # (#SHORTEN# 16r00, #SHORTEN# 16r00, #SHORTEN# 16rff),
  # white = # (#SHORTEN# 16rff, #SHORTEN# 16rff, #SHORTEN# 16rff),
  # PROC init = # (REF IMAGE self)REF IMAGE:
    BEGIN
      (fill OF class image)(self, black OF class image);
      self
    END,

  # PROC fill = # (REF IMAGE self, PIXEL color)VOID:
      FOR x FROM 1 LWB self TO 1 UPB self DO
        FOR y FROM 2 LWB self TO 2 UPB self DO
          self[x,y] := color
        OD
      OD,
  # PROC print = # (REF IMAGE self)VOID:
      printf(($n(UPB self)(3(16r2d))l$, self)),
# virtual: #
  # REF PROC line = # LOC PROC (REF IMAGE, POINT, POINT, PIXEL)VOID,
  # REF PROC circle = # LOC PROC (REF IMAGE, POINT, INT, PIXEL)VOID,
  # REF PROC cubic bezier = # LOC PROC (REF IMAGE, POINT, POINT, POINT, POINT, PIXEL, UNION(INT, VOID))VOID
);

OP CLASSOF = (IMAGE image)CLASSIMAGE: class image;
OP INIT = (REF IMAGE image)REF IMAGE: (init OF (CLASSOF image))(image);

SKIP


Bitmap_FloodFill:
	;input:
	;r0 = color to fill screen with (15-bit color)
	STMFD sp!,{r0-r12,lr}

			MOV R2,#160
			MOV R4,#0x06000000
outerloop_floodfill:
			MOV R1,#240               ;restore inner loop counter
innerloop_floodfill:
			strH r0,[r4]
			add r4,r4,#2              ;next pixel
			subs r1,r1,#1             ;decrement loop counter
			bne innerloop_floodfill
			subs r2,r2,#1
			bne outerloop_floodfill

	LDMFD sp!,{r0-r12,pc}

Bitmap_Locate:
        ;given x and y coordinates, offsets vram addr to that pixel on screen.
	;input:
	;r0 = x
	;r1 = y
	;output: r2 = vram area
	STMFD sp!,{r4-r12,lr}
		mov r2,#0x06000000	;vram base

		mov r4,#240*2          ;240 pixels across, 2 bytes per pixel
		mul r1,r4,r1
		add r2,r2,r1          ;add y*480
		add r2,r2,r0,lsl #1   ;add x*2
	LDMFD sp!,{r4-r12,pc}

Bitmap_StorePixel:
	;input: r3 = color
	;r0 = x
	;r1 = y
	bl Bitmap_Locate
	strH r3,[r2]                 ;store the pixel color in video memory
	bx lr

Bitmap_GetPixel:
        ;retrieves the color of the pixel at [r2] and stores its color value in r3.
	;r0 = x
	;r1 = y
	;output in r3
	bl Bitmap_Locate
	ldrH r3,[r2]
	bx lr


test:
blue := color(0,0,255)  ; rgb
cyan := color(0,255,255)
blue_square := Bitmap(10, 10, blue)
cyanppm := Bitmap(10, 10, cyan)
x := blue_square[4,4] ; get pixel(4,4)
msgbox % "blue: 4,4,R,G,B, RGB: " x.R ", " x.G ", " x.B ", " x.rgb()
blue_square[4,4] := cyan ; set pixel(4,4)
x := blue_square[4,4] ; get pixel(4,4)
blue_square.write("blue.ppm")
return

Bitmap(width = 1, height = 1, background = 0)
{
global black
black := color(0,0,0)
if !background
background := black

    static BitmapType
    if !BitmapType
        BitmapType
        := Object("fill", "Bitmap_Fill"
	         ,"write", "Bitmap_write_ppm3")

	img := Object("width", width
                ,"height", height
                , "base"    , BitmapType)

	img._SetCapacity(height) ; an array of rows
  img.fill(background)
Return img
}

Bitmap_Fill(bitmap, color)
{
r := color.r
g := color.g
b := color.b
  loop % bitmap.height
  {
    height := A_Index
    loop % bitmap.width
    {
      width := A_Index
      bitmap[height, width] := color(r, g, b)
    }
  }
 return bitmap
}

Bitmap_write_ppm3(bitmap, filename)
{
file := FileOpen(filename, 0x11) ; utf-8, write
file.seek(0,0)
file.write("P3`n"
. 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
}

Color(r, g, b)
{
    static ColorType
    if !ColorType
        ColorType
        := Object("rgb"   , "Color_rgb")

    return Object("r" , r, "g", g, "b", b
                , "base"    , ColorType)

 ; return Object("r" , r, "g", g, "b", b, "rgb", "Color_rgb")
}

Color_rgb(clr)
{
return clr.R << 16 | clr.G << 8 | clr.B
}


Buff(768)→Pic1
Fill(Pic1,768,255)
Pxl-Off(45,30,Pic1)

.Display the bitmap to demonstrate
Copy(Pic1)
DispGraph
Pause 4500

Disp pxl-Test(50,50,Pic1)▶Dec,i


graphsize 30,30
call fill(rgb(255,0,0))
call setpixel(10,10,rgb(0,255,255))
print "pixel 10,10 is " + pixel(10,10)
print "pixel 20,20 is " + pixel(20,10)

imgsave "BASIC256_bitmap.png"
end

subroutine fill(c)
color c
rect 0,0,graphwidth, graphheight
end subroutine

subroutine setpixel(x,y,c)
color c
plot x,y
end subroutine


      Width% = 200
      Height% = 200

      REM Set window size:
      VDU 23,22,Width%;Height%;8,16,16,128

      REM Fill with an RGB colour:
      PROCfill(100,150,200)

      REM Set a pixel:
      PROCsetpixel(100,100,255,255,0)

      REM Get a pixel:
      rgb% = FNgetpixel(100,100)
      PRINT RIGHT$("00000" + STR$~rgb%, 6)
      END

      DEF PROCfill(r%,g%,b%)
      COLOUR 1,r%,g%,b%
      GCOL 1+128
      CLG
      ENDPROC

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

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


#ifndef _IMGLIB_0
#define _IMGLIB_0

#include <stdio.h>
#include <stdlib.h>
#include <sys/types.h>
#include <string.h>
#include <math.h>
#include <sys/queue.h>

typedef unsigned char color_component;
typedef color_component pixel[3];
typedef struct {
    unsigned int width;
    unsigned int height;
    pixel * buf;
} image_t;
typedef image_t * image;

image alloc_img(unsigned int width, unsigned int height);
void free_img(image);
void fill_img(image img,
        color_component r,
        color_component g,
        color_component b );
void put_pixel_unsafe(
       	image img,
        unsigned int x,
        unsigned int y,
        color_component r,
        color_component g,
        color_component b );
void put_pixel_clip(
       	image img,
        unsigned int x,
        unsigned int y,
        color_component r,
        color_component g,
        color_component b );
#define GET_PIXEL(IMG, X, Y) (IMG->buf[ ((Y) * IMG->width + (X)) ])
#endif


public class Bitmap
{
    public struct Color
    {
        public byte Red { get; set; }
        public byte Blue { get; set; }
        public byte Green { get; set; }
    }
    Color[,] _imagemap;
    public int Width { get { return _imagemap.GetLength(0); } }
    public int Height { get { return _imagemap.GetLength(1); } }
    public Bitmap(int width, int height)
    {
        _imagemap = new Color[width, height];
    }
    public void Fill(Color color)
    {
        for (int y = 0; y < Height; y++)
            for (int x = 0; x < Width; x++)
            {
                _imagemap[x, y] = color;
            }
    }
    public Color GetPixel(int x, int y)
    {
        return _imagemap[x, y];
    }
    public void SetPixel(int x, int y, Color color)
    {
        _imagemap[x, y] = color;
    }
}


#include <iostream>
#include <boost/gil/gil_all.hpp>
int main()
{
    using namespace boost::gil;
    // create 30x40 image
    rgb8_image_t img(30, 40);

    // fill with red
    rgb8_pixel_t red(255, 0, 0);
    fill_pixels(view(img), red);

    // set pixel at 10x20 to blue
    rgb8_pixel_t blue(0, 0, 255);
    view(img)(10, 20) = blue;

    // read the value of pixel at 11x20
    rgb8_pixel_t px = const_view(img)(11, 20);
    std::cout << "the pixel at 11, 20 is " << (unsigned)px[0] << ':' << (unsigned)px[1] << ':' << (unsigned)px[2]  << '\n';
}


(import '[java.awt Color Graphics Image]
	'[java.awt.image BufferedImage])

(defn blank-bitmap [width height]
  (BufferedImage. width height BufferedImage/TYPE_3BYTE_BGR))

(defn fill [image color]
  (doto (.getGraphics image)
    (.setColor color)
    (.fillRect 0 0 (.getWidth image) (.getHeight image))))

(defn set-pixel [image x y color]
  (.setRGB image x y (.getRGB color)))

(defn get-pixel [image x y]
  (Color. (.getRGB image x y)))


(defpackage #:rgb-pixel-buffer
  (:use #:common-lisp)
  (:export #:rgb-pixel-component #:rgb-pixel #:rgb-pixel-buffer
           #:+red+ #:+green+ #:+blue+ #:+black+ #:+white+
           #:make-rgb-pixel #:make-rgb-pixel-buffer #:rgb-pixel-buffer-width
           #:rgb-pixel-buffer-height #:rgb-pixel-red #:rgb-pixel-green
           #:rgb-pixel-blue #:fill-rgb-pixel-buffer))


class RGBColor
  getter red, green, blue

  def initialize(@red = 0_u8, @green = 0_u8, @blue = 0_u8)
  end

  RED   = new(red: 255_u8)
  GREEN = new(green: 255_u8)
  BLUE  = new(blue: 255_u8)
  BLACK = new
  WHITE = new(255_u8, 255_u8, 255_u8)
end

class Pixmap
  getter width, height
  @data : Array(Array(RGBColor))

  def initialize(@width : Int32, @height : Int32)
    @data = Array.new(@width) { Array.new(@height, RGBColor::WHITE) }
  end

  def fill(color)
    @data.each &.fill(color)
  end

  def [](x, y)
    @data[x][y]
  end

  def []=(x, y, color)
    @data[x][y] = color
  end
end

bmap = Pixmap.new(5, 5)
pp bmap


module bitmap;

import std.stdio, std.array, std.exception, std.string, std.conv,
       std.algorithm, std.ascii;

final class Image(T) {
    static if (is(typeof({ auto x = T.black; })))
        const static T black = T.black;
    else
        const static T black = T.init;
    static if (is(typeof({ auto x = T.white; })))
        const static T white = T.white;

    T[] image;
    private size_t nx_, ny_;

    this(in int nxx=0, in int nyy=0, in bool inizialize=true)
    pure nothrow {
        allocate(nxx, nyy, inizialize);
    }

    void allocate(in int nxx=0, in int nyy=0, in bool inizialize=true)
    pure nothrow @safe in {
        assert(nxx >= 0 && nyy >= 0);
    } body {
        this.nx_ = nxx;
        this.ny_ = nyy;
        if (nxx * nyy > 0) {
            if (inizialize)
                image.length = nxx * nyy;
            else // Optimization.
                image = minimallyInitializedArray!(typeof(image))
                                                  (nxx * nyy);
        }
    }

    @property Image dup() const pure nothrow @safe {
        auto result = new Image();
        result.image = this.image.dup;
        result.nx_ = this.nx;
        result.ny_ = this.ny;
        return result;
    }

    static Image fromData(T[] data, in size_t nxx=0, in size_t nyy=0)
    pure nothrow @safe in {
        assert(nxx >= 0 && nyy >= 0 && data.length == nxx * nyy);
    } body {
        auto result = new Image();
        result.image = data;
        result.nx_ = nxx;
        result.ny_ = nyy;
        return result;
    }

    @property size_t nx() const pure nothrow @safe @nogc { return nx_; }
    @property size_t ny() const pure nothrow @safe @nogc { return ny_; }

    ref T opIndex(in size_t x, in size_t y) pure nothrow @safe @nogc
    in {
        assert(x < nx_ && y < ny_);
        //assert(x < nx_, format("opIndex, x=%d, nx=%d", x, nx));
        //assert(y < ny_, format("opIndex, y=%d, ny=%d", y, ny));
    } body {
        return image[x + y * nx_];
    }

    T opIndex(in size_t x, in size_t y) const pure nothrow @safe @nogc
    in {
        assert(x < nx_ && y < ny_);
        //assert(x < nx_, format("opIndex, x=%d, nx=%d", x, nx));
        //assert(y < ny_, format("opIndex, y=%d, ny=%d", y, ny));
    } body {
        return image[x + y * nx_];
    }

    T opIndexAssign(in T color, in size_t x, in size_t y)
    pure nothrow @safe @nogc
    in {
        assert(x < nx_ && y < ny_);
        //assert(x < nx_, format("opIndex, x=%d, nx=%d", x, nx));
        //assert(y < ny_, format("opIndex, y=%d, ny=%d", y, ny));
    } body {
        return image[x + y * nx_] = color;
    }

    void opIndexUnary(string op)(in size_t x, in size_t y)
    pure nothrow @safe @nogc
    if (op == "++" || op == "--") in {
        assert(x < nx_ && y < ny_);
    } body {
        mixin("image[x + y * nx_] " ~ op ~ ";");
    }

    void clear(in T color=this.black) pure nothrow @safe @nogc {
        image[] = color;
    }

    /// Convert a 2D array of chars to a binary Image.
    static Image fromText(in string txt,
                          in char one='#', in char zero='.') pure {
        auto M = txt
                 .strip
                 .split
                 .map!(row => row
                              .filter!(c => c == one || c == zero)
                              .map!(c => T(c == one))
                              .array)
                 .array;
        assert(M.join.length > 0); // Not empty.
        foreach (row; M)
            assert(row.length == M[0].length); // Rectangular
        return Image.fromData(M.join, M[0].length, M.length);
    }

    /// The axis origin is at the top left.
    void textualShow(in char bl='#', in char wh='.') const nothrow {
        size_t i = 0;
        foreach (immutable y; 0 .. ny_) {
            foreach (immutable x; 0 .. nx_)
                putchar(image[i++] == black ? bl : wh);
            putchar('\n');
        }
    }
}

struct RGB {
    ubyte r, g, b;
    static immutable black = typeof(this)();
    static immutable white = typeof(this)(255, 255, 255);
}

Image!RGB loadPPM6(ref Image!RGB img, in string fileName) {
    if (img is null)
        img = new Image!RGB;
    auto f = File(fileName, "rb");
    enforce(f.readln.strip == "P6");
    string line;
    do {
        line = f.readln();
    } while (line.length && line[0] == '#'); // Skip comments.
    const size = line.split;
    enforce(size.length == 2);
    img.allocate(size[0].to!uint, size[1].to!uint);
    enforce(f.readln().strip() == "255");
    auto l = new ubyte[img.nx * 3];
    size_t i = 0;
    foreach (immutable y; 0 .. img.ny) {
        f.rawRead!ubyte(l);
        foreach (immutable x; 0 .. img.nx)
            img.image[i++] = RGB(l[x * 3], l[x * 3 + 1], l[x * 3 + 2]);
    }
    return img;
}

void savePPM6(in Image!RGB img, in string fileName)
in {
    assert(img !is null);
    assert(img.nx > 0 && img.nx > 0);
} body {
    auto f = File(fileName, "wb");
    f.writefln("P6\n%d %d\n255", img.nx, img.ny);
    size_t i = 0;
    foreach (immutable y; 0 .. img.ny)
        foreach (immutable x; 0 .. img.nx) {
            immutable p = img.image[i++];
            f.write(cast(char)p.r, cast(char)p.g, cast(char)p.b);
        }
}

version (bitmap_main) {
    void main() {
        auto img = new Image!RGB(30, 10);
        img[4, 5] = RGB.white;
        img.textualShow;
    }
}


program BitmapTest;

{$APPTYPE CONSOLE}

type
  TColor = record
  private
    function GetColor: Cardinal;
    procedure SetColor(const Value: Cardinal);
  public
    Red, Green, Blue, Alpha: Byte;
    property Color: Cardinal read GetColor write SetColor;
  end;

  TBitmap = class
  private
    FPixels: array of array of TColor;
    FHeight: Integer;
    FWidth: Integer;
    function GetPixel(X, Y: integer): TColor;
  public
    procedure Fill(aColor: TColor); overload;
    procedure Fill(aColor: Cardinal); overload;
    procedure SetSize(w, h: Integer);
    constructor Create(); overload;
    constructor Create(w, h: Integer); overload;
    property Height: Integer read FHeight;
    property Width: Integer read FWidth;
    property Pixel[X, Y: integer]: TColor read GetPixel;
  end;

{ TColor }

function TColor.GetColor: Cardinal;
begin
  Result := (alpha shl 24) + (red shl 16) + (green shl 8) + blue;
end;

procedure TColor.SetColor(const Value: Cardinal);
begin
  blue := (Value and $FF);
  green := ((Value shr 8) and $FF);
  red := ((Value shr 16) and $FF);
  alpha := ((Value shr 24) and $FF);
end;

{ TBitmap }

constructor TBitmap.Create;
begin
  inherited;
  FHeight := 0;
  FWidth := 0;
end;

constructor TBitmap.Create(w, h: Integer);
begin
  Create;
  SetSize(w, h);
end;

procedure TBitmap.Fill(aColor: Cardinal);
var
  x, y: Integer;
begin
  if (Width > 0) and (Height > 0) then
    for x := 0 to width - 1 do
      for y := 0 to height - 1 do
        FPixels[x, y].Color := aColor;
end;

procedure TBitmap.Fill(aColor: TColor);
begin
  Fill(aColor.Color);
end;

function TBitmap.GetPixel(X, Y: integer): TColor;
begin
  Result := FPixels[X, Y];
end;

procedure TBitmap.SetSize(w, h: Integer);
var
  i: Integer;
begin
  if (h = 0) or (w = 0) then
  begin
    h := 0;
    w := 0;
  end;

  FHeight := h;
  FWidth := w;
  SetLength(FPixels, w);
  if w > 0 then
    for i := 0 to w - 1 do
      SetLength(FPixels[i], h);
end;

var
  bmp: TBitmap;
  x, y: Integer;

begin
  bmp := TBitmap.Create(200, 200);
  bmp.Fill($00FF0000);
  for y := 0 to bmp.Height - 1 do
    for x := 0 to bmp.Width - 1 do
    begin
      if x mod 2 = 1 then
        bmp.Pixel[x, y].Color := $0000FF;
    end;
  bmp.Free;
end.


def makeFlexList := <elib:tables.makeFlexList>
def format := <import:java.lang.makeString>.format

def CHANNELS := 3
def UByte := 0..255

def makeColor {
  to fromFloat(r, g, b) {
    return makeColor.fromByte((r * 255).round(),
                              (g * 255).round(),
                              (b * 255).round())
  }
  to fromByte(r :UByte, g :UByte, b :UByte) {
    def color {
      to __printOn(out) {
        out.print(format("%02x%02x%02x", [color.rb(), color.gb(), color.bb()]))
      }
      to rf() { return r / 255 }
      to gf() { return g / 255 }
      to bf() { return b / 255 }
      to rb() { return r }
      to gb() { return g }
      to bb() { return b }
    }
    return color
  }
}

/** Convert 0..255 into 0..127 -128..-1 */
def sign(v) {
  return v %% 256 - 2*(v & 128)
}

def makeImage(width, height) {
  # NOTE: The primary E implementation is in Java and Java's fixed-size integers only
  # come in signed varieties. Therefore, there is a little bit of extra arithmetic.
  #
  # In an ideal E implementation we would specify the type 0..255, but this is not
  # currently possible everywhere, or efficient.

  def storage := makeFlexList.fromType(<type:java.lang.Byte>, width * height * CHANNELS)
  storage.setSize(width * height * CHANNELS)

  def X := 0..!width
  def Y := 0..!height

  def flexImage {
    to __printOn(out) {
      for y in Y {
        out.print("[")
        for x in X {
          out.print(flexImage[x, y], " ")
        }
        out.println("]")
      }
    }
    to width() { return width }
    to height() { return height }
    to fill(color) {
      for x in X {
        for y in Y {
          flexImage[x, y] := color
        }
      }
    }
    to get(x :X, y :Y) {
      def base := (y * width + x) * CHANNELS
      return makeColor.fromByte(storage[base + 0] %% 256,
                                storage[base + 1] %% 256,
                                storage[base + 2] %% 256)
    }
    /** Provided to make [[Flood fill]] slightly less insanely slow. */
    to test(x :X, y :Y, c) {
      def base := (y * width + x) * CHANNELS
      return storage[base + 0] <=> sign(c.rb()) &&
             storage[base + 1] <=> sign(c.gb()) &&
             storage[base + 2] <=> sign(c.bb())
    }
    to put(x :X, y :Y, c) {
      def base := (y * width + x) * CHANNELS
      storage[base + 0] := sign(c.rb())
      storage[base + 1] := sign(c.gb())
      storage[base + 2] := sign(c.bb())
    }
    to writePPM(outputStream) {
      outputStream.write(`P6$\n$width $height$\n255$\n`.getBytes("US-ASCII"))
      outputStream.write(storage.getArray())
    }
    /** Used for [[Read ppm file]] */
    to replace(list :List) {
      require(list.size() == width * height * CHANNELS)
      storage(0) := list
    }
  }

  return flexImage
}


(lib 'plot)
(define width 600)
(define height 400)

(plot-size width height) ;; set image size

(define (blue x y) (rgb 0.0 0.0 1.0)) ;; a constant function
(plot-rgb blue 1 1) ;; blue everywhere

(lib 'types) ;; uint32 and uint8 vector types

;; bit-map pixel access
(define bitmap (pixels->uint32-vector)) ;; screen to vector of int32
    → 240000

(define (pix-at x y) (vector-ref bitmap (+ x (* y width))))
(rgb->list (pix-at 100 200)) → (0 0 255 255)  ;; rgb blue

;; writing to bitmap
(define (set-color-xy x y col) (vector-set! bitmap (+ x (* y width)) col))

(for* ((x 100)(y 200)) (set-color-xy x y (rgb 1 1 0))) ;; to bitmap
(vector->pixels bitmap) ;; bitmap to screen

;; bit-map color components (r g b a) = index (0 1 2 3) access
(define bitmap (pixels->uint8-clamped-vector)) ;; screen to vector of uint8
(vector-length bitmap)
    → 960000
(define (blue-at-xy x y) (vector-ref bitmap (+ x 3 (* y width)))) ;; 3 = blue component
(blue-at-xy 100 200)
    → 255


defmodule RosBitmap do
  defrecord Bitmap, pixels: nil, shape: {0, 0}

  defp new(width, height, {:rgb, r, g, b}) do
    Bitmap[
      pixels: :array.new(width * height,
        {:default, <<r::size(8), g::size(8), b::size(8)>>}),
      shape: {width, height}]
  end

  def new(width, height), do: new(width, height, {:rgb, 0, 0, 0})

  def fill(Bitmap[shape: {width, height}], {:rgb, _r, _g, _b}=color) do
    new(width, height, color)
  end

  def set_pixel(Bitmap[pixels: pixels, shape: {width, _height}]=bitmap,
      {:at, x, y}, {:rgb, r, g, b}) do
    index = x + y * width
    bitmap.pixels(:array.set(index, <<r::size(8), g::size(8), b::size(8)>>, pixels))
  end

  def get_pixel(Bitmap[pixels: pixels, shape: {width, _height}], {:at, x, y}) do
    index = x + y * width
    <<r::size(8), g::size(8), b::size(8)>> = :array.get(index, pixels)
    {:rgb, r, g, b}
  end
end


-module(ros_bitmap).

-export([new/2, fill/2, set_pixel/3, get_pixel/2]).

-record(bitmap, {
    pixels = nil,
    shape = {0, 0}
  }).

new(Width, Height) ->
  #bitmap{pixels=array:new(Width * Height, {default, <<0:8, 0:8, 0:8>>}), shape={Width, Height}}.

fill(#bitmap{shape={Width, Height}}, {rgb, R, G, B}) ->
  #bitmap{
    pixels=array:new(Width * Height, {default, <<R:8, G:8, B:8>>}),
    shape={Width, Height}}.

set_pixel(#bitmap{pixels=Pixels, shape={Width, _Height}}=Bitmap, {at, X, Y}, {rgb, R, G, B}) ->
  Index = X + Y * Width,
  Bitmap#bitmap{pixels=array:set(Index, <<R:8, G:8, B:8>>, Pixels)}.

get_pixel(#bitmap{pixels=Pixels, shape={Width, _Height}}, {at, X, Y}) ->
  Index = X + Y * Width,
  <<R:8, G:8, B:8>> = array:get(Index, Pixels),
  {rgb, R, G, B}.


-- Some color constants:
constant
    black = #000000,
    white = #FFFFFF,
    red =   #FF0000,
    green = #00FF00,
    blue =  #0000FF

-- Create new image filled with some color
function new_image(integer width, integer height, atom fill_color)
    return repeat(repeat(fill_color,height),width)
end function

-- Usage example:
sequence image
image = new_image(800,600,black)

-- Set pixel color:
image[400][300] = red

-- Get pixel color
atom color
color = image[400][300] -- Now color is #FF0000


//pure functional version ... changing a pixel color provides a new Bitmap
type Color = {red: byte; green: byte; blue: byte}
type Point = {x:uint32; y:uint32}
type Bitmap = {color: Color array; maxX: uint32; maxY: uint32}

let colorBlack = {red = (byte) 0; green = (byte) 0; blue = (byte) 0}
let emptyBitmap = {color = Array.empty; maxX = (uint32) 0; maxY = (uint32) 0}
let bitmap (width: uint32) (height: uint32) =
    match width, height with
    | 0u,0u | 0u,_ | _, 0u -> emptyBitmap
    | _,_ -> {color = Array.create ((int) (width * height)) colorBlack;
            maxX = width;
            maxY = height}
let getPixel point bitmap =
    match bitmap.color with
    | c when c |> Array.isEmpty -> None
    | c when (uint32) c.Length <= (point.y * bitmap.maxY + point.x) -> None
    | c -> Some c.[(int) (point.y * bitmap.maxY + point.x)]
let setPixel point color bitmap =
    {bitmap with color = bitmap.color |> Array.mapi (function
                | i when i = (int) (point.y * bitmap.maxY + point.x) ->
                    (fun _ -> color)
                | _ -> id)}
let fill color bitmap = {bitmap with color = bitmap.color |> Array.map (fun _ ->color)}


USING: arrays fry kernel math.matrices sequences ;
IN: rosettacode.raster.storage

! Various utilities
: meach ( matrix quot -- ) [ each ] curry each ; inline
: meach-index ( matrix quot -- )
    [ swap 2array ] prepose
    [ curry each-index ] curry each-index ; inline
: mmap ( matrix quot -- matrix' ) [ map ] curry map ; inline
: mmap! ( matrix quot -- matrix' ) [ map! ] curry map! ; inline
: mmap-index ( matrix quot -- matrix' )
    [ swap 2array ] prepose
    [ curry map-index ] curry map-index ; inline

: matrix-dim ( matrix -- i j ) [ length ] [ first length ] bi ;
: set-Mi,j ( elt {i,j} matrix -- ) [ first2 swap ] dip nth set-nth ;
: Mi,j ( {i,j} matrix -- elt ) [ first2 swap ] dip nth nth ;

! The storage functions
: <raster-image> ( width height -- image )
    zero-matrix [ drop { 0 0 0 } ] mmap ;
: fill-image ( {R,G,B} image -- image )
    swap '[ drop _ ] mmap! ;
: set-pixel ( {R,G,B} {i,j} image -- ) set-Mi,j ; inline
: get-pixel ( {i,j} image -- pixel ) Mi,j ; inline


#DEFINE WM_LBUTTONDOWN 513
#DEFINE WM_RBUTTONDOWN 516
#DEFINE WM_CLOSE 16

FBSLSETFORMCOLOR(ME, RGB(0, 255, 255)) ' Cyan: set persistent background color
DRAWWIDTH(5) ' Adjust point size
FBSL.GETDC(ME) ' Use volatile FBSL.GETDC below to avoid extra assignments

RESIZE(ME, 0, 0, 300, 200)
CENTER(ME)
SHOW(ME)

BEGIN EVENTS
	SELECT CASE CBMSG
		CASE WM_LBUTTONDOWN ' Set color at current coords as hex literal
			PSET(FBSL.GETDC, LOWORD(CBLPARAM), HIWORD(CBLPARAM), &H0000FF) ' Red: Windows stores colors in BGR order
		CASE WM_RBUTTONDOWN ' Get color at current coords as hex literal
			FBSLSETTEXT(ME, "&H" & HEX(POINT(FBSL.GETDC, LOWORD(CBLPARAM), HIWORD(CBLPARAM))))
		CASE WM_CLOSE ' Clean up
			FBSL.RELEASEDC(ME, FBSL.GETDC)
	END SELECT
END EVENTS


hex
0000ff constant red
00ff00 constant green
ff0000 constant blue
decimal

1 cells constant pixel
: pixels cells ;

: bdim ( bmp -- w h ) [email protected] ;
: bheight ( bmp -- h ) @ ;
: bwidth ( bmp -- w ) bdim drop ;
: bdata ( bmp -- addr ) 2 cells + ;

: bitmap ( w h -- bmp )
  2dup * pixels bdata allocate throw
  dup >r 2! r> ;

: bfill ( pixel bmp -- )
  dup bdata swap bdim * pixels
  bounds do
    dup i !
  pixel +loop
  drop ;

: bxy ( x y bmp -- addr )
  dup >r bwidth * + pixels r> bdata + ;

: [email protected] ( x y bmp -- pixel ) bxy @ ;
: b! ( pixel x y bmp -- ) bxy ! ;

: bshow ( bmp -- )
  hex
  dup bdim
  0 do cr
    dup 0 do
      over i j rot [email protected] if [char] * else bl then emit  \ 7 u.r
    loop
  loop
  2drop decimal ;

4 3 bitmap value test
red test bfill
test bshow cr


Screenres 320, 240, 8
Dim Shared As Integer w, h
Screeninfo w, h
Const As Ubyte cyan    = 3
Const As Ubyte red     = 4

Sub rellenar(c As Integer)
    Line (0,0) - (w/3, h/3), red, BF
End Sub

Sub establecePixel(x As Integer, y As Integer, c As Integer)
    Pset (x,y), cyan
End Sub

rellenar(12)
establecePixel(10,10, cyan)
Locate 12
Print "pixel 10,10 es " & Point(10,10)
Print "pixel 20,20 es " & Point(20,10)

Bsave "FreeBASIC_bitmap.bmp", 0
Sleep


package main

import (
	"bytes"
	"fmt"
	"image"
	"image/color"
	"image/draw"
	"image/png"
)

func main() {
	// A rectangle from 0,0 to 300,240.
	r := image.Rect(0, 0, 300, 240)

	// Create an image
	im := image.NewNRGBA(r)

	// set some color variables for convience
	var (
		red  = color.RGBA{0xff, 0x00, 0x00, 0xff}
		blue = color.RGBA{0x00, 0x00, 0xff, 0xff}
	)

	// Fill with a uniform color
	draw.Draw(im, r, &image.Uniform{red}, image.ZP, draw.Src)

	// Set individual pixels
	im.Set(10, 20, blue)
	im.Set(20, 30, color.Black)
	im.Set(30, 40, color.RGBA{0x10, 0x20, 0x30, 0xff})

	// Get the values of specific pixels as color.Color types.
	// The color will be in the color.Model of the image (in this
	// case color.NRGBA) but color models can convert their values
	// to other models.
	c1 := im.At(0, 0)
	c2 := im.At(10, 20)

	// or directly as RGB components (scaled values)
	redc, greenc, bluec, _ := c1.RGBA()
	redc, greenc, bluec, _ = im.At(30, 40).RGBA()

	// Images can be read and writen in various formats
	var buf bytes.Buffer
	err := png.Encode(&buf, im)
	if err != nil {
		fmt.Println(err)
	}

	fmt.Println("Image size:", im.Bounds().Dx(), "×", im.Bounds().Dy())
	fmt.Println(buf.Len(), "bytes when encoded as PNG.")
	fmt.Printf("Pixel at %7v is %v\n", image.Pt(0, 0), c1)
	fmt.Printf("Pixel at %7v is %#v\n", image.Pt(10, 20), c2) // %#v shows type details
	fmt.Printf("Pixel at %7v has R=%d, G=%d, B=%d\n",
		image.Pt(30, 40), redc, greenc, bluec)
}


module Bitmap(module Bitmap) where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST

newtype Pixel = Pixel (Int, Int) deriving Eq

instance Ord Pixel where
    compare (Pixel (x1, y1)) (Pixel (x2, y2)) =
        case compare y1 y2 of
            EQ -> compare x1 x2
            v  -> v

instance Ix Pixel where
{- This instance differs from the one for (Int, Int) in that
the ordering of indices is
  (0,0), (1,0), (2,0), (0,1), (1,1), (2,1)
instead of
  (0,0), (0,1), (1,0), (1,1), (2,0), (2,1). -}
    range (Pixel (xa, ya), Pixel (xz, yz)) =
        [Pixel (x, y) | y <- [ya .. yz], x <- [xa .. xz]]
    index (Pixel (xa, ya), Pixel (xz, _)) (Pixel (xi, yi)) =
        (yi - ya)*(xz - xa + 1) + (xi - xa)
    inRange (Pixel (xa, ya), Pixel (xz, yz)) (Pixel (xi, yi)) =
        not $ xi < xa || xi > xz || yi < ya || yi > yz
    rangeSize (Pixel (xa, ya), Pixel (xz, yz)) =
        (xz - xa + 1) * (yz - ya + 1)

instance Show Pixel where
    show (Pixel p) = show p

class Ord c => Color c where
    luminance :: c -> Int
     -- The Int should be in the range [0 .. 255].
    black, white :: c
    toNetpbm :: [c] -> String
    fromNetpbm :: [Int] -> [c]
    netpbmMagicNumber, netpbmMaxval :: c -> String
      {- The argument to these two functions is ignored; the
      parameter is only for typechecking. -}

newtype Color c => Image s c = Image (STArray s Pixel c)

image :: Color c => Int -> Int -> c -> ST s (Image s c)
{- Creates a new image with the given width and height, filled
with the given color. -}
image w h = liftM Image .
    newArray (Pixel (0, 0), Pixel (w - 1, h - 1))

listImage :: Color c => Int -> Int -> [c] -> ST s (Image s c)
{- Creates a new image with the given width and height, with
each pixel set to the corresponding element of the given list. -}
listImage w h = liftM Image .
    newListArray (Pixel (0, 0), Pixel (w - 1, h - 1))

dimensions :: Color c => Image s c -> ST s (Int, Int)
dimensions (Image i) = do
    (_, Pixel (x, y)) <- getBounds i
    return (x + 1, y + 1)

getPix :: Color c => Image s c -> Pixel -> ST s c
getPix (Image i) = readArray i

getPixels :: Color c => Image s c -> ST s [c]
getPixels (Image i) = getElems i

setPix :: Color c => Image s c -> Pixel -> c -> ST s ()
setPix (Image i) = writeArray i

fill :: Color c => Image s c -> c -> ST s ()
fill (Image i) c = getBounds i >>= mapM_ f . range
  where f p = writeArray i p c

mapImage :: (Color c, Color c') =>
    (c -> c') -> Image s c -> ST s (Image s c')
mapImage f (Image i) = liftM Image $ mapArray f i


procedure makebitmap(width,height)
   return open("bitmap", "g", "canvas=hidden",
             "size="||width||","||height)
end
procedure fillimage(w,color)
   Fg(w,color)
   FillRectangle(w)
end
procedure setpixel(w,x,y,color)
   Fg(w,color)
   DrawPixel(x,y)
end
procedure getpixel(w,x,y)
   return Pixel(w,x,y)
end


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

public class BasicBitmapStorage {

    private final BufferedImage image;

    public BasicBitmapStorage(int width, int height) {
        image = new BufferedImage(width, height, BufferedImage.TYPE_INT_RGB);
    }

    public void fill(Color c) {
        Graphics g = image.getGraphics();
        g.setColor(c);
        g.fillRect(0, 0, image.getWidth(), image.getHeight());
    }

    public void setPixel(int x, int y, Color c) {
        image.setRGB(x, y, c.getRGB());
    }

    public Color getPixel(int x, int y) {
        return new Color(image.getRGB(x, y));
    }

    public Image getImage() {
        return image;
    }
}


// Set up the canvas
var canvas = document.createElement("canvas"),
    ctx = canvas.getContext("2d"),
    width = 400, height = 400;

ctx.canvas.width = width;
ctx.canvas.height = height;

// Optionaly add it to the current page
document.body.appendChild(canvas);

// Draw an image
var img = document.createElement("img");
img.onload = function(){
    // Draw the element into the top-left of the canvas
    ctx.drawImage(img, 0, 0);
};
img.src = "//placehold.it/400x400";

// Fill the canvas with a solid blue color
ctx.fillStyle = "blue";
ctx.fillRect(0, 0, width, height);

// Place a black pixel in the middle
// Note that a pixel is a 1 by 1 rectangle
// This is the fastest method as of 2012 benchmarks
ctx.fillStyle = "black";
ctx.fillRect(width / 2, height / 2, 1, 1);


using Images, Colors

Base.hex(p::RGB{T}) where T = join(hex(c(p), 2) for c in (red, green, blue))
function showhex(m::Matrix{RGB{T}}, pad::Integer=4) where T
    for r in 1:size(m, 1)
        println(" " ^ pad, join(hex.(m[r, :]), " "))
    end
end

w, h = 5, 7
cback = RGB(1, 0, 1)
cfore = RGB(0, 1, 0)

img = Array{RGB{N0f8}}(h, w);
println("Uninitialized image:")
showhex(img)

fill!(img, cback)
println("\nImage filled with background color:")
showhex(img)

img[2, 3] = cfore
println("\nImage with a pixel set for foreground color:")
showhex(img)


function main() {
  Var:Number shape;

  Image:New(50, 50, shape)
  Draw:RectFill(0, 0, 50, 50, 0xFF0000, shape)  //one to fill an image with a plain RED color

  Draw:Pixel(30, 30, 0x0000FF, shape)           //set a given pixel at (30,30) with a BLUE color

  while (B1 == false) {
    Image:Blit(10, 10, shape, screen)
    Screen:Render()
  }
}


// version 1.1.4-3

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>) {
    val width = 640
    val height = 480
    val bbs = BasicBitmapStorage(width, height)
    with (bbs) {
        fill(Color.cyan)
        setPixel(width / 2, height / 2, Color.black)
        val c1 = getPixel(width / 2, height / 2)
        val c2 = getPixel(20, 20)
        print("The color of the pixel at (${width / 2}, ${height / 2}) is ")
        println(if (c1 == Color.black) "black" else "unknown")
        print("The color of the pixel at (120, 120) is ")
        println(if (c2 == Color.cyan) "cyan" else "unknown")
    }
}


-- Creates a new image object of size 640x480 pixel and 32-bit color depth
img = image(640, 480, 32)

-- Fills image with plain red
img.fill(img.rect, rgb(255,0,0))

-- Gets the color value of the pixel at point (320, 240)
col = img.getPixel(320, 240)

-- Changes the color of the pixel at point (320, 240) to black
img.setPixel(320, 240, rgb(0,0,0))


   -- create an image container box at the center of the current stack window with default properties
   create image "test"
   -- programtically choose the paint bucket tool
   choose bucket tool
   -- LiveCode engine has built-in color keywords:
   set the brushColor to "dark green"
   -- programtically mouse click at the center of image container box to fill
   click at the loc of image "test"
   -- get the RGBA values of the first pixel in the image box
   put byteToNum(byte 1 of the imageData of image "test") into tRed
   put byteToNum(byte 2 of the imageData of image "test") into tGreen
   put byteToNum(byte 3 of the imageData of image "test") into tBlue
   put byteToNum(byte 4 of the imageData of image "test") into tAlpha
   -- log message the info in the message box
   put "First Pixel Color is Red:"& tRed &" Green:"& tGreen &" Blue:"& tBlue &" Transparency:"& tAlpha
   -- just for fun replace the contents with RosettaCode logo
   wait 2 seconds
   set the filename of image "test" to "http://rosettacode.org/mw/title.png"
    -- the next line is copy of the Write a PPM task:
   export image "test" to file "~/Test.PPM" as paint -- paint format is one of PBM, PGM, or PPM


function Allocate_Bitmap( width, height )
    local bitmap = {}
    for i = 1, width do
        bitmap[i] = {}
        for j = 1, height do
            bitmap[i][j] = {}
        end
    end
    return bitmap
end

function Fill_Bitmap( bitmap, color )
    for i = 1, #bitmap do
        for j = 1, #bitmap[1] do
            bitmap[i][j] = color
        end
    end
end

function Get_Pixel( bitmap, x, y )
    return bitmap[x][y]
end


\ Bitmap width in pixels, height in pixels
\ Return a group object with some lambda as members: SetPixel, GetPixel, Image$
\ copyimage
\ using Copy x, y Use Image$ we can display image$ to x, y  as twips
\ we can use  x*twipsx, y*twipsy  for x,y as  pixels
Function Bitmap (x as long, y as long) {
      if x<1 or y<1 then  Error "Wrong dimensions"
      structure rgb {
            red as byte
            green as byte
            blue as byte
      }
      m=len(rgb)*x mod 4
      if m>0 then m=4-m  ' add some bytes to raster line
      m+=len(rgb) *x
      Structure rasterline {
            {
                  pad as byte*m
            }
            \\ union pad+hline
            hline as rgb*x
      }

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

      }
      GetPixel=Lambda Image1,aLines=Len(Raster)-Len(Rasterline), blines=-Len(Rasterline) (x,y) ->{
            where=alines+3*x+blines*y
            =color(Eval(image1, where+2 as byte), Eval(image1, where+1 as byte), Eval(image1, where as byte))
      }
      StrDib$=Lambda$ Image1, Raster -> {
            =Eval$(Image1, 0, Len(Raster))
      }
      CopyImage=Lambda Image1 (image$) -> {
            if left$(image$,12)=Eval$(Image1, 0, 24 ) Then  {
                   Return Image1, 0:=Image$
            } Else Error "Can't Copy Image"
      }
      Group Bitmap {
            SetPixel=SetPixel
            GetPixel=GetPixel
            Image$=StrDib$
            Copy=CopyImage
      }
      =Bitmap
}
A=Bitmap(100,100)
Call A.SetPixel(50,50, color(128,0,255))
Print A.GetPixel(50,50)=color(128,0,255)
\\ display image to screen at 100, 50 pixel
copy 100*twipsx,50*twipsy use A.Image$()
A1=Bitmap(100,100)
Call A1.copy(A.Image$())
copy 500*twipsx,50*twipsy use A1.Image$()


allocateImg := proc(width, height)
	return Array(1..width, 1..height, 1..3);
end proc:
fillColor := proc(img, rgb::list)
	local i;
	for i from 1 to 3 do
		img[..,..,i] := map(x->rgb[i], img[..,..,i]):
	end do:
end proc:
setColor := proc(x, y, img, rgb::list)
	local i:
	for i from 1 to 3 do
		img[x,y,i] := rgb[i]:
	end do:
end proc:
getColor := proc(x,y,img)
	local rgb,i:
	rgb := Array(1..3):
	for i from 1 to 3 do
		rgb(i) := img[x,y,i]:
	end do:
	return rgb:
end proc:


%Bitmap class
%
%Implements a class to manage bitmap images without the need for the
%various conversion and display functions
%
%Available functions:
%
%fill(obj,color)
%setPixel(obj,pixel,color)
%getPixel(obj,pixel,[optional: color channel])
%display(obj)
%disp(obj)
%plot(obj)
%image(obj)
%save(obj)
%open(obj)

classdef Bitmap

    %% Public Properties
    properties

        %Channel arrays
        red;
        green;
        blue;

    end

    %% Public Methods
    methods

        %Creates image and defaults it to black
        function obj = Bitmap(width,height)
            obj.red   = zeros(height,width,'uint8');
            obj.green = zeros(height,width,'uint8');
            obj.blue  = zeros(height,width,'uint8');
        end % End Bitmap Constructor

        %Fill the image with a specified color
        %color = [red green blue] max for each is 255
        function fill(obj,color)
            obj.red(:,:)   = color(1);
            obj.green(:,:) = color(2);
            obj.blue(:,:)  = color(3);
            assignin('caller',inputname(1),obj); %saves the changes to the object
        end

        %Set a pixel to a specified color
        %pixel = [x y]
        %color = [red green blue]
        function setPixel(obj,pixel,color)
            obj.red(pixel(2),pixel(1))   = color(1);
            obj.green(pixel(2),pixel(1)) = color(2);
            obj.blue(pixel(2),pixel(1))  = color(3);
            assignin('caller',inputname(1),obj); %saves the changes to the object
        end

        %Get pixel color
        %pixel = [x y]
        %varargin can be:
        %  no input for all channels
        %  'r' or 'red' for red channel
        %  'g' or 'green' for green channel
        %  'b' or 'blue' for blue channel
        function color = getPixel(obj,pixel,varargin)

            if( ~isempty(varargin) )
                switch (varargin{1})
                    case {'r','red'}
                        color = obj.red(pixel(2),pixel(1));
                    case {'g','green'}
                        color = obj.red(pixel(2),pixel(1));
                    case {'b','blue'}
                        color = obj.red(pixel(2),pixel(1));
                end
            else
                color = [obj.red(pixel(2),pixel(1)) obj.green(pixel(2),pixel(1)) obj.blue(pixel(2),pixel(1))];
            end

        end

        %Display the image
        %varargin can be:
        %  no input for all channels
        %  'r' or 'red' for red channel
        %  'g' or 'green' for green channel
        %  'b' or 'blue' for blue channel
        function display(obj,varargin)

            if( ~isempty(varargin) )
                switch (varargin{1})
                    case {'r','red'}
                        image(obj.red)
                    case {'g','green'}
                        image(obj.green)
                    case {'b','blue'}
                        image(obj.blue)
                end

                colormap bone;
            else
                bitmap = cat(3,obj.red,obj.green,obj.blue);
                image(bitmap);
            end
        end

        %Overload several commonly used display functions
        function disp(obj,varargin)
            display(obj,varargin{:});
        end

        function plot(obj,varargin)
            display(obj,varargin{:});
        end

        function image(obj,varargin)
            display(obj,varargin{:});
        end

        %Saves the image
        function save(obj)

            %Open file dialogue
            [fileName,pathName,success] = uiputfile({'*.bmp','Bitmap Image (*.bmp)'},'Save Bitmap As');

            if( not(success == 0) )
                imwrite(cat(3,obj.red,obj.green,obj.blue),[pathName fileName],'bmp'); %Write image file to disk
                disp('Save Complete');
            end
        end

        %Opens an image and overwrites what is currently stored
        function success = open(obj)

            %Open file dialogue
            [fileName,pathName,success] = uigetfile({'*.bmp','Bitmap Image (*.bmp)'},'Open Bitmap ');

            if( not(success == 0) )

                channels = imread([pathName fileName], 'bmp'); %returns color indexed data

                %Store each channel
                obj.red   = channels(:,:,1);
                obj.green = channels(:,:,2);
                obj.blue  = channels(:,:,3);

                assignin('caller',inputname(1),obj); %saves the changes to the object
                success = true;
                return
            else
                success = false;
                return
            end
        end

    end %methods
end %classdef


INTERFACE Bitmap;

TYPE UByte = BITS 8 FOR [0 .. 16_FF];
     Pixel = RECORD R, G, B: UByte; END;
     Point = RECORD x, y: UByte; END;
     T = REF ARRAY OF ARRAY OF Pixel;

CONST
  Black = Pixel{0, 0, 0};
  White = Pixel{255, 255, 255};
  Red = Pixel{255, 0, 0};
  Green = Pixel{0, 255, 0};
  Blue = Pixel{0, 0, 255};
  Yellow = Pixel{255, 255, 0};

EXCEPTION BadImage;
          BadColor;

PROCEDURE NewImage(height, width: UByte): T RAISES {BadImage};
PROCEDURE Fill(VAR pic: T; color: Pixel);
PROCEDURE GetPixel(VAR pic: T; point: Point): Pixel RAISES {BadColor};
PROCEDURE SetPixel(VAR pic: T; point: Point; color: Pixel);

END Bitmap.


type
  Luminance* = uint8
  Index* = int

  Color* = tuple
    r, g, b: Luminance

  Image* = ref object
    w*, h*: Index
    pixels*: seq[Color]

  Point* = tuple
    x, y: Index

proc color*(r, g, b: SomeInteger): Color =
  ## Build a color value from R, G and B values.
  result.r = r.uint8
  result.g = g.uint8
  result.b = b.uint8

const
  Black* = color(  0,   0,   0)
  White* = color(255, 255, 255)

proc newImage*(width, height: int): Image =
  ## Create an image with given width and height.
  new(result)
  result.w = width
  result.h = height
  result.pixels.setLen(width * height)

iterator indices*(img: Image): Point =
  ## Yield the pixels coordinates as tuples.
  for y in 0 ..< img.h:
    for x in 0 ..< img.w:
      yield (x, y)

proc `[]`*(img: Image; x, y: int): Color =
  ## Get a pixel RGB value.
  img.pixels[y * img.w + x]

proc `[]=`*(img: Image; x, y: int; c: Color) =
  ## Set a pixel RGB value to given color.
  img.pixels[y * img.w + x] = c

proc fill*(img: Image; color: Color) =
  ## Fill the image with a color.
  for x, y in img.indices:
    img[x, y] = color

proc print*(img: Image) =
  ## Output an ASCII representation of the image.
  for x, y in img.indices:
    if x mod img.w == 0:
      stdout.write '\n'
    stdout.write if img[x, y] == White: '.' else: 'H'
  stdout.write '\n'

when isMainModule:
  var img = newImage(100, 20)
  img.fill color(255, 255, 255)
  img[1, 2] = color(255, 0, 0)
  img[3, 4] = img[1, 2]
  img.print


let new_img ~width ~height =
  let all_channels =
    let kind = Bigarray.int8_unsigned
    and layout = Bigarray.c_layout
    in
    Bigarray.Array3.create kind layout 3 width height
  in
  let r_channel = Bigarray.Array3.slice_left_2 all_channels 0
  and g_channel = Bigarray.Array3.slice_left_2 all_channels 1
  and b_channel = Bigarray.Array3.slice_left_2 all_channels 2
  in
  (all_channels,
   r_channel,
   g_channel,
   b_channel)


im = zeros(W, H, 3, "uint8"); % create an RGB image of width W and height H
                              % and intensity from 0 to 255; black (all zeros)
im(:,:,1) = 255;              % set R to 255
im(:,:,2) = 100;              % set G to 100
im(:,:,3) = 155;              % set B to 155
im(floor(W/2), floor(H/2), :) = 0;  % pixel in the center made black
disp(im(floor(W/3), floor(H/3), :)) % display intensities of the pixel
                                    % at W/3, H/3
p = im(40,40,:); % or just store it in the vector p, so that
                 % p(1) is R, p(2) G and p(3) is B


'GENERIC BITMAP

type pixel byte r,g,b

'===========
class BitMap
'===========

% sp   sizeof(pixel)
sys    wx,wy,px,py
string buf
sys    pb
method Constructor(sys x=640,y=480) { wx=x : wy=y : buf=nuls x*y*sp : pb=strptr buf}
method Destructor()                 {buf="" : wx=0 : wy=0 : pb=0}
method GetPixel(sys x,y,pixel*p)    {copy @p,pb+(y*wx+x)*sp,sp}
method SetPixel(sys x,y,pixel*p)    {copy pb+(y*wx+x)*sp,@p,sp}
'
method Fill(pixel*p)
  sys i, e=wx*wy*sp+pb-1
  for i=pb to e step sp {copy i,@p,sp}
end method

end class

pixel p,q

new BitMap m(400,400) 'width, height in pixels

p<=100,120,140 'red,green,blue

m.fill p

m.getPixel 200,100,q
print "" q.r "," q.g "," q.b 'result 100,120,140
q<=10,20,40
m.setPixel 200,100,q
m.getPixel 200,100,p
print "" p.r "," p.g "," p.b 'result 10,20,40

del m


functor
export
   New
   Get
   Set
   Transform
define
   fun {New Width Height Init}
      C = {Array.new 1 Height unit}
   in
      for Row in 1..Height do
	 C.Row := {Array.new 1 Width Init}
      end

      array2d(width:Width
	      height:Height
	      contents:C)
   end

   fun {Get array2d(contents:C ...) X Y}
      C.Y.X
   end

   proc {Set array2d(contents:C ...) X Y Val}
      C.Y.X := Val
   end

   proc {Transform array2d(contents:C width:W height:H ...) Fun}
      for Y in 1..H do
	 for X in 1..W do
	    C.Y.X := {Fun C.Y.X}
	 end
      end
   end

   %% omitted: Clone, Map, Fold, ForAll
end


Interface
uses  crt,   { GetDir }
      graph; { function GetPixel }

type { integer numbers }
  { from unit bitmaps XPERT software production Tamer Fakhoury }
  _bit     = $00000000..$00000001; {number 1 bit   without sign = (0..1) }
  _byte    = $00000000..$000000FF; {number 1 byte  without sign = (0..255)}
  _word    = $00000000..$0000FFFF; {number 2 bytes without sign = (0..65 535)}
  _dWord   = $00000000..$7FFFFFFF; {number 4 bytes without sign = (0..4 294 967 296)}
  _longInt = $80000000..$7FFFFFFF; {number 4 bytes with sign
                                    = (-2 147 483 648..2 147 483 648}

  TbmpFileHeader =
  record
    ID: _word;             { Must be 'BM' =19778=$424D for windows }
    FileSize: _dWord;      { Size of this file in bytes }
    Reserved: _dWord;      { ??? }
    bmpDataOffset: _dword; { = 54 = $36 from begining of file to begining of bmp data }
  end;

  TbmpInfoHeader =
  record
    InfoHeaderSize: _dword;      { Size of Info header
                                   = 28h = 40 (decimal)
                                   for windows }
    Width,
    Height: _longInt;    { Width and Height of image in pixels }
    Planes,              { number of planes of bitmap }
    BitsPerPixel: _word; { Bits can be 1, 4, 8, 24 or 32 }
    Compression,
    bmpDataSize: _dword;    { in bytes rounded to the next 4 byte boundary }
    XPixPerMeter,           { horizontal resolution in pixels }
    YPixPerMeter: _longInt; { vertical }
    NumbColorsUsed,
    NumbImportantColors: _dword;   {= NumbColorUsed}
  end; { TbmpHeader = Record ... }

  T32Color =
  record { 4 byte = 32 bit }
    Blue:  byte;
    Green: byte;
    Red:   byte;
    Alfa:  byte
  end;

var directory,
    bmpFileName:    string;
    bmpFile:        file; { untyped file }
    bmpFileHeader:  TbmpFileHeader;
    bmpInfoHeader:  TbmpInfoHeader;
    color32:        T32Color;
    RowSizeInBytes: integer;
    BytesPerPixel:  integer;

const defaultBmpFileName = 'test';
      DefaultDirectory   = 'c:\bp\';
      DefaultExtension   = '.bmp';
      bmpFileHeaderSize  = 14;
      { compression specyfication }
      bi_RGB             = 0;  { compression }
      bi_RLE8            = 1;
      bi_RLE4            = 2;
      bi_BITFIELDS       = 3;

      bmp_OK          = 0;
      bmp_NotBMP      = 1;
      bmp_OpenError   = 2;
      bmp_ReadError   = 3;

Procedure CreateBmpFile32(directory: string; FileName: string;
                           iWidth, iHeight: _LongInt);

{************************************************}
Implementation  {-----------------------------}
{************************************************}

Procedure CreateBmpFile32(directory: string; FileName: string;
                           iWidth, iHeight: _LongInt);
  var
    x, y: integer;
  begin
    if directory = '' then
      GetDir(0, directory);
    if FileName = '' then
      FileName: = DefaultBmpFileName;
    { create a new file on a disk in a given directory with given name }
    Assign(bmpFile, directory + FileName + DefaultExtension);
    ReWrite(bmpFile, 1);

    { fill the headers }
    with bmpInfoHeader, bmpFileHeader do
    begin
      ID := 19778;
      InfoheaderSize := 40;
      width := iWidth;
      height := iHeight;
      BitsPerPixel := 32;
      BytesPerPixel := BitsPerPixel div 8;
      reserved := 0;
      bmpDataOffset := InfoHeaderSize + bmpFileHeaderSize;
      planes := 1;
      compression := bi_RGB;
      XPixPerMeter := 0;
      YPixPerMeter := 0;
      NumbColorsUsed := 0;
      NumbImportantColors := 0;

      RowSizeInBytes := (Width * BytesPerPixel); { only for >=8 bits per pixel }
      bmpDataSize := height * RowSizeinBytes;
      FileSize := InfoHeaderSize + bmpFileHeaderSize + bmpDataSize;

      { copy headers to disk file }
      BlockWrite(bmpFile, bmpFileHeader, bmpFileHeaderSize);
      BlockWrite(bmpFile, bmpInfoHeader, infoHeaderSize);

      { fill the pixel data area }
      for y := (height - 1) downto 0  do
      begin
	for x := 0 to (width - 1) do
	begin { Pixel(x,y) }
	  color32.Blue  := 255;
	  color32.Green := 0;
	  color32.Red   := 0;
	  color32.Alfa  := 0;
	  BlockWrite(bmpFile, color32, 4);
	end; { for x ... }
      end; { for y ... }
      Close(bmpFile);
    end; { with bmpInfoHeader, bmpFileHeader }
   end; { procedure }


#! /usr/bin/perl

use strict;

use Image::Imlib2;

# create the "canvas"
my $img = Image::Imlib2->new(200,200);

# fill with a plain RGB(A) color
$img->set_color(255, 0, 0, 255);
$img->fill_rectangle(0,0, 200, 200);

# set a pixel to green (at 40,40)
$img->set_color(0, 255, 0, 255);
$img->draw_point(40,40);

# "get" pixel rgb(a)
my ($red, $green, $blue, $alpha) = $img->query_pixel(40,40);
undef $img;

# another way of creating a canvas with a bg colour (or from
# an existing "raw" data)
my $col = pack("CCCC", 255, 255, 0, 0); # a, r, g, b
my $img = Image::Imlib2->new_using_data(200, 200, $col x (200 * 200));

exit 0;


with javascript_semantics
-- Some colour constants:
constant black = #000000,
--       blue  = #0000FF,
--       green = #00FF00,
--       red   = #FF0000,
         white = #FFFFFF

-- Create new image filled with some colour
function new_image(integer width, integer height, integer fill_colour=black)
    return repeat(repeat(fill_colour,height),width)
end function

-- Usage example:
sequence image = new_image(800,600)

-- Set pixel color:
image[400][300] = white

-- Get pixel color
integer colour = image[400][300] -- Now colour is #FFFFFF


class Bitmap {
  public $data;
  public $w;
  public $h;
  public function __construct($w = 16, $h = 16){
    $white = array_fill(0, $w, array(255,255,255));
    $this->data = array_fill(0, $h, $white);
    $this->w = $w;
    $this->h = $h;
  }
  //Fills a rectangle, or the whole image with black by default
  public function fill($x = 0, $y = 0, $w = null, $h = null, $color = array(0,0,0)){
    if (is_null($w)) $w = $this->w;
    if (is_null($h)) $h = $this->h;
    $w += $x;
    $h += $y;
    for ($i = $y; $i < $h; $i++){
      for ($j = $x; $j < $w; $j++){
        $this->setPixel($j, $i, $color);
      }
    }
  }
  public function setPixel($x, $y, $color = array(0,0,0)){
    if ($x >= $this->w) return false;
    if ($x < 0) return false;
    if ($y >= $this->h) return false;
    if ($y < 0) return false;
    $this->data[$y][$x] = $color;
  }
  public function getPixel($x, $y){
    return $this->data[$y][$x];
  }
}

$b = new Bitmap(16,16);
$b->fill();
$b->fill(2, 2, 18, 18, array(240,240,240));
$b->setPixel(0, 15, array(255,0,0));
print_r($b->getPixel(3,3)); //(240,240,240)


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

# Fill an image with a given color
(de ppmFill (Ppm R G B)
   (for Y Ppm
      (map
         '((X) (set X (list R G B)))
         Y ) ) )

# Set pixel with a color
(de ppmSetPixel (Ppm X Y R G B)
   (set (nth Ppm Y X) (list R G B)) )

# Get the color of a pixel
(de ppmGetPixel (Ppm X Y)
   (get Ppm Y X) )


/* Declaration for an image, suitable for BMP files. */
declare image(0:500, 0:500) bit (24) aligned;

image = '000000000000000011111111'b;
   /* Sets the entire image to red. */

image(10,40) = '111111110000000000000000'b;
   /* Sets one pixel to blue. */

declare color bit (24) aligned;
color = image(20,50); /* Obtain the color of a pixel */

/* To allocate an image of size (x,y) */
allocate_image: procedure (image, x, y);
   declare image (*, *) controlled bit (24) aligned;
   declare (x, y) fixed binary (31);

   allocate image (0:x, 0:y);
end allocate_image;

/* To use the above procedure, it's necessary to define   */
/* the image in the calling program thus, for BMP images: */

declare image(*,*) controlled bit (24) aligned;


PGraphics bitmap = createGraphics(100,100); // Create the bitmap
bitmap.beginDraw();
bitmap.background(255, 0, 0); // Fill bitmap with red rgb color
bitmap.endDraw();
image(bitmap, 0, 0); // Place bitmap on screen.
color b = color(0, 0, 255); // Define a blue rgb color
set(50, 50, b); // Set blue colored pixel in the middle of the screen
color c = get(50, 50); // Get the color of same pixel
if(b == c) print("Color changed correctly"); // Verify


:- module(bitmap, [
	new_bitmap/3,
	fill_bitmap/3,
	get_pixel0/3,
	set_pixel0/4 ]).

:- use_module(library(lists)).

%-----------------------------------------------------------------------------%
% Convenience Predicates
replicate(Term,Times,L):-
	length(L,Times),
	maplist(=(Term),L).

replace0(N,OL,E,NL):-
	nth0(N,OL,_,TL),
	nth0(N,NL,E,TL).
%-----------------------------------------------------------------------------%
% Bitmap Utilities
%
% The Bitmap structure is a list with pixels kept in row major order:
% [dimensions-[X,Y],pixels-[[n11,n12...],[n21,n22...]]]

% In this code what exactly an RGB value is doesn't matter however
% in other bitmap tasks it is assumed to be a list [R,G,B] where
% each is an int between 0 and 255, in code:
rgb_pixel(RGB):-
	length(RGB,3),
	maplist(integer,RGB),
	maplist(between(0,255),RGB).

%new_bitmap(Bitmap,Dimensions,RGB)
new_bitmap([[X,Y],Pixels],[X,Y],RGB) :-
	replicate(RGB,X,Row),
	replicate(Row,Y,Pixels).

%fill_bitmap(New_Bitmap,Bitmap,RGB)
fill_bitmap(New_Bitmap,[[X,Y],_],RGB) :-
	new_bitmap(New_Bitmap,[X,Y],RGB).

%here get and set use 0 based indexing
%get_pixel0(Bitmap,Coordinates,RGB)
get_pixel0([[_DimX,_DimY],Pixels],[X,Y],RGB) :-
	nth0(Y,Pixels,Row),
	nth0(X,Row,RGB).

%set_pixel0(New Bitmap, Bitmap, Coordinates, RGB)
set_pixel0([[DimX,DimY],New_Pixels],[[DimX,DimY],Pixels],[X,Y],RGB) :-
	nth0(Y,Pixels,Row),
	replace0(X,Row,RGB,New_Row),
	replace0(Y,Pixels,New_Row,New_Pixels).


w=800 : h=600
CreateImage(1,w,h)
;1 is internal id of image
StartDrawing(ImageOutput(1))
; fill with color red
Box(0,0,w,h,$ff)
; or using another (but slower) way in green
FillArea(0,0,-1,$ff00)
; a green Dot
Plot(10,10,$ff0000)
; check if we set it right (should be 255)
Debug Blue(Point(10,10))


#  See the class definitions and constructors with, e.g.
getClass("pixmapIndexed", package=pixmap)
pixmapIndexed

# Image with all one colour
plot(p1 <- pixmapIndexed(matrix(0, nrow=3, ncol=4), col="red"))

# Image with one pixel specified
cols <- rep("blue", 12); cols[7] <- "red"
plot(p2 <- pixmapIndexed(matrix(1:12, nrow=3, ncol=4), col=cols))

# Retrieve colour of a pixel
getcol <- function(pm, i, j)
{
   pmcol <- [email protected]
   dim(pmcol) <- dim([email protected])
   pmcol[i,j]
}
getcol(p2, 3, 4)  #red


#lang racket

;; The racket/draw libraries provide imperative drawing functions.
;; http://docs.racket-lang.org/draw/index.html
(require racket/draw)

;; To create an image with width and height, use the make-bitmap
;; function.

;; For example, let's make a small image here:
(define bm (make-bitmap 640 480))

;; We use a drawing context handle, a "dc", to operate on the bitmap.
(define dc (send bm make-dc))

;; We can fill the bitmap with a color by using a combination of
;; setting the background, and clearing.
(send dc set-background (make-object color% 0 0 0)) ;; Color it black.
(send dc clear)

;; Let's set a few pixels to a greenish color with set-pixel:
(define aquamarine (send the-color-database find-color "aquamarine"))
(for ([i 480])
  (send dc set-pixel i i aquamarine))

;; We can get at the color of a bitmap pixel by using the get-pixel
;; method.  However, it may be faster to use get-argb-pixels if we
;; need a block of the pixels.  Let's use get-argb-pixels and look
;; at a row starting at (0, 42)
(define buffer (make-bytes (* 480 4)))  ;; alpha, red, green, blue
(send dc get-argb-pixels 0 42 480 1 buffer)

;; We can inspect the buffer
(bytes-ref buffer 0) ;;  and see that the first pixel's alpha is 255,
(bytes-ref buffer 1) ;;  and the red, green, and blue components are 0.
(bytes-ref buffer 2)
(bytes-ref buffer 3)

;; If we are using DrRacket, we can just print the bm as a toplevel expression
;; to view the final image:
bm


class Pixel { has UInt ($.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 + $j * $!width] }

    method set-pixel ($i, $j, Pixel $p) {
	self.pixel($i, $j) = $p.clone;
    }
    method get-pixel ($i, $j) returns Pixel {
	self.pixel($i, $j);
    }
}

my Bitmap $b = Bitmap.new( width => 10, height => 10);

$b.fill( Pixel.new( R => 0, G => 0, B => 200) );

$b.set-pixel( 7, 5, Pixel.new( R => 100, G => 200, B => 0) );

say $b.perl;


DECLARE SUB PaintCanvas

CREATE form AS QForm
    Width  = 640
    Height = 480
    CREATE canvas AS QCanvas
        Height  = form.ClientHeight
	Width   = form.ClientWidth
	OnPaint = PaintCanvas
    END CREATE
END CREATE

SUB PaintCanvas
    ' Fill background
    canvas.FillRect(0, 0, canvas.Width, canvas.Height, &H301000)

    ' Draw a pixel
    canvas.Pset(300, 200, &H00ddff)

    ' Read pixel color
    PRINT canvas.Pixel(300, 200)
END SUB

form.ShowModal


/*REXX program demonstrates how to process/display a simple  RGB  raster graphics image.*/
red   = 'ff 00 00'x                              /*a method to define a   red   value.  */
blue  = '00 00 ff'x                              /*"    "    "    "   "   blue    "     */
@.    =                                          /*define entire  @.  array  to  nulls. */
outFN = 'image'                                  /*the filename of the output image PPM */
sWidth = 500;     sHeight= 500                   /*the screen width and height in pixels*/
call RGBfill      red                            /*set the entire   image   to red.     */
            x= 10;       y= 40                   /*set pixel's coördinates.             */
call RGBset x, y, blue                           /*set a pixel (at  10,40)  to blue.    */
color = RGBget(x, y)                             /*get the color of a pixel.            */
hexV  = c2x(color)                               /*get hex    value of pixel's color.   */
binV  = x2b(hexV)                                /* "  binary   "    "    "      "      */
bin3V = left(binV, 8)    substr(binV, 9, 8)    right(binV, 8)
hex3V = left(hexV, 2)    substr(hexV, 3, 2)    right(hexV, 2)
xy= '(' || x","y')'                              /*create a handy─dandy literal for SAY.*/
say  xy    ' pixel in binary: '     binV         /*show the binary value of  20,50      */
say  xy    ' pixel in binary: '     bin3V        /*show again, but with spaces.         */
say                                              /*show a blank between binary and hex. */
say  xy    ' pixel in hex:    '     hexV         /*show again, but in hexadecimal.      */
say  xy    ' pixel in hex:    '     hex3V        /*show again, but with spaces.         */
call PPMwrite outFN, sWidth, sHeight             /*create a PPM (output) file of image. */      /* ◄■■■■■■■■ not part of this task.*/
say                                              /*show a blank.                        */
say 'The file ' outFN".PPM  was created."        /*inform user that a file was created. */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
RGBfill:  @.=arg(1);                          return          /*fill image with a color.*/
RGBget:   parse arg px,py;                    return @.px.py  /*get a pixel's color.    */
RGBset:   parse arg px,py,p$;  @.px.py=p$;    return          /*set "    "      "       */
/*──────────────────────────────────────────────────────────────────────────────────────*/
PPMwrite: parse arg oFN, width, height           /*obtain output filename, width, height*/
          oFID= oFN'.PPM';   $='9'x;   #=255     /*fileID;  separator;  max color value.*/
          call charout oFID, ,  1                /*set the position of the file's output*/
          call charout oFID,'P6'width || $ || height || $ || # || $    /*write hdr info.*/
            do   j=1  for width
              do k=1  for height;     call charout oFID, @.j.k
              end   /*k*/                        /*  ↑          write the PPM file, ··· */
            end     /*j*/                        /*  └───────── ··· one pixel at a time.*/
          call charout oFID;      return         /*close the output file just to be safe*/


class RGBColour
  def initialize(red, green, blue)
    unless red.between?(0,255) and green.between?(0,255) and blue.between?(0,255)
      raise ArgumentError, "invalid RGB parameters: #{[red, green, blue].inspect}"
    end
    @red, @green, @blue = red, green, blue
  end
  attr_reader :red, :green, :blue
  alias_method :r, :red
  alias_method :g, :green
  alias_method :b, :blue

  RED   = RGBColour.new(255,0,0)
  GREEN = RGBColour.new(0,255,0)
  BLUE  = RGBColour.new(0,0,255)
  BLACK = RGBColour.new(0,0,0)
  WHITE = RGBColour.new(255,255,255)
end

class Pixmap
  def initialize(width, height)
    @width = width
    @height = height
    @data = fill(RGBColour::WHITE)
  end
  attr_reader :width, :height

  def fill(colour)
    @data = Array.new(@width) {Array.new(@height, colour)}
  end

  def validate_pixel(x,y)
    unless x.between?(0, @width-1) and y.between?(0, @height-1)
      raise ArgumentError, "requested pixel (#{x}, #{y}) is outside dimensions of this bitmap"
    end
  end

  def [](x,y)
    validate_pixel(x,y)
    @data[x][y]
  end
  alias_method :get_pixel, :[]

  def []=(x,y,colour)
    validate_pixel(x,y)
    @data[x][y] = colour
  end
  alias_method :set_pixel, :[]=
end


#[derive(Copy, Clone, Debug, PartialEq, Eq)]
pub struct Rgb {
    pub r: u8,
    pub g: u8,
    pub b: u8,
}

impl Rgb {
    pub fn new(r: u8, g: u8, b: u8) -> Self {
        Rgb { r, g, b }
    }

    pub const BLACK: Rgb = Rgb { r: 0, g: 0, b: 0 };
    pub const RED: Rgb = Rgb { r: 255, g: 0, b: 0 };
    pub const GREEN: Rgb = Rgb { r: 0, g: 255, b: 0 };
    pub const BLUE: Rgb = Rgb { r: 0, g: 0, b: 255 };
}

#[derive(Clone, Debug)]
pub struct Image {
    width: usize,
    height: usize,
    pixels: Vec<Rgb>,
}

impl Image {
    pub fn new(width: usize, height: usize) -> Self {
        Image {
            width,
            height,
            pixels: vec![Rgb::BLACK; width * height],
        }
    }

    pub fn width(&self) -> usize {
        self.width
    }

    pub fn height(&self) -> usize {
        self.height
    }

    pub fn fill(&mut self, color: Rgb) {
        for pixel in &mut self.pixels {
            *pixel = color;
        }
    }

    pub fn get(&self, row: usize, col: usize) -> Option<&Rgb> {
        if row >= self.width {
            return None;
        }
        self.pixels.get(row * self.width + col)
    }

    pub fn get_mut(&mut self, row: usize, col: usize) -> Option<&mut Rgb> {
        if row >= self.width {
            return None;
        }
        self.pixels.get_mut(row * self.width + col)
    }
}

fn main() {
    let mut image = Image::new(16, 9);
    assert_eq!(Some(&Rgb::BLACK), image.get(3, 4));
    assert!(image.get(22, 3).is_none());

    image.fill(Rgb::RED);
    assert_eq!(Some(&Rgb::RED), image.get(3, 4));

    if let Some(pixel) = image.get_mut(3, 4) {
        *pixel = Rgb::GREEN;
    }
    assert_eq!(Some(&Rgb::GREEN), image.get(3, 4));

    if let Some(pixel) = image.get_mut(3, 4) {
        pixel.g -= 100;
        pixel.b = 20;
    }
    assert_eq!(Some(&Rgb::new(0, 155, 20)), image.get(3, 4));
}


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

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

   def fill(c:Color)={
      val g=image.getGraphics()
      g.setColor(c)
      g.fillRect(0, 0, width, height)
   }

   def setPixel(x:Int, y:Int, c:Color)=image.setRGB(x, y, c.getRGB())
   def getPixel(x:Int, y:Int)=new Color(image.getRGB(x, y))
}


(define (make-list length object)
  (if (= length 0)
      (list)
      (cons object (make-list (- length 1) object))))

(define (list-fill! list object)
  (if (not (null? list))
      (begin (set-car! list object) (list-fill! (cdr list) object))))

(define (list-set! list element object)
  (if (= element 1)
      (set-car! list object)
      (list-set! (cdr list) (- element 1) object)))

(define (list-get list element)
  (if (= element 1)
      (car list)
      (list-get (cdr list) (- element 1))))


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

const proc: main is func
  local
    var PRIMITIVE_WINDOW: myPixmap is PRIMITIVE_WINDOW.value;
    var color: myColor is black;
  begin
    myPixmap := newPixmap(300, 200);
    clear(myPixmap, light_green);
    point(myPixmap, 20, 30, color(256, 512, 768));
    myColor := getPixelColor(myPixmap, 20, 30);
    writeln(myColor.redLight <& " " <& myColor.greenLight <& " " <& myColor.blueLight);
  end func;


RGB ::= (R: int(0), G: int(0), B: int(0));

newBitmap: int * int -> RGB(2);
newBitmap(width, height)[y, x] :=
	 (R: 0, G: 0, B: 0)
	 foreach y within 1 ... height,
	 		 x within 1 ... width;

fill: RGB(2) * RGB -> RGB(2);
fill(bitmap(2), color)[y, x] :=
	color
	foreach y within 1 ... size(bitmap),
			x within 1 ... size(bitmap[y]);

setColorAt: RGB(2) * int * int * RGB -> RGB(2);
setColorAt(bitmap(2), x, y, color)[Y, X] :=
		color when Y = y and X = x
	else
		bitmap[Y, X];

getColorAt: RGB(2) * int * int -> RGB;
getColorAt(bitmap(2), x, y) := bitmap[y, x];

lightGreen := (R: 51, G: 255, B: 51);
lightRed := (R: 255, G: 51, B: 51);

main(args(2)) :=
	let
		width := 1920;
		height := 1200;

		cleanImage := newBitmap(width, height);

		filledGreen := fill(cleanImage, lightGreen);

		redCenter := setColorAt(filledGreen, width / 2, height / 2, lightRed);
	in
		getColorAt(redCenter, width / 2, height / 2);


|img1 img2|
"a depth24 RGB image"
img1 := Image width:100 height:200 depth:24.
img1 fillRectangle:(0@0 corner:100@100) with:Color red.
img1 fillRectangle:(0@100 corner:100@100) with:(Color rgbValue: 16rFF00FF).
img1 colorAt:(10 @ 10) put:(Color green).
img1 saveOn:'sampleFile.png'.

img1 displayOn:Transcript window graphicsContext.
Transcript showCR:(img1 colorAt:(100 @ 10) ).

"a depth8 palette image"
img2 := Image width:100 height:200 depth:8.
img2 colorMap:{ Color black. Color red . Color green }.
img2 fillRectangle:(0@0 corner:100@100) with:Color red.
img2 fillRectangle:(0@100 corner:100@100) with: 16r02.
img2 colorAt:(10 @ 10) put:(Color green).
img2 saveOn:'sampleFile.gif'.

img2 displayOn:Transcript window graphicsContext.
Transcript showCR:(img2 colorAt:(100 @ 10) ).


package require Tcl 8.5
package require Tk
namespace path ::tcl::mathfunc ;# for [max] function

proc newImage {width height} {
    return [image create photo -width $width -height $height]
}
proc fill {image colour} {
    $image put $colour -to 0 0 [$image cget -width] [$image cget -height]
}
proc setPixel {image colour point} {
    lassign $point x y
    $image put $colour -to [max 0 $x] [max 0 $y]
}
proc getPixel {image point} {
    lassign $point x y
    # [$img get] returns a list: {r g b}; this proc should return a colour value
    format {#%02x%02x%02x} {*}[$image get $x $y]
}

# create the image and display it
set img [newImage 150 150]
label .l -image $img
pack .l

fill $img red

setPixel $img green {40 40}

set rbg [getPixel $img {40 40}]


typeset -T RGBColor_t=(
    integer r g b
    function to_s {
        printf "%d %d %d" ${_.r} ${_.g} ${_.b}
    }
    function white   { print "255 255 255"; }
    function black   { print "0 0 0"; }
    function red     { print "255 0 0"; }
    function green   { print "0 255 0"; }
    function blue    { print "0 0 255"; }
    function yellow  { print "255 255 0"; }
    function magenta { print "255 0 255"; }
    function cyan    { print "0 255 255"; }
)

typeset -T Bitmap_t=(
    integer height
    integer width
    typeset -a data

    function fill {
        typeset color=$1
        if [[ -z ${color:+set} ]]; then
            print -u2 "error: no fill color specified"
            return 1
        fi
        integer x y
        for ((y=0; y<_.height; y++)); do
            for ((x=0; x<_.width; x++)); do
                _.data[y][x]="$color"
            done
        done
    }

    function setpixel {
        integer x=$1 y=$2
        typeset color=$3
        _.data[y][x]=$color
    }

    function getpixel {
        integer x=$1 y=$2
        print "${_.data[y][x]}"
    }

    function to_s {
        typeset ppm=""
        ppm+="P3"$'\n'
        ppm+="${_.width} ${_.height}"$'\n'
        ppm+="255"$'\n'
        typeset sep
        for ((y=0; y<_.height; y++)); do
            sep=""
            for ((x=0; x<_.width; x++)); do
                ppm+="$sep${_.data[y][x]}"
                sep=" "
            done
            ppm+=$'\n'
        done
        print -- "$ppm"
    }
)

RGBColor_t color
Bitmap_t b=( width=3  height=2 )
b.fill "$(color.white)"
b.setpixel 0 0 "$(color.red)"
b.setpixel 1 0 "$(color.green)"
b.setpixel 2 0 "$(color.blue)"
b.setpixel 0 1 "$(color.yellow)"
b.setpixel 1 1 "$(color.white)"
b.setpixel 2 1 "$(color.black)"
echo "$(b.getpixel 0 0)"
b.to_s