' FB 1.05.0 Win64

' Draw the color bars on an 80 x 25 console using the system palette of 16 colors
' i.e. 5 columns per color
Width 80, 25
Shell "cls"
Locate ,, 0  '' turn cursor off
For clr As UInteger = 0 To 15
  Color 0, clr
  For row As Integer = 1 to 25
    Locate row, clr * 5 + 1
    Print Space(5);
  Next row
Next clr

Sleep
' restore default settings
Locate ,, 1 '' turn cursor on
Color 7, 0  '' white text on black background


Public Sub Form_Open()
Dim iColour As Integer[] = [Color.Black, Color.red, Color.Green, Color.Magenta, Color.Cyan, Color.Yellow, Color.white]
Dim hPanel As Panel
Dim siCount As Short

With Me
  .Arrangement = Arrange.Horizontal
  .Height = 300
  .Width = 400
End With

For siCount = 0 To 6
  hpanel = New Panel(Me)
  hpanel.Expand = True
  hpanel.H = 500
  HPanel.Background = iColour[siCount]
Next

End


package main

import "github.com/fogleman/gg"

var colors = [8]string{
    "000000", // black
    "FF0000", // red
    "00FF00", // green
    "0000FF", // blue
    "FF00FF", // magenta
    "00FFFF", // cyan
    "FFFF00", // yellow
    "FFFFFF", // white
}

func drawBars(dc *gg.Context) {
    w := float64(dc.Width() / len(colors))
    h := float64(dc.Height())
    for i := range colors {
        dc.SetHexColor(colors[i])
        dc.DrawRectangle(w*float64(i), 0, w, h)
        dc.Fill()
    }
}

func main() {
    dc := gg.NewContext(400, 400)
    drawBars(dc)
    dc.SavePNG("color_bars.png")
}


from PIL import Image
import colorsys
import math

if __name__ == "__main__":

    im = Image.new("RGB", (300,300))
    radius = min(im.size)/2.0
    cx, cy = im.size[0]/2, im.size[1]/2
    pix = im.load()

    for x in range(im.width):
        for y in range(im.height):
            rx = x - cx
            ry = y - cy
            s = (rx ** 2.0 + ry ** 2.0) ** 0.5 / radius
            if s <= 1.0:
                h = ((math.atan2(ry, rx) / math.pi) + 1.0) / 2.0
                rgb = colorsys.hsv_to_rgb(h, s, 1.0)
                pix[x,y] = tuple([int(round(c*255.0)) for c in rgb])

    im.show()


#lang racket

(require racket/draw
         colors)

(define DIM 500)
(define target (make-bitmap DIM DIM))
(define dc (new bitmap-dc% [bitmap target]))
(define radius 200)
(define center (/ DIM 2))

(define (atan2 y x) (if (= 0 y x) 0 (atan y x)))

(for* ([x (in-range DIM)]
       [y (in-range DIM)]
       [rx (in-value (- x center))]
       [ry (in-value (- y center))]
       [s (in-value (/ (sqrt (+ (sqr rx) (sqr ry))) radius))]
       #:when (<= s 1))
  (define h (* 0.5 (+ 1 (/ (atan2 ry rx) pi))))
  (send dc set-pen (hsv->color (hsv (if (= 1 h) 0 h) s 1)) 1 'solid)
  (send dc draw-point x y))

target


use Image::PNG::Portable;

my ($w, $h) = 300, 300;

my $out = Image::PNG::Portable.new: :width($w), :height($h);

my $center = $w/2 + $h/2*i;

color-wheel($out);

$out.write: 'Color-wheel-perl6.png';

sub color-wheel ( $png ) {
    ^$w .race.map: -> $x {
        for ^$h -> $y {
            my $vector    = $center - $x - $y*i;
            my $magnitude = $vector.abs * 2 / $w;
            my $direction = ( π + atan2( |$vector.reals ) ) / τ;
            $png.set: $x, $y, |hsv2rgb( $direction, $magnitude, $magnitude < 1 );
        }
    }
}

sub hsv2rgb ( $h, $s, $v ){
    my $c = $v * $s;
    my $x = $c * (1 - abs( (($h*6) % 2) - 1 ) );
    my $m = $v - $c;
    (do given $h {
        when   0..^1/6 { $c, $x, 0 }
        when 1/6..^1/3 { $x, $c, 0 }
        when 1/3..^1/2 { 0, $c, $x }
        when 1/2..^2/3 { 0, $x, $c }
        when 2/3..^5/6 { $x, 0, $c }
        when 5/6..1    { $c, 0, $x }
    } ).map: ((*+$m) * 255).Int
}


(define $comb
  (lambda [$n $xs]
    (match-all xs (list integer)
      [(loop $i [1 ,n] <join _ <cons $a_i ...>> _) a])))

(test (comb 3 (between 0 4)))


class
	COMBINATIONS

create
	make

feature

	make (n, k: INTEGER)
		require
			n_positive: n > 0
			k_positive: k > 0
			k_smaller_equal: k <= n
		do
			create set.make
			set.extend ("")
			create sol.make
			sol := solve (set, k, n - k)
			sol := convert_solution (n, sol)
		ensure
			correct_num_of_sol: num_of_comb (n, k) = sol.count
		end

	sol: LINKED_LIST [STRING]

feature {None}

	set: LINKED_LIST [STRING]

	convert_solution (n: INTEGER; solution: LINKED_LIST [STRING]): LINKED_LIST [STRING]
			-- strings of 'k' digits between 1 and 'n'
		local
			i, j: INTEGER
			temp: STRING
		do
			create temp.make (n)
			from
				i := 1
			until
				i > solution.count
			loop
				from
					j := 1
				until
					j > n
				loop
					if solution [i].at (j) = '1' then
						temp.append (j.out)
					end
					j := j + 1
				end
				solution [i].deep_copy (temp)
				temp.wipe_out
				i := i + 1
			end
			Result := solution
		end

	solve (seta: LINKED_LIST [STRING]; one, zero: INTEGER): LINKED_LIST [STRING]
			-- list of strings with a number of 'one' 1s and 'zero' 0, standig for wether the corresponing digit is taken or not.
		local
			new_P1, new_P0: LINKED_LIST [STRING]
		do
			create new_P1.make
			create new_P0.make
			if one > 0 then
				new_P1.deep_copy (seta)
				across
					new_P1 as P1
				loop
					new_P1.item.append ("1")
				end
				new_P1 := solve (new_P1, one - 1, zero)
			end
			if zero > 0 then
				new_P0.deep_copy (seta)
				across
					new_P0 as P0
				loop
					new_P0.item.append ("0")
				end
				new_P0 := solve (new_P0, one, zero - 1)
			end
			if one = 0 and zero = 0 then
				Result := seta
			else
				create Result.make
				Result.fill (new_p0)
				Result.fill (new_p1)
			end
		end

	num_of_comb (n, k: INTEGER): INTEGER
			-- number of 'k' sized combinations out of 'n'.
		local
			upper, lower, m, l: INTEGER
		do
			upper := 1
			lower := 1
			m := n
			l := k
			from
			until
				m < n - k + 1
			loop
				upper := m * upper
				lower := l * lower
				m := m - 1
				l := l - 1
			end
			Result := upper // lower
		end

end


<?php
  function combos($arr, $k) {
    if ($k == 0) {
      return array(array());
    }

    if (count($arr) == 0) {
      return array();
    }

    $head = $arr[0];

    $combos = array();
    $subcombos = combos($arr, $k-1);
    foreach ($subcombos as $subcombo) {
      array_unshift($subcombo, $head);
      $combos[] = $subcombo;
    }
    array_shift($arr);
    $combos = array_merge($combos, combos($arr, $k));
    return $combos;
  }

  $arr = array("iced", "jam", "plain");
  $result = combos($arr, 2);
  foreach($result as $combo) {
    echo implode(' ', $combo), "<br>";
  }
  $donuts = range(1, 10);
  $num_donut_combos = count(combos($donuts, 3));
  echo "$num_donut_combos ways to order 3 donuts given 10 types";
?>


#!/usr/bin/env stack
-- stack --resolver lts-7.0 --install-ghc runghc --package vty -- -threaded

import Graphics.Vty

colorBars :: Int -> [(Int, Attr)] -> Image
colorBars h bars = horizCat $ map colorBar bars
  where colorBar (w, attr) = charFill attr ' ' w h

barWidths :: Int -> Int -> [Int]
barWidths nBars totalWidth = map barWidth [0..nBars-1]
  where fracWidth = fromIntegral totalWidth / fromIntegral nBars
        barWidth n =
          let n' = fromIntegral n :: Double
          in floor ((n' + 1) * fracWidth) - floor (n' * fracWidth)

barImage :: Int -> Int -> Image
barImage w h = colorBars h $ zip (barWidths nBars w) attrs
  where attrs = map color2attr colors
        nBars = length colors
        colors = [black, brightRed, brightGreen, brightMagenta, brightCyan, brightYellow, brightWhite]
        color2attr c = Attr Default Default (SetTo c)

main = do
    cfg <- standardIOConfig
    vty <- mkVty cfg
    let output = outputIface vty
    bounds <- displayBounds output
    let showBars (w,h) = do
          let img = barImage w h
              pic = picForImage img
          update vty pic
          e <- nextEvent vty
          case e of
            EvResize w' h' -> showBars (w',h')
            _ -> return ()
    showBars bounds
    shutdown vty


link graphics,printf

procedure main()  # generalized colour bars
   DrawTestCard(Simple_TestCard())
   WDone()
end

procedure DrawTestCard(TC)
   size := sprintf("size=%d,%d",TC.width,TC.height)
   &window := TC.window := open(TC.id,"g","bg=black",size) |
               stop("Unable to open window")

   every R := TC.bands[r := 1 to *TC.bands -1] do
      every C := R.bars[c := 1 to *R.bars - 1] do {
	     Fg(R.bars[c].colour)
	     FillRectangle( C.left, R.top,
		            R.bars[c+1].left-C.left, TC.bands[r+1].top-R.top )
	     }
   return TC
end

record testcard(window,id,width,height,bands)
record band(top,bars)
record bar(left,colour)

procedure Simple_TestCard()  #: return structure simple testcard
   return testcard(,"Simple Test Card",width := 800,height := 600,
		   [   band( 1, [ bar(  1, "black"),
				  bar(114, "red"),
				  bar(228, "green"),
				  bar(342, "blue"),
                                  bar(456, "magenta"),
                                  bar(570, "cyan"),
                                  bar(684, "yellow"),
                                  bar(width) ] ),
		       band(height) ])
end


#===================================================================#
#  Sample: Color Wheel
#  Author: Gal Zsolt, Bert Mariani, Ilir Liburn & Mahmoud Fayed
#===================================================================#

load "guilib.ring"

xWidth  = 400
yHeight = 400

MyApp = new qapp
{
   win1 = new qwidget()
   {  setwindowtitle("ColorWheel-FastDraw")
      setgeometry(500,150,xWidth,yHeight)

      Canvas = new qlabel(win1)
      {  ### daVinci paints the MonaLisa on the Canvas
         MonaLisa  = new qPixMap2( xWidth, yHeight)
             color = new qcolor(){ setrgb(255,255,255,0) }
              pen  = new qpen()  { setwidth(1) }
         MonaLisa.fill(color)

         daVinci = new qpainter()
         {  begin(MonaLisa)
            #endpaint()           ### This will Stop the Painting. For Animation comment it out
         }

         setPixMap(MonaLisa)
      }

      show()
   }

   ColorWheel()
   exec()
}

//=====================

Func colorWheel

   #=====================================================================#
   ? "Start Processing..."
   t1 = clock()
   ? "Clock : " + t1
   #=====================================================================#

   aList = []
   pi       = 3.14159265359
   diameter = pi * 2
   radius   = yHeight / 2
   v        = 1                    // value/brightness  1 to 100  1=bright 0=dark

   for i = 1 to xWidth
      iradius = i - radius
            p = pow( iradius, 2)

      for j = 1 to yHeight

          h = (atan2( iradius, j-radius ) + pi ) / diameter   // hue/color  1 to 360
          s =   sqrt( p + pow( j-radius, 2)) / radius         // saturation/intensity 1 to 100

         if s <= 1 and h <= 1
            aList + [i,j,h,s,v,1]
         ok

      next
   next

   #=====================================================================#
   ? "Start drawing..."
   t2 = clock()
   ? "Clock : " + t2
   #=====================================================================#

   daVinci.drawHSVFList(aList)
   Canvas.setPixMap(MonaLisa)

   #=====================================================================#
   ? "Done..."
   t3 = clock()
   ? "Clock : " + t3
   #=====================================================================#
   ? "Processing Time: " + ( (t2-t1)/ClocksPerSecond() ) + " seconds "
   ? "Drawing Time: " + ( (t3-t2)/ClocksPerSecond() ) + " seconds "
   ? "Total Time: " + ( (t3-t1)/ClocksPerSecond() ) + " seconds "
   #=====================================================================#

 return

//==================


def settings
  size(300, 300)
end

def setup
  sketch_title 'Color Wheel'
  background(0)
  radius = width / 2.0
  center = width / 2
  grid(width, height) do |x, y|
    rx = x - center
    ry = y - center
    sat = Math.hypot(rx, ry) / radius
    if sat <= 1.0
      hue = ((Math.atan2(ry, rx) / PI) + 1) / 2.0
      color_mode(HSB)
      col = color((hue * 255).to_i, (sat * 255).to_i, 255)
      set(x, y, col)
    end
  end
end


' -----------------------------------
' color wheel
' -----------------------------------
global pi
pi	= 22 / 7
steps	= 1

graphic #g, 525, 525

for x =0 to 525 step steps
	for y =0 to 525 step steps
		angle   = atan2(y - 250, x - 250) * 360 / 2 / pi      '  full degrees....
		sector  = int(angle / 60)                             '    60 degree sectors (0 to 5)
		slope   = (angle mod 60) /60 * 255                    '     1 degree sectors.

		if  sector = 0 then  col$    = "255 ";                    str$( int( slope));      "   0"
		if  sector = 1 then  col$    = str$(int(256 - slope)); " 255                          0"
		if  sector = 2 then  col$    = "0                         255 ";                     str$( int( slope))
		if  sector = 3 then  col$    = "0 ";                      str$( int( 256 -slope)); " 255"
		if  sector = 4 then  col$    = str$(int(slope));    "     0                        255"
		if  sector = 5 then  col$    = "255                         0 ";                     str$( int( 256 -slope))

		red	= val( word$( col$, 1))
		grn	= val( word$( col$, 2))
		blu	= val( word$( col$, 3))
		p	= ((x -270)^2 +(y -270)^2)^0.5 / 250
		r	= min(255,p * red)
		g	= min(255,p * grn)
		b	= min(255,p * blu)
		if p > 1 then  #g "color white" else #g color(r,g,b)
		#g "set "; x; " "; y
	next y
next x
render #g
end

function atan2(y,x)
if (x = 0) and (y <> 0) then
	r$ = "Y"
	if y > 0 then atan2 = pi /2
	if y < 0 then atan2 = 3 * pi /2
end if

if y = 0 and (x <> 0) then
	r$ = "Y"
	if x > 0 then atan2 = 0
	if x < 0 then atan2 = pi
end if

If r$ <> "Y" then
	if x = 0 and y = 0 then
		atan2	= 0
		else
		baseAngle = atn(abs(y) / abs(x))
		if x > 0 then
			if y > 0 then atan2 = baseAngle
			If y < 0 then atan2 = 2 * pi - baseAngle
		end if
		if x < 0 then
			If y > 0 then atan2 = pi - baseAngle
			If y < 0 then atan2 = pi + baseAngle
		end if
	end if
end if
end function


// [dependencies]
// image = "0.23"

use image::error::ImageResult;
use image::{Rgb, RgbImage};

fn hsv_to_rgb(h: f64, s: f64, v: f64) -> Rgb<u8> {
    let hp = h / 60.0;
    let c = s * v;
    let x = c * (1.0 - (hp % 2.0 - 1.0).abs());
    let m = v - c;
    let mut r = 0.0;
    let mut g = 0.0;
    let mut b = 0.0;
    if hp <= 1.0 {
        r = c;
        g = x;
    } else if hp <= 2.0 {
        r = x;
        g = c;
    } else if hp <= 3.0 {
        g = c;
        b = x;
    } else if hp <= 4.0 {
        g = x;
        b = c;
    } else if hp <= 5.0 {
        r = x;
        b = c;
    } else {
        r = c;
        b = x;
    }
    r += m;
    g += m;
    b += m;
    Rgb([(r * 255.0) as u8, (g * 255.0) as u8, (b * 255.0) as u8])
}

fn write_color_wheel(filename: &str, width: u32, height: u32) -> ImageResult<()> {
    let mut image = RgbImage::new(width, height);
    let margin = 10;
    let diameter = std::cmp::min(width, height) - 2 * margin;
    let xoffset = (width - diameter) / 2;
    let yoffset = (height - diameter) / 2;
    let radius = diameter as f64 / 2.0;
    for x in 0..=diameter {
        let rx = x as f64 - radius;
        for y in 0..=diameter {
            let ry = y as f64 - radius;
            let r = ry.hypot(rx) / radius;
            if r > 1.0 {
                continue;
            }
            let a = 180.0 + ry.atan2(-rx).to_degrees();
            image.put_pixel(x + xoffset, y + yoffset, hsv_to_rgb(a, r, 1.0));
        }
    }
    image.save(filename)
}

fn main() {
    match write_color_wheel("color_wheel.png", 400, 400) {
        Ok(()) => {}
        Err(error) => eprintln!("{}", error),
    }
}


require('Imager')

var (width, height) = (300, 300)
var center = Complex(width/2 , height/2)

var img = %O<Imager>.new(xsize => width, ysize => height)

for y=(^height), x=(^width) {
    var vector    = (center - x - y.i)
    var magnitude = (vector.abs * 2 / width)
    var direction = ((Num.pi + atan2(vector.real, vector.imag)) / Num.tau)
    img.setpixel(x => x, y => y,
        color => Hash(hsv => [360*direction, magnitude, magnitude < 1 ? 1 : 0])
    )
}

img.write(file => 'color_wheel.png')


import system'routines;
import extensions;
import extensions'routines;

const int M = 3;
const int N = 5;

Numbers(n)
{
    ^ Array.allocate(n).populate:(int n => n)
}

public program()
{
    var numbers := Numbers(N);
    Combinator.new(M, numbers).forEach:(row)
    {
        console.printLine(row.toString())
    };

    console.readChar()
}


defmodule RC do
  def comb(0, _), do: [[]]
  def comb(_, []), do: []
  def comb(m, [h|t]) do
    (for l <- comb(m-1, t), do: [h|l]) ++ comb(m, t)
  end
end

{m, n} = {3, 5}
list = for i <- 1..n, do: i
Enum.each(RC.comb(m, list), fn x -> IO.inspect x end)


(defun comb-recurse (m n n-max)
  (cond ((zerop m) '(()))
        ((= n-max n) '())
        (t (append (mapcar #'(lambda (rest) (cons n rest))
                           (comb-recurse (1- m) (1+ n) n-max))
                   (comb-recurse m (1+ n) n-max)))))

(defun comb (m n)
  (comb-recurse m 0 n))

(comb 3 5)


(de combrep (N Lst)
   (cond
      ((=0 N) '(NIL))
      ((not Lst))
      (T
         (conc
            (mapcar
               '((X) (cons (car Lst) X))
               (combrep (dec N) Lst) )
            (combrep N (cdr Lst)) ) ) ) )


combinations_of_length(_,[]).
combinations_of_length([X|T],[X|Combinations]):-
    combinations_of_length([X|T],Combinations).
combinations_of_length([_|T],[X|Combinations]):-
    combinations_of_length(T,[X|Combinations]).


Procedure nextCombination(Array combIndex(1), elementCount)
  ;combIndex() must be dimensioned to 'k' - 1, elementCount equals 'n' - 1
  ;combination produced includes repetition of elements and is represented by the array combIndex()
  Protected i, indexValue, combSize = ArraySize(combIndex()), curIndex

  ;update indexes
  curIndex = combSize
  Repeat
    combIndex(curIndex) + 1
    If combIndex(curIndex) > elementCount

      curIndex - 1
      If curIndex < 0
        For i = 0 To combSize
          combIndex(i) = 0
        Next
        ProcedureReturn #False ;array reset to first combination
      EndIf

    ElseIf curIndex < combSize

      indexValue = combIndex(curIndex)
      Repeat
        curIndex + 1
        combIndex(curIndex) = indexValue
      Until curIndex = combSize

    EndIf
  Until  curIndex = combSize

  ProcedureReturn #True ;array contains next combination
EndProcedure

Procedure.s display(Array combIndex(1), Array dougnut.s(1))
  Protected i, elementCount = ArraySize(combIndex()), output.s = "  "
  For i = 0 To elementCount
    output + dougnut(combIndex(i)) + " + "
  Next
  ProcedureReturn Left(output, Len(output) - 3)
EndProcedure

DataSection
  Data.s "iced", "jam", "plain"
EndDataSection

If OpenConsole()
  Define n = 3, k = 2, i, combinationCount
  Dim combIndex(k - 1)
  Dim dougnut.s(n - 1)
  For i = 0 To n - 1: Read.s dougnut(i): Next

  PrintN("Combinations of " + Str(n) + " dougnut types taken " + Str(k) + " at a time with repetitions.")
  combinationCount = 0
  Repeat
    PrintN(display(combIndex(), dougnut()))
    combinationCount + 1
  Until Not nextCombination(combIndex(), n - 1)
  PrintN("Total combination count: " + Str(combinationCount))

  ;extra credit
  n = 10: k = 3
  Dim combIndex(k - 1)
  combinationCount = 0
  Repeat: combinationCount + 1: Until Not nextCombination(combIndex(), n - 1)
  PrintN(#CRLF$ + "Ways to select " + Str(k) + " items from " + Str(n) + " types: " + Str(combinationCount))

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


   load 'viewmat'
   size=: 2{.".wd'qm' NB. J6
   size=: getscreenwh_jgtk_ '' NB. J7
   'rgb'viewmat (|.size){. (>.&.(%&160)|.size)$ 20# 256#.255*#:i.8


import java.awt.Color;
import java.awt.Graphics;

import javax.swing.JFrame;

public class ColorFrame extends JFrame {
	public ColorFrame(int width, int height) {
		this.setDefaultCloseOperation(EXIT_ON_CLOSE);
		this.setSize(width, height);
		this.setVisible(true);
	}

	@Override
	public void paint(Graphics g) {
		Color[] colors = { Color.black, Color.red, Color.green, Color.blue,
				Color.pink, Color.CYAN, Color.yellow, Color.white };

		for (int i = 0; i < colors.length; i++) {
			g.setColor(colors[i]);
			g.fillRect(this.getWidth() / colors.length * i, 0, this.getWidth()
					/ colors.length, this.getHeight());
		}
	}

	public static void main(String args[]) {
		new ColorFrame(200, 200);
	}
}


using Images

colors = [colorant"black", colorant"red", colorant"green", colorant"darkblue",
          colorant"purple", colorant"blue", colorant"yellow", colorant"white"]
wcol = 60 # width of each color bar
h, w = 150, wcol * length(colors) + 1
img = Matrix{RGB{N0f8}}(h, w);
for (j, col) in zip(1:wcol:w, colors)
    img[:, j:j+wcol] = col
end
save("data/colourbars.jpg", img)


' Runs on iOS
GET SCREEN SIZE sw,sh
xmax=0.45*3/7*(sw+sh)
x0=sw/2!y0=sh/2
twopi=2*3.1415926
GRAPHICS
GRAPHICS CLEAR
DIM triX(1000), triY(1000)
triX(0)=x0 ! triY(0)=y0
steps=INT(1^2*360)+1
dAngle=twopi/steps
dAngle2=dAngle/2
REFRESH OFF
FOR i=0 TO steps-1
  pal(i/steps+TintOffset)
  ANGLE=i*dAngle
  FILL COLOR pal.r,pal.g,pal.b
  DRAW COLOR pal.r,pal.g,pal.b
  x=x0+(xmax-radius)*COS(ANGLE)
  y=y0-(xmax-radius)*SIN(ANGLE)
  k=0
  FOR j=-dAngle2 TO dAngle2 STEP 0.02
    k+=1
    triX(k)=x0+xmax*COS(ANGLE+j)
    triY(k)=y0-xmax*SIN(ANGLE+j)
  NEXT j
  k+=1
  triX(k)=x0+xmax*COS(ANGLE+dAngle2)
  triY(k)=y0-xmax*SIN(ANGLE+dAngle2)
  DRAW POLY triX,triY COUNT k+1
  FILL POLY triX,triY COUNT k+1
NEXT i
REFRESH ON
END

DEF pal(tint)
tint=tint*360
h=(tint%360)/60 ! f=FRACT(h) ! z=1-f ! ic=FLOOR(h)+1
ON ic GOTO s1,s2,s3,s4,s5,s6
  s1: r=1 ! g=f ! b=0 ! GOTO done
  s2: r=z ! g=1 ! b=0 ! GOTO done
  s3: r=0 ! g=1 ! b=f ! GOTO done
  s4: r=0 ! g=z ! b=1 ! GOTO done
  s5: r=f ! g=0 ! b=1 ! GOTO done
  s6: r=1 ! g=0 ! b=z ! done:
END DEF


import "graphics" for Canvas, Color
import "dome" for Window
import "random" for Random

class Game {
    static init() {
        Window.title = "Color Wheel"
        __width = 640
        __height = 640
        Window.resize(__width, __height)
        Canvas.resize(__width, __height)
        colorWheel()
    }

    static colorWheel() {
        var cx = (__width/2).floor
        var cy = (__height/2).floor
        var r = (cx < cy) ? cx : cy
        for (y in 0...__height) {
            var dy = y - cy
            for (x in 0...__width) {
                var dx = x - cx
                var dist = (dx*dx + dy*dy).sqrt
                if (dist <= r) {
                    var theta = dy.atan(dx)
                    var h = (theta + Num.pi) / Num.pi * 180
                    var col = Color.hsv(h, dist/r, 1)
                    Canvas.pset(x, y, col)
                }
            }
        }
    }

    static update() {}

    static draw(alpha) {}
}


def  Radius = 480/2;
real Hue, Sat, Dist, I, F, P, Q, T;
real XX, YY, RR, GG, BB;
int  X, Y, R, G, B;
def  Pi = 3.141592654;
def  V = 1.;            \Value
[SetVid($112);          \640x480x24 graphics
for Y:= -Radius to Radius do
    for X:= -Radius to Radius do
        [XX:= float(X);
         YY:= float(Y);
         Dist:= sqrt(XX*XX + YY*YY);
         if Dist <= float(Radius) then
                [Sat:= Dist/float(Radius);      \0 >= Sat <= 1
                Hue:= ATan2(YY, XX);            \-Pi >= Hue <= Pi
                if Hue < 0. then Hue:= Hue + 2.*Pi;
                Hue:= Hue * 180./Pi;            \radians to degrees
                Hue:= Hue / 60.;                \0 >= Hue < 6
                I:= Floor(Hue);                 \integer part of Hue
                F:= Hue - I;                    \fractional part of Hue
                P:= 1. - Sat;
                Q:= 1. - Sat*F;
                T:= 1. - Sat*(1.-F);
                case fix(I) of
                  0:    [RR:= V;  GG:= T;  BB:= P];
                  1:    [RR:= Q;  GG:= V;  BB:= P];
                  2:    [RR:= P;  GG:= V;  BB:= T];
                  3:    [RR:= P;  GG:= Q;  BB:= V];
                  4:    [RR:= T;  GG:= P;  BB:= V];
                  5:    [RR:= V;  GG:= P;  BB:= Q]
                other   [exit 1];
                R:= fix(RR*255.);
                G:= fix(GG*255.);
                B:= fix(BB*255.);
                Point(X+Radius, Radius-Y, R<<16+G<<8+B);
                ];
        ];
]


var w=300,h=300,out=PPM(w,h);
colorWheel(out);
out.writeJPGFile("colorWheel.zkl.jpg");

fcn colorWheel(ppm){
   zero,R:=ppm.w/2, zero;
   foreach x,y in (w,h){
      v,hue:=(x - zero).toFloat().toPolar(y - zero);
      if(v<=R){    // only render in the circle
	 if((hue = hue.toDeg())<0) hue+=360;  // (-pi..pi] to [0..2pi)
	 s:=v/R;  // scale saturation zero at center to 1 at edge
	 ppm[x,y]=hsv2rgb(hue,1.0,s);
      }
   }
}

fcn hsv2rgb(hue,v,s){  //  0<=H<360, 0<=v(brightness)<=1, 0<=saturation<=1
		       // --> 24 bit RGB each R,G,B in [0..255]
   to24bit:=fcn(r,g,b,m){
      r,g,b=((r+m)*255).toInt(),((g+m)*255).toInt(),((b+m)*255).toInt();
      r*0x10000 + g*0x100 + b
   };
   c:=v*s;
   x:=c*(1.0 - (hue.toFloat()/60%2 - 1).abs());
   m:=v - c;
   if     (0  <=hue< 60) return(to24bit(c,  x,  0.0,m));
   else if(60 <=hue<120) return(to24bit(x,  c,  0.0,m));
   else if(120<=hue<180) return(to24bit(0.0,c,  x,  m));
   else if(180<=hue<240) return(to24bit(0.0,x,  c,  m));
   else if(240<=hue<300) return(to24bit(x,  0.0,c,  m));
   else			 return(to24bit(c,  0.0,x,  m));
}


PROGRAM COMBINATIONS

CONST M_MAX=3,N_MAX=5

DIM COMBINATION[M_MAX],STACK[100,1]

PROCEDURE GENERATE(M)
   LOCAL I
   IF (M>M_MAX) THEN
    FOR I=1 TO M_MAX DO
     PRINT(COMBINATION[I];" ";)
    END FOR
    PRINT
   ELSE
    FOR N=1 TO N_MAX DO
      IF ((M=1) OR (N>COMBINATION[M-1])) THEN
        COMBINATION[M]=N
        ! --- PUSH STACK -----------
        STACK[SP,0]=M  STACK[SP,1]=N
        SP=SP+1
        ! --------------------------

        GENERATE(M+1)

        ! --- POP STACK ------------
        SP=SP-1
        M=STACK[SP,0] N=STACK[SP,1]
        ! --------------------------
      END IF
    END FOR
   END IF
END PROCEDURE

BEGIN
 GENERATE(1)
END PROGRAM


>>> from itertools import combinations_with_replacement
>>> n, k = 'iced jam plain'.split(), 2
>>> list(combinations_with_replacement(n,k))
[('iced', 'iced'), ('iced', 'jam'), ('iced', 'plain'), ('jam', 'jam'), ('jam', 'plain'), ('plain', 'plain')]
>>> # Extra credit
>>> len(list(combinations_with_replacement(range(10), 3)))
220
>>>


( nextplain generates the next plaindrome in the
  current base by adding one to a given plaindrome,
  then replacing each trailing zero with the least
  significant non-zero digit of the number

  See: https://oeis.org/search?q=plaindromes

       4 base put
       -1
       10 times
         [ nextplain
           dup echo sp ]
       drop
       base release

        prints "0 1 2 3 11 12 13 22 23 33"
  i.e. decimal "0 1 2 3  5  6  7 10 11 15"

  Right padding the base 4 representations with
  zeros gives all the combinations with repetitions
  for selecting two doughnuts in a store selling
  four types  of doughnut, numbered 0, 1, 2, and 3.

     00 01 02 03 11 12 13 22 23 33                      )

  [ 1+ dup 0 = if done
    0 swap
    [ base share /mod
      dup 0 = while
      drop dip 1+
      again ]
    swap rot 1+ times
      [ base share * over + ]
    nip ]                      is nextplain (   n --> n )

  [ dup base put
    swap ** 1 -
    [] swap -1
    [ 2dup > while
      nextplain
      rot over join
      unrot
      again ]
    base release
    2drop ]                    is kcombnums ( n n --> [ )

  [ [] unrot times
     [ base share /mod
       rot join swap ]
    drop ]                     is ndigits   ( n n --> [ )

  [ [] unrot
    witheach
      [ dip dup peek
        nested rot swap join
        swap ]
    drop ]                     is [peek]    ( [ [ --> [ )

  [ dup temp put
    size dup base put
    dip dup kcombnums
    [] unrot witheach
      [ over ndigits
        temp share swap [peek]
        nested rot swap join
        swap ]
    temp release
    base release
    drop ]                     is kcombs    ( n [ --> [ )

  2
  $ "jam iced plain" nest$
  kcombs
  witheach
    [ witheach
        [ echo$ sp ] cr ]
  cr
  3 10 kcombnums size echo


import java.awt.Color
import java.awt.Graphics
import javax.swing.JFrame

class ColorFrame(width: Int, height: Int): JFrame() {
    init {
        defaultCloseOperation = EXIT_ON_CLOSE
        setSize(width, height)
        isVisible = true
    }

    override fun paint(g: Graphics) {
        val colors = listOf(Color.black, Color.red,  Color.green,  Color.blue,
		            Color.pink,  Color.cyan, Color.yellow, Color.white)
        val size = colors.size
        for (i in 0 until size) {
            g.color = colors[i]
            g.fillRect(width / size * i, 0, width / size, height)
        }
    }
}

fun main(args: Array<String>) {
    ColorFrame(400, 400)
}


Module Checkit {
      Module Bars {
            barwidth=x.twips div 8
            barheight=y.twips
            barcolors=(0,#ff0000,#00ff00, #0000ff, #FF00FF, #00ffff, #ffff00, #ffffff)
            For i=0 to 7
                  Move i*barwidth, 0
                  \\ gradient fill. Here second color are the same as first color
                  Fill barwidth, barheight, array(barcolors, i), array(barcolors, i)
            Next i
      }
      \\ first draw on console
      Call Bars
      Declare Form1 Form
      Layer Form1 {
            window 12, 10000,8000;
            \\ now draw on Form1 layer, above console, in a window
            Call Bars
      }
      Method Form1, "Show", 1 ' open modal
      Declare Form1 Nothing
}
Checkit


with(plottools):
plots:-display([rectangle([0, 0], [.3, 2.1], color = black), rectangle([.3, 0], [.6, 2.1], color = red), rectangle([.6, 0], [.9, 2.1], color = green), rectangle([.9, 0], [1.2, 2.1], color = magenta), rectangle([1.2, 0], [1.5, 2.1], color = cyan), rectangle([1.5, 0], [1.8, 2.1], color = white), rectangle([1.8, 0], [2.1, 2.1], color = yellow)])


ArrayPlot[
 ConstantArray[{Black, Red, Green, Blue, Magenta, Cyan, Yellow,
   White}, 5]]


import gintro/[glib, gobject, gtk, gio, cairo]

const
  Width = 400
  Height = 300

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

proc draw(area: DrawingArea; context: Context) =
  ## Draw the color bars.

  const Colors = [[0.0, 0.0, 0.0], [255.0, 0.0, 0.0],
                  [0.0, 255.0, 0.0], [0.0, 0.0, 255.0],
                  [255.0, 0.0, 255.0], [0.0, 255.0, 255.0],
                  [255.0, 255.0, 0.0], [255.0, 255.0, 255.0]]

  const
    RectWidth = float(Width div Colors.len)
    RectHeight = float(Height)

  var x = 0.0
  for color in Colors:
    context.rectangle(x, 0, RectWidth, RectHeight)
    context.setSource(color)
    context.fill()
    x += RectWidth

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

proc onDraw(area: DrawingArea; context: Context; data: pointer): bool =
  ## Callback to draw/redraw the drawing area contents.

  area.draw(context)
  result = true

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

proc activate(app: Application) =
  ## Activate the application.

  let window = app.newApplicationWindow()
  window.setSizeRequest(Width, Height)
  window.setTitle("Color bars")

  # Create the drawing area.
  let area = newDrawingArea()
  window.add(area)

  # Connect the "draw" event to the callback to draw the spiral.
  discard area.connect("draw", ondraw, pointer(nil))

  window.showAll()

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

let app = newApplication(Application, "Rosetta.ColorBars")
discard app.connect("activate", activate)
discard app.run()


let choose m n =
    let rec fC prefix m from = seq {
        let rec loopFor f = seq {
            match f with
            | [] -> ()
            | x::xs ->
                yield (x, fC [] (m-1) xs)
                yield! loopFor xs
        }
        if m = 0 then yield prefix
        else
            for (i, s) in loopFor from do
                for x in s do
                    yield [email protected][i]@x
    }
    fC [] m [0..(n-1)]

[<EntryPoint>]
let main argv =
    choose 3 5
    |> Seq.iter (printfn "%A")
    0


USING: math.combinatorics prettyprint ;

5 iota 3 all-combinations .


library(gtools)
combinations(3, 2, c("iced", "jam", "plain"), set = FALSE, repeats.allowed = TRUE)
nrow(combinations(10, 3, repeats.allowed = TRUE))


#lang racket
(define (combinations xs k)
  (cond [(= k 0)     '(())]
        [(empty? xs) '()]
        [(append (combinations (rest xs) k)
                 (map (λ(x) (cons (first xs) x))
                      (combinations xs (- k 1))))]))


open Graphics

let round x =
  int_of_float (floor (x +. 0.5))

let () =
  open_graph "";
  let cols = size_x () in
  let rows = size_y () in
  let colors = [| black; red; green; blue; magenta; cyan; yellow; white |] in
  let n = Array.length colors in
  let bar_width = (float cols) /. (float n) in
  Array.iteri (fun i color ->
    let x1 = bar_width *. (float i) in
    let x2 = bar_width *. (float (succ i)) in
    set_color color;
    fill_rect (round x1) 0 (round x2) rows;
  ) colors;
  ignore (read_key ());
;;


#!/usr/bin/perl -w
use strict ;
use GD ;

my %colors = ( white => [ 255 , 255 , 255 ] , red => [255 , 0 , 0 ] ,
      green => [ 0 , 255 , 0 ] , blue => [ 0 , 0 , 255 ] ,
      magenta => [ 255 , 0 , 255 ] , yellow => [ 255 , 255 , 0 ] ,
      cyan => [ 0 , 255 , 255 ] , black => [ 0 , 0 , 0 ] ) ;
my $barwidth = 160 / 8 ;
my $image = new GD::Image( 160 , 100 ) ;
my $start = 0 ;
foreach my $rgb ( values %colors ) {
   my $paintcolor = $image->colorAllocate( @$rgb ) ;
   $image->filledRectangle( $start * $barwidth , 0 , $start * $barwidth +
	 $barwidth - 1 , 99 , $paintcolor ) ;
   $start++ ;
}
open ( DISPLAY , ">" , "testprogram.png" ) || die ;
binmode DISPLAY ;
print DISPLAY $image->png ;
close DISPLAY ;#to be watched with <image viewer> testprogram.png


program Combinations
  use iso_fortran_env
  implicit none

  type comb_result
     integer, dimension(:), allocatable :: combs
  end type comb_result

  type(comb_result), dimension(:), pointer :: r
  integer :: i, j

  call comb(5, 3, r)
  do i = 0, choose(5, 3) - 1
     do j = 2, 0, -1
        write(*, "(I4, ' ')", advance="no") r(i)%combs(j)
     end do
     deallocate(r(i)%combs)
     write(*,*) ""
  end do
  deallocate(r)

contains

  function choose(n, k, err)
    integer :: choose
    integer, intent(in) :: n, k
    integer, optional, intent(out) :: err

    integer :: imax, i, imin, ie

    ie = 0
    if ( (n < 0 ) .or. (k < 0 ) ) then
       write(ERROR_UNIT, *) "negative in choose"
       choose = 0
       ie = 1
    else
       if ( n < k ) then
          choose = 0
       else if ( n == k ) then
          choose = 1
       else
          imax = max(k, n-k)
          imin = min(k, n-k)
          choose = 1
          do i = imax+1, n
             choose = choose * i
          end do
          do i = 2, imin
             choose = choose / i
          end do
       end if
    end if
    if ( present(err) ) err = ie
  end function choose

  subroutine comb(n, k, co)
    integer, intent(in) :: n, k
    type(comb_result), dimension(:), pointer, intent(out) :: co

    integer :: i, j, s, ix, kx, hm, t
    integer :: err

    hm = choose(n, k, err)
    if ( err /= 0 ) then
       nullify(co)
       return
    end if

    allocate(co(0:hm-1))
    do i = 0, hm-1
       allocate(co(i)%combs(0:k-1))
    end do
    do i = 0, hm-1
       ix = i; kx = k
       do s = 0, n-1
          if ( kx == 0 ) exit
          t = choose(n-(s+1), kx-1)
          if ( ix < t ) then
             co(i)%combs(kx-1) = s
             kx = kx - 1
          else
             ix = ix - t
          end if
       end do
    end do

  end subroutine comb

end program Combinations


my @S = <iced jam plain>;
my $k = 2;

.put for [X](@S xx $k).unique(as => *.sort.cache, with => &[eqv])


/*REXX pgm displays combination sets with repetitions for  X  things taken  Y  at a time*/
call RcombN    3,  2,  'iced jam plain'          /*The  1st  part of Rosetta Code task. */
call RcombN  -10,  3,  'Iced jam plain'          /* "   2nd    "   "    "      "    "   */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
RcombN: procedure; parse arg x,y,syms;  tell= x>0;  x=abs(x);   z=x+1  /*X>0? Show combo*/
        say copies('─',15) x "doughnut selection taken" y 'at a time:' /*display title. */
               do i=1  for words(syms);           $.i=word(syms, i)    /*assign symbols.*/
               end   /*i*/
        @.=1                                                           /*assign default.*/
               do #=1;        if tell    then  call show               /*display combos?*/
               @.[email protected].y + 1;   if @.y==z  then  if .(y-1)  then leave   /* ◄─── recursive*/
               end   /*#*/
        say copies('═',15)  #  "combinations.";    say;   say          /*display answer.*/
        return
/*──────────────────────────────────────────────────────────────────────────────────────*/
.: procedure expose @. y z;   parse arg ?;     if ?==0  then return 1;            [email protected].? +1
        if p==z  then return .(? -1);      do j=?  to y;   @.j=p;   end  /*j*/;   return 0
/*──────────────────────────────────────────────────────────────────────────────────────*/
show:   L=;      do c=1  for y;   [email protected].c;   L=L $._;   end  /*c*/;       say L;    return


-- demo\rosetta\Colour_bars.exw
with javascript_semantics
include pGUI.e

constant colours = {CD_BLACK, CD_RED, CD_GREEN, CD_BLUE, CD_MAGENTA, CD_CYAN, CD_YELLOW, CD_WHITE}

Ihandle dlg, canvas
cdCanvas cdcanvas

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/)
    integer {width, height} = IupGetIntInt(canvas, "DRAWSIZE"),
            x = 0, lc = length(colours)
    cdCanvasActivate(cdcanvas)
    for i=1 to lc do
        integer w = floor((width-x)/(lc-i+1))
        cdCanvasSetForeground(cdcanvas, colours[i])
        cdCanvasBox(cdcanvas, x, x+w, 0, height)
        x += w
    end for
    cdCanvasFlush(cdcanvas)
    return IUP_DEFAULT
end function

IupOpen()
canvas = IupCanvas(Icallback("redraw_cb"),"RASTERSIZE=600x400") -- initial size
dlg = IupDialog(canvas,`TITLE="Colour bars"`)
IupMap(dlg)
cdcanvas = cdCreateCanvas(CD_IUP, canvas)
IupShow(dlg)
IupSetAttribute(canvas, "RASTERSIZE", NULL) -- release the minimum limitation
if platform()!=JS then
    IupMainLoop()
    IupClose()
end if


<?php
$colors = array(array(  0,   0,   0),   // black
                array(255,   0,   0),   // red
                array(  0, 255,   0),   // green
                array(  0,   0, 255),   // blue
                array(255,   0, 255),   // magenta
                array(  0, 255, 255),   // cyan
                array(255, 255,   0),   // yellow
                array(255, 255, 255));  // white

define('BARWIDTH', 640 / count($colors));
define('HEIGHT',   480);

$image = imagecreate(BARWIDTH * count($colors), HEIGHT);

foreach ($colors as $position => $color) {
    $color = imagecolorallocate($image, $color[0], $color[1], $color[2]);
    imagefilledrectangle($image, $position * BARWIDTH, 0,
                         $position * BARWIDTH + BARWIDTH - 1,
                         HEIGHT - 1, $color);
}

header('Content-type:image/png');
imagepng($image);
imagedestroy($image);


sub iterate( byval curr as string, byval start as uinteger,_
             byval stp as uinteger, byval depth as uinteger )
    dim as uinteger i
    for i = start to stp
        if depth = 0 then
            print curr + " " + str(i)
        end if
        iterate( curr+" "+str(i), i+1, stp, depth-1 )
    next i
    return
end sub

dim as uinteger m, n
input "Enter n comb m.  ", n, m
dim as string outstr = ""
iterate outstr, 0, m-1, n-1


# Project : Combinations with repetitions

n = 2
k = 3
temp = []
comb = []
num = com(n, k)
combinations(n, k)
comb = sortfirst(comb, 1)
see showarray(comb) + nl

func combinations(n, k)
while true
         temp = []
         for nr = 1 to k
               tm = random(n-1) + 1
               add(temp, tm)
         next
             add(comb, temp)
         for p = 1  to len(comb) - 1
               for q = p + 1 to len(comb)
                     if (comb[p][1] = comb[q][1]) and (comb[p][2] = comb[q][2]) and (comb[p][3] = comb[q][3])
                        del(comb, p)
                     ok
                next
         next
         if len(comb) = num
            exit
         ok
end

func com(n, k)
        res = pow(n, k)
        return res

func showarray(vect)
        svect = ""
        for nrs = 1 to len(vect)
              svect = "[" + vect[nrs][1] + " " + vect[nrs][2] + " " + vect[nrs][3] + "]" + nl
              see svect
        next

Func sortfirst(alist, ind)
        aList = sort(aList,ind)
        for n = 1 to len(alist)-1
             for m= n + 1 to len(aList)
                  if alist[n][1] = alist[m][1] and alist[m][2] < alist[n][2]
                     temp = alist[n]
                     alist[n] = alist[m]
                     alist[m] = temp
                   ok
             next
        next
        for n = 1 to len(alist)-1
             for m= n + 1 to len(aList)
                  if alist[n][1] = alist[m][1] and alist[n][2] = alist[m][2] and alist[m][3] < alist[n][3]
                     temp = alist[n]
                     alist[n] = alist[m]
                     alist[m] = temp
                   ok
             next
       next
       return aList


possible_doughnuts = ['iced', 'jam', 'plain'].repeated_combination(2)
puts "There are #{possible_doughnuts.count} possible doughnuts:"
possible_doughnuts.each{|doughnut_combi| puts doughnut_combi.join(' and ')}

# Extra credit
possible_doughnuts = [*1..1000].repeated_combination(30)
# size returns the size of the enumerator, or nil if it can’t be calculated lazily.
puts "", "#{possible_doughnuts.size} ways to order 30 donuts given 1000 types."


// Iterator for the combinations of `arr` with `k` elements with repetitions.
// Yields the combinations in lexicographical order.
struct CombinationsWithRepetitions<'a, T: 'a> {
    // source array to get combinations from
    arr: &'a [T],
    // length of the combinations
    k: u32,
    // current counts of each object that represent the next combination
    counts: Vec<u32>,
    // whether there are any combinations left
    remaining: bool,
}

impl<'a, T> CombinationsWithRepetitions<'a, T> {
    fn new(arr: &[T], k: u32) -> CombinationsWithRepetitions<T> {
        let mut counts = vec![0; arr.len()];
        counts[arr.len() - 1] = k;
        CombinationsWithRepetitions {
            arr,
            k,
            counts,
            remaining: true,
        }
    }
}

impl<'a, T> Iterator for CombinationsWithRepetitions<'a, T> {
    type Item = Vec<&'a T>;

    fn next(&mut self) -> Option<Vec<&'a T>> {
        if !self.remaining {
            return None;
        }
        let mut comb = Vec::new();
        for (count, item) in self.counts.iter().zip(self.arr.iter()) {
            for _ in 0..*count {
                comb.push(item);
            }
        }
        // this is lexicographically largest, and thus the last combination
        if self.counts[0] == self.k {
            self.remaining = false;
        } else {
            let n = self.counts.len();
            for i in (1..n).rev() {
                if self.counts[i] > 0 {
                    let original_value = self.counts[i];
                    self.counts[i - 1] += 1;
                    for j in i..(n - 1) {
                        self.counts[j] = 0;
                    }
                    self.counts[n - 1] = original_value - 1;
                    break;
                }
            }
        }
        Some(comb)
    }
}

fn main() {
    let collection = vec!["iced", "jam", "plain"];
    for comb in CombinationsWithRepetitions::new(&collection, 2) {
        for item in &comb {
            print!("{} ", item)
        }
        println!()
    }
}


(call 'clear)

(let Width (in '(tput cols) (read))
   (do (in '(tput lines) (read))
      (for B (range 0 7)
         (call 'tput 'setab B)
         (space (/ Width 8)) )
      (prinl) ) )

(call 'tput 'sgr0)   # reset


To run:
Start up.
Clear the screen.
Divide the screen width by 8 giving a bar width.
Make a bar with 0 and 0 and the bar width and the screen's bottom.
Draw the color bars using the bar.
Refresh the screen.
Wait for the escape key.
Shut down.

To divide the screen width by a number giving a width:
Put the screen's right into the width.
Divide the width by the number.

A bar is a box.

To draw a bar using a color and move it over:
Draw and fill the bar with the color.
Move the bar right the bar's width.

To draw the color bars using a bar:
Draw the bar using the black color and move it over.
Draw the bar using the red color and move it over.
Draw the bar using the green color and move it over.
Draw the bar using the blue color and move it over.
Draw the bar using the magenta color and move it over.
Draw the bar using the cyan color and move it over.
Draw the bar using the yellow color and move it over.
Draw and fill the bar using the white color.


[string[]]$colors = "Black"   , "DarkBlue"   , "DarkGreen" , "DarkCyan",
                    "DarkRed" , "DarkMagenta", "DarkYellow", "Gray",
                    "DarkGray", "Blue"       , "Green"     , "Cyan",
                    "Red"     , "Magenta"    , "Yellow"    , "White"

for ($i = 0; $i -lt 64; $i++)
{
    for ($j = 0; $j -lt $colors.Count; $j++)
    {
        Write-Host (" " * 12) -BackgroundColor $colors[$j] -NoNewline
    }

    Write-Host
}


fullScreen();
noStroke();
color[] cs = {
  color(0),         // black
  color(255,0,0),   // red
  color(0,255,0),   // green
  color(255,0,255), // magenta
  color(0,255,255), // cyan
  color(255,255,0), // yellow
  color(255)        // white
};
for(int i=0; i<7; i++) {
  fill(cs[i]);
  rect(i*width/8,0,width/8,height);
}


5!3 >>> ,,\

$$(5!3) give all combinations of 3 out of 5
$$(>>>) sorted up,
$$(,,\) printed with crlf delimiters.


package main

import (
    "fmt"
)

func main() {
    comb(5, 3, func(c []int) {
        fmt.Println(c)
    })
}

func comb(n, m int, emit func([]int)) {
    s := make([]int, m)
    last := m - 1
    var rc func(int, int)
    rc = func(i, next int) {
        for j := next; j < n; j++ {
            s[i] = j
            if i == last {
                emit(s)
            } else {
                rc(i+1, j+1)
            }
        }
        return
    }
    rc(0, 0)
}


object CombinationsWithRepetition {

  def multi[A](as: List[A], k: Int): List[List[A]] =
    (List.fill(k)(as)).flatten.combinations(k).toList

  def main(args: Array[String]): Unit = {
    val doughnuts = multi(List("iced", "jam", "plain"), 2)
    for (combo <- doughnuts) println(combo.mkString(","))

    val bonus = multi(List(0,1,2,3,4,5,6,7,8,9), 3).size
    println("There are "+bonus+" ways to choose 3 items from 10 choices")
  }
}


(define (combs-with-rep k lst)
  (cond ((= k 0) '(()))
        ((null? lst) '())
        (else
         (append
          (map
           (lambda (x)
             (cons (car lst) x))
           (combs-with-rep (- k 1) lst))
          (combs-with-rep k (cdr lst))))))

(display (combs-with-rep 2 (list "iced" "jam" "plain"))) (newline)
(display (length (combs-with-rep 3 '(1 2 3 4 5 6 7 8 9 10)))) (newline)


#!/usr/bin/env python
#vertical coloured stripes in window in Python 2.7.1

from livewires import *

horiz=640; vert=480
begin_graphics(width=horiz,height=vert,title="v_stripes",background=Colour.black)
NameColors=["black","red","green","dark_blue","purple","blue","yellow","white"]
stepik=horiz/len(NameColors)

for index,each in enumerate(NameColors):
	ExcStrng="set_colour(Colour."+each+")"
	exec ExcStrng
	box(index*stepik,0,(index+1)*stepik,vert,filled=1)

while keys_pressed() != ['x']: # press x key to terminate program
	pass

end_graphics()


pal <- c("black", "red", "green", "blue", "magenta", "cyan", "yellow", "white")
par(mar = rep(0, 4))
image(matrix(1:8), col = pal, axes = FALSE)


#lang racket/gui

(define-values [W H] (get-display-size #t))

(define colors
  '("Black" "Red" "Green" "Blue" "Magenta" "Cyan" "Yellow" "White"))

(define (paint-pinstripe canvas dc)
  (send dc set-pen "black" 0 'transparent)
  (for ([x (in-range 0 W (/ W (length colors)))] [c colors])
    (send* dc (set-brush c 'solid) (draw-rectangle x 0 W H))))

(define full-frame%
  (class frame%
    (define/override (on-subwindow-char r e)
      (when (eq? 'escape (send e get-key-code))
        (send this show #f)))
    (super-new
     [label "Color bars"] [width W] [height H]
     [style '(no-caption no-resize-border hide-menu-bar no-system-menu)])
    (define c (new canvas% [parent this] [paint-callback paint-pinstripe]))
    (send this show #t)))

(void (new full-frame%))


def comb
comb = { m, list ->
    def n = list.size()
    m == 0 ?
        [[]] :
        (0..(n-m)).inject([]) { newlist, k ->
            def sublist = (k+1 == n) ? [] : list[(k+1)..<n]
            newlist += comb(m-1, sublist).collect { [list[k]] + it }
        }
}


comb :: Int -> [a] -> [[a]]
comb 0 _      = [[]]
comb _ []     = []
comb m (x:xs) = map (x:) (comb (m-1) xs) ++ comb m xs


func cwr (n, l, a = []) {
    n>0 ? (^l -> map {|k| __FUNC__(n-1, l.slice(k), [a..., l[k]]) }) : a
}

cwr(2, %w(iced jam plain)).each {|a|
    say a.map{ .join(' ') }.join("\n")
}


let rec combs_with_rep k xxs =
  match k, xxs with
  | 0,  _ -> [[]]
  | _, [] -> []
  | k, x::xs ->
      List.map (fun ys -> x::ys) (combs_with_rep (k-1) xxs)
      @ combs_with_rep k xs


function combrep(v,k) {
	n = cols(v)
	a = J(comb(n+k-1,k),k,v[1])
	u = J(1,k,1)
	for (i=2; 1; i++) {
		for (j=k; j>0; j--) {
			if (u[j]<n) break
		}
		if (j<1) return(a)
		m = u[j]+1
		for (; j<=k; j++) u[j] = m
		a[i,.] = v[u]
	}
}

combrep(("iced","jam","plain"),2)

a = combrep(1..10,3)
rows(a)


/*REXX program  displays  eight colored vertical bars  on a full screen.                */
parse  value  scrsize()  with sd sw .                 /*the screen depth and width.     */
barWidth=sw%8                                         /*calculate the bar width.        */
_.=copies('db'x, barWidth)                            /*the bar, full width.            */
_.8=left(_.,barWidth-1)                               /*the last bar width,  less one.  */
    $ = x2c('1b5b73')  ||  x2c("1b5b313b33376d")      /* the preamble,  and the header. */
hdr.1 = x2c('1b5b303b33306d')                         /*  "  color black.               */
hdr.2 = x2c('1b5b313b33316d')                         /*  "  color red.                 */
hdr.3 = x2c('1b5b313b33326d')                         /*  "  color green.               */
hdr.4 = x2c('1b5b313b33346d')                         /*  "  color blue.                */
hdr.5 = x2c('1b5b313b33356d')                         /*  "  color magenta.             */
hdr.6 = x2c('1b5b313b33366d')                         /*  "  color cyan.                */
hdr.7 = x2c('1b5b313b33336d')                         /*  "  color yellow.              */
hdr.8 = x2c('1b5b313b33376d')                         /*  "  color white.               */
 tail = x2c('1b5b751b5b303b313b33363b34303b306d')     /*  "  epilogue,  and the trailer.*/
                                                      /* [↓]  last bar width is shrunk. */
       do j=1  for 8                                  /*build the line, color by color. */
       $=$ || hdr.j || _.j                            /*append the color header + bar.  */
       end   /*j*/                                    /* [↑]  color order is the list.  */
                                                      /* [↓]  the tail is overkill.     */
$=$ || tail                                           /*append the epilogue (trailer).  */
                                                      /* [↓]  show full screen of bars. */
       do k=1  for sd                                 /*SD = screen depth (from above). */
       say $                                          /*have REXX display line of bars. */
       end   /*k*/                                    /* [↑]  Note:  SD  could be zero. */
                                                      /*stick a fork in it, we're done. */


load "guilib.ring"

new qapp
        {
        win1 = new qwidget() {
               setwindowtitle("drawing using qpainter")
               setwinicon(self,"C:\Ring\bin\image\browser.png")
               setgeometry(100,100,500,600)
               label1 = new qlabel(win1) {
                        setgeometry(10,10,400,400)
                        settext("")
               }
               new qpushbutton(win1) {
                   setgeometry(200,400,100,30)
                   settext("draw")
                   setclickevent("draw()")
               }
               show()
        }
        exec()
        }

func draw
     p1 = new qpicture()
          color = new qcolor() {
          setrgb(0,0,255,255)
     }
     pen = new qpen() {
           setcolor(color)
           setwidth(1)
     }
     new qpainter() {
         begin(p1)
         setpen(pen)

     //Black, Red, Green, Blue, Magenta, Cyan, Yellow, White

     for n = 1 to 8
         color2 = new qcolor(){
         switch n
                on 1 r=0 g=0 b=0
                on 2 r=255 g=0 b=0
                on 3 r=0 g=255 b=0
                on 4 r=0 g=0 b=255
                on 5 r=255 g=0 b=255
                on 6 r=0 g=255 b=255
                on 7 r=255 g=255 b=0
                on 8 r=255 g=255 b=255
           off
           setrgb(r,g,b,255)
           }
           mybrush = new qbrush() {setstyle(1) setcolor(color2)}
           setbrush(mybrush)
           drawrect(n*25,25,25,70)
     next

     endpaint()
     }
     label1 { setpicture(p1) show() }


# Array of web colors black, red, green, blue, magenta, cyan, yellow, white
PALETTE = %w[#000000 #ff0000 #00ff00 #0000ff #ff00ff #00ffff #ffffff].freeze

def settings
  full_screen
end

def setup
  PALETTE.each_with_index do |col, idx|
    fill color(col)
    rect(idx * width / 8, 0, width / 8, height)
  end
end


procedure main()
return combinations(3,5,0)
end

procedure combinations(m,n,z)                      # demonstrate combinations
/z := 1

write(m," combinations of ",n," integers starting from ",z)
every put(L := [], z to n - 1 + z by 1)            # generate list of n items from z
write("Intial list\n",list2string(L))
write("Combinations:")
every write(list2string(lcomb(L,m)))
end

procedure list2string(L)                           # helper function
every (s := "[") ||:= " " || (!L|"]")
return s
end

link lists


100 PROGRAM "Combinat.bas"
110 LET MMAX=3:LET NMAX=5
120 NUMERIC COMB(0 TO MMAX)
130 CALL GENERATE(1)
140 DEF GENERATE(M)
150   NUMERIC N,I
160   IF M>MMAX THEN
170     FOR I=1 TO MMAX
180       PRINT COMB(I);
190     NEXT
200     PRINT
220   ELSE
230     FOR N=0 TO NMAX-1
240       IF M=1 OR N>COMB(M-1) THEN
250         LET COMB(M)=N
260         CALL GENERATE(M+1)
270       END IF
280     NEXT
290   END IF
300 END DEF


func combosWithRep<T>(var objects: [T], n: Int) -> [[T]] {
  if n == 0 { return [[]] } else {
    var combos = [[T]]()
    while let element = objects.last {
      combos.appendContentsOf(combosWithRep(objects, n: n - 1).map{ $0 + [element] })
      objects.removeLast()
    }
    return combos
  }
}
print(combosWithRep(["iced", "jam", "plain"], n: 2).map {$0.joinWithSeparator(" and ")}.joinWithSeparator("\n"))


package require Tcl 8.5
proc combrepl {set n {presorted no}} {
    if {!$presorted} {
        set set [lsort $set]
    }
    if {[incr n 0] < 1} {
	return {}
    } elseif {$n < 2} {
	return $set
    }
    # Recursive call
    set res [combrepl $set [incr n -1] yes]
    set result {}
    foreach item $set {
	foreach inner $res {
	    dict set result [lsort [list $item {*}$inner]] {}
	}
    }
    return [dict keys $result]
}

puts [combrepl {iced jam plain} 2]
puts [llength [combrepl {1 2 3 4 5 6 7 8 9 10} 3]]


use pixels::{Pixels, SurfaceTexture}; // 0.2.0
use winit::event::*; // 0.24.0
use winit::event_loop::{ControlFlow, EventLoop};
use winit::window::{Fullscreen, WindowBuilder};

fn main() {
    let event_loop = EventLoop::new();
    let window = WindowBuilder::new()
        .with_title("Colour Bars")
        .with_decorations(false)
        .with_fullscreen(Some(Fullscreen::Borderless(None)))
        .build(&event_loop).unwrap();
    let size = window.inner_size();
    let texture = SurfaceTexture::new(size.width, size.height, &window);
    let mut image_buffer = Pixels::new(8, 1, texture).unwrap();
    let frame = image_buffer.get_frame();
    frame.copy_from_slice(&[
        0x00, 0x00, 0x00, 0xFF, // black
        0xFF, 0x00, 0x00, 0xFF, // red
        0x00, 0xFF, 0x00, 0xFF, // green
        0x00, 0x00, 0xFF, 0xFF, // blue
        0xFF, 0x00, 0xFF, 0xFF, // magenta
        0x00, 0xFF, 0xFF, 0xFF, // cyan
        0xFF, 0xFF, 0x00, 0xFF, // yellow
        0xFF, 0xFF, 0xFF, 0xFF, // white
    ]);

    image_buffer.render().unwrap();

    event_loop.run(move |ev, _, flow| {
        match ev {
            Event::WindowEvent {
                event: WindowEvent::KeyboardInput { input, .. }, ..
            } => {
                if input.virtual_keycode == Some(VirtualKeyCode::Escape) {
                    *flow = ControlFlow::Exit;
                }
            }
            Event::RedrawRequested(_) | Event::WindowEvent {
                event: WindowEvent::Focused(true), ..
            } => {
                image_buffer.render().unwrap();
            }
            _ => {}
        }
    });
}


import java.awt.Color
import scala.swing._

class ColorBars extends Component {
  override def paintComponent(g:Graphics2D)={
    val colors=List(Color.BLACK, Color.RED, Color.GREEN, Color.BLUE, Color.MAGENTA, Color.CYAN, Color.YELLOW, Color.WHITE)
    val colCount=colors.size
    val deltaX=size.width.toDouble/colCount
    for(x <- 0 until colCount){
      val startX=(deltaX*x).toInt
      val endX=(deltaX*(x+1)).toInt
      g.setColor(colors(x))
      g.fillRect(startX, 0, endX-startX, size.height)
    }
  }
}


require('GD');

var colors = Hash.new(
              white   => [255, 255, 255],
              red     => [255, 0,   0],
              green   => [0,   255, 0],
              blue    => [0,   0,   255],
              magenta => [255, 0,   255],
              yellow  => [255, 255, 0],
              cyan    => [0,   255, 255],
              black   => [0,   0,   0],
             );

var barwidth = 160/8;
var image    = %s'GD::Image'.new(160, 100);
var start    = 0;

colors.values.each { |rgb|
    var paintcolor = image.colorAllocate(rgb...);
    image.filledRectangle(start * barwidth, 0, start*barwidth + barwidth - 1, 99, paintcolor);
    start++;
};

%f'colorbars.png'.open('>:raw').print(image.png);


import java.util.Collections;
import java.util.LinkedList;

public class Comb{

        public static void main(String[] args){
                System.out.println(comb(3,5));
        }

        public static String bitprint(int u){
                String s= "";
                for(int n= 0;u > 0;++n, u>>= 1)
                        if((u & 1) > 0) s+= n + " ";
                return s;
        }

        public static int bitcount(int u){
                int n;
                for(n= 0;u > 0;++n, u&= (u - 1));//Turn the last set bit to a 0
                return n;
        }

        public static LinkedList<String> comb(int c, int n){
                LinkedList<String> s= new LinkedList<String>();
                for(int u= 0;u < 1 << n;u++)
                        if(bitcount(u) == c) s.push(bitprint(u));
                Collections.sort(s);
                return s;
        }
}


#import std
#import nat

cwr = ~&s+ -<&*+ ~&K0=>&^|DlS/~& iota     # takes a set and a selection size

#cast %gLSnX

main = ^|(~&,length) cwr~~/(<'iced','jam','plain'>,2) ('1234567890',3)


' Combinations with repetitions - iterative - VBScript

Sub printc(vi,n,vs)
	Dim i, w
	For i=0 To n-1
		w=w &" "& vs(vi(i))
	Next 'i
	Wscript.Echo w
End Sub

Sub combine(flavors, draws, xitem, tell)
	Dim n, i, j
	ReDim v(draws)
	If tell Then Wscript.Echo "list of cwr("& flavors &","& draws &") :"
	Do While True
		For i=0 To draws-1
			If v(i)>flavors-1 Then
				v(i+1)=v(i+1)+1
				For j=i To 0 Step -1
					v(j)=v(i+1)
				Next 'j
			End If
		Next 'i
		If v(draws)>0 Then Exit Do
		n=n+1
		If tell Then Call printc(v, draws, xitem)
		v(0)=v(0)+1
	Loop
	Wscript.Echo "cwr("& flavors &","& draws &")="&n
End Sub

	items=Array( "iced", "jam", "plain" )
	combine  3, 2, items, True
	combine 10, 3, ,      False
	combine 10, 7, ,      False
	combine 10, 9, ,      False


package require Tcl 8.5
package require Tk 8.5

wm attributes . -fullscreen 1
pack [canvas .c -highlightthick 0] -fill both -expand 1
set colors {black red green blue magenta cyan yellow white}

for {set x 0} {$x < [winfo screenwidth .c]} {incr x 8} {
    .c create rectangle $x 0 [expr {$x+7}] [winfo screenheight .c] \
            -fill [lindex $colors 0] -outline {}
    set colors [list {*}[lrange $colors 1 end] [lindex $colors 0]]
}


#!/bin/sh
clear
WIDTH=`tput cols`
HEIGHT=`tput lines`
NUMBARS=8
BARWIDTH=`expr $WIDTH / $NUMBARS`

l="1"    # Set the line counter to 1
while [ "$l" -lt $HEIGHT ]; do
  b="0"    # Bar counter
  while [ "$b" -lt $NUMBARS ]; do
    tput setab $b
    s="0"
    while [ "$s" -lt $BARWIDTH ]; do
      echo -n " "
      s=`expr $s + 1`
    done
    b=`expr $b + 1`
  done
  echo    # newline
  l=`expr $l + 1`
done

tput sgr0    # reset


import "graphics" for Canvas, Color
import "dome" for Window

class Game {
    static init() {
        Window.title = "Color bars"
        __width = 400
        __height = 400
        Canvas.resize(__width, __height)
        Window.resize(__width, __height)
        var colors = [
            Color.hex("000000"), // black
            Color.hex("FF0000"), // red
            Color.hex("00FF00"), // green
            Color.hex("0000FF"), // blue
            Color.hex("FF00FF"), // magenta
            Color.hex("00FFFF"), // cyan
            Color.hex("FFFF00"), // yellow
            Color.hex("FFFFFF")  // white
        ]
        drawBars(colors)
    }

    static drawBars(colors) {
        var w = __width / colors.count
        var h = __height
        for (i in 0...colors.count) {
            Canvas.rectfill(w*i, 0, w, h, colors[i])
        }
    }

    static update() {}

    static draw(dt) {}
}


function bitprint(u) {
  var s="";
  for (var n=0; u; ++n, u>>=1)
    if (u&1) s+=n+" ";
  return s;
}
function bitcount(u) {
  for (var n=0; u; ++n, u=u&(u-1));
  return n;
}
function comb(c,n) {
  var s=[];
  for (var u=0; u<1<<n; u++)
    if (bitcount(u)==c)
      s.push(bitprint(u))
  return s.sort();
}
comb(3,5)


def combination(r):
  if r > length or r < 0 then empty
  elif r == length then .
  else  ( [.[0]] + (.[1:]|combination(r-1))),
        ( .[1:]|combination(r))
  end;

# select r integers from the set (0 .. n-1)
def combinations(n;r): [range(0;n)] | combination(r);


var combrep // recursive
combrep = Fn.new { |n, lst|
    if (n == 0 ) return [[]]
    if (lst.count == 0) return []
    var r = combrep.call(n, lst[1..-1])
    for (x in combrep.call(n-1, lst)) {
        var y = x.toList
        y.add(lst[0])
        r.add(y)
    }
    return r
}

System.print(combrep.call(2, ["iced", "jam", "plain"]))
System.print(combrep.call(3, (1..10).toList).count)


code ChOut=8, CrLf=9, IntOut=11, Text=12;
int  Count, Array(10);

proc Combos(D, S, K, N, Names); \Generate all size K combinations of N objects
int  D, S, K, N, Names;         \depth of recursion, starting value of N, etc.
int  I;
[if D<K then                    \depth < size
    [for I:= S to N-1 do
        [Array(D):= I;
        Combos(D+1, I, K, N, Names);
        ];
    ]
else [Count:= Count+1;
     if Names(0) then
        [for I:= 0 to K-1 do
            [Text(0, Names(Array(I)));  ChOut(0, ^ )];
        CrLf(0);
        ];
     ];
];

[Count:= 0;
Combos(0, 0, 2, 3, ["iced", "jam", "plain"]);
Text(0, "Combos = ");  IntOut(0, Count);  CrLf(0);
Count:= 0;
Combos(0, 0, 3, 10, [0]);
Text(0, "Combos = ");  IntOut(0, Count);  CrLf(0);
]


include c:\cxpl\codes;       \intrinsic code declarations
int W, X0, X1, Y, C;
[SetVid($13);           \320x200x8 graphics
W:= 320/8;              \width of color bar (pixels)
for C:= 0 to 8-1 do
        [X0:= W*C; X1:= X0+W-1;
        for Y:= 0 to 200-1 do
                [Move(X0, Y); Line(X1, Y, C)];
        ];
C:= ChIn(1);            \wait for keystroke
SetVid(3);              \restore normal text mode
]


using Combinatorics
n = 4
m = 3
for i in combinations(0:n,m)
    println(i')
end


fcn combosK(k,seq){	// repeats, seq is finite
   if (k==1)    return(seq);
   if (not seq) return(T);
   self.fcn(k-1,seq).apply(T.extend.fp(seq[0])).extend(self.fcn(k,seq[1,*]));
}


10 READ n
20 DIM d$(n,5)
30 FOR i=1 TO n
40 READ d$(i)
50 NEXT i
60 DATA 3,"iced","jam","plain"
70 FOR i=1 TO n
80 FOR j=i TO n
90 PRINT d$(i);" ";d$(j)
100 NEXT j
110 NEXT i


class Combinations(val m: Int, val n: Int) {
    private val combination = IntArray(m)

    init {
        generate(0)
    }

    private fun generate(k: Int) {
        if (k >= m) {
            for (i in 0 until m) print("${combination[i]} ")
            println()
        }
        else {
            for (j in 0 until n)
                if (k == 0 || j > combination[k - 1]) {
                    combination[k] = j
                    generate(k + 1)
                }
        }
    }
}

fun main(args: Array<String>) {
    Combinations(3, 5)
}


import std

// combi is an itertor that solves the Combinations problem for iota arrays as stated

def combi(m, n, f):
    let c = map(n): _

    while true:
        f(c)
        var i = n-1
        c[i] = c[i] + 1
        if c[i] > m - 1:
            while c[i] >= m - n + i:
                i -= 1
                if i < 0: return
            c[i] = c[i] + 1
            while i < n-1:
                c[i+1] = c[i] + 1
                i += 1

combi(5, 3): print(_)


to comb :n :list
  if :n = 0 [output [[]]]
  if empty? :list [output []]
  output sentence map [sentence first :list ?] comb :n-1 bf :list ~
                  comb :n bf :list
end
print comb 3 [0 1 2 3 4]


function map(f, a, ...) if a then return f(a), map(f, ...) end end
function incr(k) return function(a) return k > a and a or a+1 end end
function combs(m, n)
  if m * n == 0 then return {{}} end
  local ret, old = {}, combs(m-1, n-1)
  for i = 1, n do
    for k, v in ipairs(old) do ret[#ret+1] = {i, map(incr(i), unpack(v))} end
  end
  return ret
end

for k, v in ipairs(combs(3, 5)) do print(unpack(v)) end


Module Checkit {
      Global a$
      Document a$
      Module Combinations (m as long, n as long){
            Module Level (n, s, h)   {
                  If n=1 then {
                        while Len(s) {
                               Print h, car(s)
                               ToClipBoard()
                               s=cdr(s)
                         }
                  } Else {
                        While len(s) {
                              call Level n-1, cdr(s),  cons(h, car(s))
                              s=cdr(s)
                        }
                  }
                  Sub ToClipBoard()
                        local m=each(h)
                        Local b$=""
                        While m {
                              b$+=If$(Len(b$)<>0->" ","")+Format$("{0::-10}",Array(m))
                        }
                        b$+=If$(Len(b$)<>0->" ","")+Format$("{0::-10}",Array(s,0))+{
                        }
                        a$<=b$   ' assign to global need <=
                  End Sub
            }
            If m<1 or n<1 then Error
            s=(,)
            for i=0 to n-1 {
                  s=cons(s, (i,))
            }
            Head=(,)
            Call Level m,  s, Head
      }
      Clear a$
      Combinations 3, 5
      ClipBoard a$
}
Checkit


combinations[n_Integer, m_Integer]/;m>= 0:=Union[Sort /@ Permutations[Range[0, n - 1], {m}]]


MODULE Combinations;
FROM STextIO IMPORT
  WriteString, WriteLn;
FROM SWholeIO IMPORT
  WriteInt;

CONST
  MMax = 3;
  NMax = 5;

VAR
  Combination: ARRAY [0 .. MMax] OF CARDINAL;

PROCEDURE Generate(M: CARDINAL);
VAR
  N, I: CARDINAL;
BEGIN
  IF (M > MMax) THEN
    FOR I := 1 TO MMax DO
      WriteInt(Combination[I], 1);
      WriteString(' ');
    END;
    WriteLn;
  ELSE
    FOR N := 1 TO NMax DO
      IF (M = 1) OR (N > Combination[M - 1]) THEN
        Combination[M] := N;
        Generate(M + 1);
      END
    END
  END
END Generate;

BEGIN
  Generate(1);
END Combinations.


iterator comb(m, n: int): seq[int] =
  var c = newSeq[int](n)
  for i in 0 ..< n: c[i] = i

  block outer:
    while true:
      yield c

      var i = n - 1
      inc c[i]
      if c[i] <= m - 1: continue

      while c[i] >= m - n + i:
        dec i
        if i < 0: break outer
      inc c[i]
      while i < n-1:
        c[i+1] = c[i] + 1
        inc i

for i in comb(5, 3):
  echo i


let combinations m n =
  let rec c = function
    | (0,_) -> [[]]
    | (_,0) -> []
    | (p,q) -> List.append
               (List.map (List.cons (n-q)) (c (p-1, q-1)))
               (c (p , q-1))
  in c (m , n)

let () =
  let rec print_list = function
    | [] -> print_newline ()
    | hd :: tl -> print_int hd ; print_string " "; print_list tl
  in List.iter print_list (combinations 3 5)


define variable r as integer no-undo extent 3.
define variable m as integer no-undo initial 5.
define variable n as integer no-undo initial 3.
define variable max_n as integer no-undo.

max_n = m - n.

function combinations returns logical (input pos as integer, input val as integer):
  define variable i as integer no-undo.
  do i = val to max_n:
    r[pos] = pos + i.
	if pos lt n then
		combinations(pos + 1, i).
	else
	 	message r[1] - 1 r[2] - 1 r[3] - 1.
  end.
end function.

combinations(1, 0).


declare
  fun {Comb M N}
     proc {CombScript Comb}
        %% Comb is a subset of [0..N-1]
        Comb = {FS.var.upperBound {List.number 0 N-1 1}}
        %% Comb has cardinality M
        {FS.card Comb M}
        %% enumerate all possibilities
        {FS.distribute naive [Comb]}
     end
  in
     %% Collect all solutions and convert to lists
     {Map {SearchAll CombScript} FS.reflect.upperBoundList}
  end
in
  {Inspect {Comb 3 5}}


Program Combinations;

const
 m_max = 3;
 n_max = 5;
var
 combination: array [0..m_max] of integer;

 procedure generate(m: integer);
  var
   n, i: integer;
  begin
   if (m > m_max) then
    begin
    for i := 1 to m_max do
     write (combination[i], ' ');
    writeln;
    end
   else
    for n := 1 to n_max do
     if ((m = 1) or (n > combination[m-1])) then
      begin
       combination[m] := n;
       generate(m + 1);
      end;
   end;

begin
 generate(1);
end.


use ntheory qw/forcomb/;
forcomb { print "@_\n" } 5,3


use perl5i::2;

# ----------------------------------------
# generate combinations of length $n consisting of characters
# from the sorted set @set, using each character once in a
# combination, with sorted strings in sorted order.
#
# Returns a list of array references, each containing one combination.
#
func combine($n, @set) {
  return unless @set;
  return map { [ $_ ] } @set if $n == 1;

  my ($head) = shift @set;
  my @result = combine( $n-1, @set );
  for my $subarray ( @result ) {
   $subarray->unshift( $head );
  }
  return ( @result, combine( $n, @set ) );
}

say @$_ for combine( 3, ('a'..'e') );


with javascript_semantics
procedure comb(integer pool, needed, done=0, sequence chosen={})
    if needed=0 then    -- got a full set
        ?chosen         -- (or use a routine_id, result arg, or whatever)
        return
    end if
    if done+needed>pool then return end if -- cannot fulfil
    -- get all combinations with and without the next item:
    done += 1
    comb(pool,needed-1,done,append(deep_copy(chosen),done))
    comb(pool,needed,done,chosen)
end procedure

comb(5,3)


(de comb (M Lst)
   (cond
      ((=0 M) '(NIL))
      ((not Lst))
      (T
         (conc
            (mapcar
               '((Y) (cons (car Lst) Y))
               (comb (dec M) (cdr Lst)) )
            (comb M (cdr Lst)) ) ) ) )

(comb 3 (1 2 3 4 5))


define comb(n, m);
    lvars ress = [];
    define do_combs(l, m, el_lst);
        lvars i;
        if m = 0 then
            cons(rev(el_lst), ress) -> ress;
        else
            for i from l to n - m do
                do_combs(i + 1, m - 1, cons(i, el_lst));
            endfor;
        endif;
    enddefine;
    do_combs(0, m, []);
    rev(ress);
enddefine;

comb(5, 3) ==>


$source = @'
    using System;
    using System.Collections.Generic;

    namespace Powershell
    {
        public class CSharp
        {
            public static IEnumerable<int[]> Combinations(int m, int n)
            {
                int[] result = new int[m];
                Stack<int> stack = new Stack<int>();
                stack.Push(0);

                while (stack.Count > 0) {
                    int index = stack.Count - 1;
                    int value = stack.Pop();

                    while (value < n) {
                        result[index++] = value++;
                        stack.Push(value);
                        if (index == m) {
                            yield return result;
                            break;
                        }
                    }
                }
            }
        }
    }
'@

Add-Type -TypeDefinition $source -Language CSharp

[Powershell.CSharp]::Combinations(3,5) | Format-Wide {$_} -Column 3 -Force


:- use_module(library(clpfd)).

comb_clpfd(L, M, N) :-
    length(L, M),
    L ins 1..N,
    chain(L, #<),
    label(L).


comb m n = comb m (0..n-1) with
  comb 0 _ = [[]];
  comb _ [] = [];
  comb m (x:xs) = [x:xs | xs = comb (m-1) xs] + comb m xs;
end;

comb 3 5;


Procedure.s Combinations(amount, choose)
  NewList comb.s()
  ; all possible combinations with {amount} Bits
  For a = 0 To 1 << amount
    count = 0
    ; count set bits
    For x = 0 To amount
      If (1 << x)&a
        count + 1
      EndIf
    Next
    ; if set bits are equal to combination length
    ; we generate a String representing our combination and add it to list
    If count = choose
      string$ = ""
      For x = 0 To amount
        If (a >> x)&1
          ; replace x by x+1 to start counting with 1
          String$ + Str(x) + " "
        EndIf
      Next
      AddElement(comb())
      comb() = string$
    EndIf
  Next
  ; now we sort our list and format it for output as string
  SortList(comb(), #PB_Sort_Ascending)
  ForEach comb()
    out$ + ", [ " + comb() + "]"
  Next
  ProcedureReturn Mid(out$, 3)
EndProcedure

Debug Combinations(5, 3)


fun combos<a>(lst :: List<a>, size :: Number) -> List<List<a>>:
  # return all subsets of lst of a certain size,
  # maintaining the original ordering of the list

  # Let's handle a bunch of degenerate cases up front
  # to be defensive...
  if lst.length() < size:
    # return an empty list if size is too big
    [list:]
  else if lst.length() == size:
    # combos([list: 1,2,3,4]) == list[list: 1,2,3,4]]
    [list: lst]
  else if size == 1:
    # combos(list: 5, 9]) == list[[list: 5], [list: 9]]
    lst.map(lam(elem): [list: elem] end)
  else:
    # The main resursive step here is to consider
    # all the combinations of the list that have the
    # first element (aka head) and then those that don't
    # don't.
    cases(List) lst:
      | empty => [list:]
      | link(head, rest) =>
        # All the subsets of our list either include the
        # first element of the list (aka head) or they don't.
        with-head-combos = combos(rest, size - 1).map(
          lam(combo):
          link(head, combo) end
          )
        without-head-combos = combos(rest, size)
        with-head-combos._plus(without-head-combos)
    end
  end
where:
  # define semantics for the degenerate cases, although
  # maybe we should just make some of these raise errors
  combos([list:], 0) is [list: [list:]]
  combos([list:], 1) is [list:]
  combos([list: "foo"], 1) is [list: [list: "foo"]]
  combos([list: "foo"], 2) is [list:]

  # test the normal stuff
  lst = [list: 1, 2, 3]
  combos(lst, 1) is [list:
    [list: 1],
    [list: 2],
    [list: 3]
  ]
  combos(lst, 2) is [list:
    [list: 1, 2],
    [list: 1, 3],
    [list: 2, 3]
  ]
  combos(lst, 3) is [list:
    [list: 1, 2, 3]
  ]

  # remember the 10th row of Pascal's Triangle? :)
  lst10 = [list: 1,2,3,4,5,6,7,8,9,10]
  combos(lst10, 3).length() is 120
  combos(lst10, 4).length() is 210
  combos(lst10, 5).length() is 252
  combos(lst10, 6).length() is 210
  combos(lst10, 7).length() is 120

  # more sanity checks...
  for each(sublst from combos(lst10, 6)):
    sublst.length() is 6
  end

  for each(sublst from combos(lst10, 9)):
    sublst.length() is 9
  end
end

fun int-combos(n :: Number, m :: Number) -> List<List<Number>>:
  doc: "return all lists of size m containing distinct, ordered nonnegative ints < n"
  lst = range(0, n)
  combos(lst, m)
where:
  int-combos(5, 5) is [list: [list: 0,1,2,3,4]]
  int-combos(3, 2) is [list:
    [list: 0, 1],
    [list: 0, 2],
    [list: 1, 2]
  ]
end

fun display-3-comb-5-for-rosetta-code():
  # The very concrete nature of this function is driven
  # by the web page from Rosetta Code.  We want to display
  # output similar to the top of this page:
  #
  # https://rosettacode.org/wiki/Combinations
  results = int-combos(5, 3)
  for each(lst from results):
    print(lst.join-str(" "))
  end
end

display-3-comb-5-for-rosetta-code()


  [ 0 swap
    [ dup 0 != while
      dup 1 & if
        [ dip 1+ ]
      1 >> again ]
    drop ]                     is bits      (   n --> n )

  [ [] unrot
    bit times
      [ i bits
        over = if
          [ dip
              [ i join ] ] ]
    drop ]                     is combnums  ( n n --> [ )

  [ [] 0 rot
    [ dup 0 != while
      dup 1 & if
        [ dip
            [ dup dip join ] ]
       dip 1+
       1 >>
       again ]
    2drop ]                    is makecomb  (   n --> [ )

  [ over 0 = iff
      [ 2drop [] ] done
    combnums
    [] swap witheach
       [ makecomb
         nested join ] ]       is comb      ( n n --> [ )

  [ behead swap witheach max ] is largest   (   [ --> n )

  [ 0 rot witheach
      [ [ dip [ over * ] ] + ]
    nip ]                      is comborder ( [ n --> n )

  [ dup [] != while
    sortwith
      [ 2dup join
        largest 1+ dup dip
          [ comborder swap ]
        comborder < ] ]        is sortcombs (   [ --> [ )

  3 5 comb
  sortcombs
  witheach [ witheach [ echo sp ] cr ]


(define sublists
  (match-lambda**
   [(0 _)           '(())]
   [(_ '())         '()]
   [(m (cons x xs)) (append (map (curry cons x) (sublists (- m 1) xs))
                            (sublists m xs))]))

(define (combinations n m)
  (sublists n (range m)))


/*REXX program displays   combination sets   for   X   things taken   Y   at a time.    */
parse arg x y $ .                                /*get optional arguments from the C.L. */
if x=='' | x==","  then x= 5                     /*No  X  specified?   Then use default.*/
if y=='' | y==","  then y= 3;  oy= y;  y= abs(y) /* "  Y      "          "   "     "    */
if $=='' | $==","  then $='123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ',
                          "[email protected]#$%^&*()_+`{}|[]\:;<>?,./█┌┐└┘±≥≤≈∙" /*some extended chars*/
                                                 /* [↑]  No  $  specified?  Use default.*/
if y>x             then do;    say y  " can't be greater than "   x;        exit 1;    end
say "────────────"             x            ' things taken '        y        " at a time:"
say "────────────"       combN(x,y)         ' combinations.'
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
combN:  procedure expose $ oy;  parse arg x,y;      xp= x+1;      xm= xp-y;         !.= 0
                                                    if x=0 | y=0  then return 'no'
                                do i=1  for y;      !.i= i
                                end   /*i*/
                  do j=1;  L=
                                do d=1  for y;      L= L substr($, !.d, 1)
                                end   /*d*/
                  if oy>0  then say L;              !.y= !.y + 1   /*don't show if OY<0 */
                  if !.y==xp  then  if .combN(y-1)  then leave
                  end   /*j*/
        return j
/*──────────────────────────────────────────────────────────────────────────────────────*/
.combN: procedure expose !. y xm;  parse arg d;  if d==0  then return 1;            p= !.d
                  do u=d  to y;  !.u= p+1;  if !.u==xm+u  then return .combN(u-1);  p= !.u
                  end   /*u*/                    /*                       ↑             */
        return 0                                 /*recursive call──►──────┘             */


# Project : Combinations

n = 5
k = 3
temp = []
comb = []
num = com(n, k)
while true
         temp = []
         for n = 1 to 3
               tm = random(4) + 1
               add(temp, tm)
         next
         bool1 = (temp[1] = temp[2]) and (temp[1] = temp[3]) and (temp[2] = temp[3])
         bool2 = (temp[1] < temp[2]) and (temp[2] < temp[3])
         if not bool1 and bool2
            add(comb, temp)
         ok
         for p = 1  to len(comb) - 1
               for q = p + 1 to len(comb)
                     if (comb[p][1] = comb[q][1]) and (comb[p][2] = comb[q][2]) and (comb[p][3] = comb[q][3])
                        del(comb, p)
                     ok
                next
         next
         if len(comb) = num
            exit
         ok
end
comb = sortfirst(comb, 1)
see showarray(comb) + nl

func com(n, k)
        res1 = 1
        for n1 = n - k + 1 to n
             res1 = res1 * n1
        next
        res2 = 1
        for n2 = 1 to k
              res2 = res2 * n2
        next
        res3 = res1/res2
        return res3

func showarray(vect)
        svect = ""
        for nrs = 1 to len(vect)
              svect = "[" + vect[nrs][1] + " " + vect[nrs][2] + " " + vect[nrs][3] + "]" + nl
              see svect
        next

Func sortfirst(alist, ind)
        aList = sort(aList,ind)
        for n = 1 to len(alist)-1
             for m= n + 1 to len(aList)
                  if alist[n][1] = alist[m][1] and alist[m][2] < alist[n][2]
                     temp = alist[n]
                     alist[n] = alist[m]
                     alist[m] = temp
                   ok
             next
        next
        for n = 1 to len(alist)-1
             for m= n + 1 to len(aList)
                  if alist[n][1] = alist[m][1] and alist[n][2] = alist[m][2] and alist[m][3] < alist[n][3]
                     temp = alist[n]
                     alist[n] = alist[m]
                     alist[m] = temp
                   ok
             next
       next
       return aList


fn comb<T: std::fmt::Default>(arr: &[T], n: uint) {
  let mut incl_arr: ~[bool] = std::vec::from_elem(arr.len(), false);
  comb_intern(arr, n, incl_arr, 0);
}

fn comb_intern<T: std::fmt::Default>(arr: &[T], n: uint, incl_arr: &mut [bool], index: uint) {
  if (arr.len() < n + index) { return; }
  if (n == 0) {
    let mut it = arr.iter().zip(incl_arr.iter()).filter_map(|(val, incl)|
      if (*incl) { Some(val) } else { None }
    );
    for val in it { print!("{} ", *val); }
    print("\n");
    return;
  }

  incl_arr[index] = true;
  comb_intern(arr, n-1, incl_arr, index+1);
  incl_arr[index] = false;

  comb_intern(arr, n, incl_arr, index+1);
}

fn main() {
  let arr1 = ~[1, 2, 3, 4, 5];
  comb(arr1, 3);

  let arr2 = ~["A", "B", "C", "D", "E"];
  comb(arr2, 3);
}


implicit def toComb(m: Int) = new AnyRef {
  def comb(n: Int) = recurse(m, List.range(0, n))
  private def recurse(m: Int, l: List[Int]): List[List[Int]] = (m, l) match {
    case (0, _)   => List(Nil)
    case (_, Nil) => Nil
    case _        => (recurse(m - 1, l.tail) map (l.head :: _)) ::: recurse(m, l.tail)
  }
}


(define (comb m lst)
  (cond ((= m 0) '(()))
        ((null? lst) '())
        (else (append (map (lambda (y) (cons (car lst) y))
                           (comb (- m 1) (cdr lst)))
                      (comb m (cdr lst))))))

(comb 3 '(0 1 2 3 4))


$ include "seed7_05.s7i";

const type: combinations is array array integer;

const func combinations: comb (in array integer: arr, in integer: k) is func
  result
    var combinations: combResult is combinations.value;
  local
    var integer: x is 0;
    var integer: i is 0;
    var array integer: suffix is 0 times 0;
  begin
    if k = 0 then
      combResult := 1 times 0 times 0;
    else
      for x key i range arr do
        for suffix range comb(arr[succ(i) ..], pred(k)) do
          combResult &:= [] (x) & suffix;
        end for;
      end for;
    end if;
  end func;

const proc: main is func
  local
    var array integer: aCombination is 0 times 0;
    var integer: element is 0;
  begin
    for aCombination range comb([] (0, 1, 2, 3, 4), 3) do
      for element range aCombination do
        write(element lpad 3);
      end for;
      writeln;
    end for;
  end func;


program combin
tempfile cp
tempvar k
gen `k'=1
quietly save "`cp'"
rename `1' `1'1
forv i=2/`2' {
	joinby `k' using "`cp'"
	rename `1' `1'`i'
	quietly drop if `1'`i'<=`1'`=`i'-1'
}
sort `1'*
end


func addCombo(prevCombo: [Int], var pivotList: [Int]) -> [([Int], [Int])] {

  return (0..<pivotList.count)
    .map {
      _ -> ([Int], [Int]) in
      (prevCombo + [pivotList.removeAtIndex(0)], pivotList)
    }
}
func combosOfLength(n: Int, m: Int) -> [[Int]] {

  return [Int](1...m)
    .reduce([([Int](), [Int](0..<n))]) {
      (accum, _) in
      accum.flatMap(addCombo)
    }.map {
      $0.0
    }
}

println(combosOfLength(5, 3))


proc comb {m n} {
    set set [list]
    for {set i 0} {$i < $n} {incr i} {lappend set $i}
    return [combinations $set $m]
}
proc combinations {list size} {
    if {$size == 0} {
        return [list [list]]
    }
    set retval {}
    for {set i 0} {($i + $size) <= [llength $list]} {incr i} {
        set firstElement [lindex $list $i]
        set remainingElements [lrange $list [expr {$i + 1}] end]
        foreach subset [combinations $remainingElements [expr {$size - 1}]] {
            lappend retval [linsert $subset 0 $firstElement]
        }
    }
    return $retval
}

comb 3 5 ;# ==> {0 1 2} {0 1 3} {0 1 4} {0 2 3} {0 2 4} {0 3 4} {1 2 3} {1 2 4} {1 3 4} {2 3 4}


(defun comb-n-m (n m)
  (comb (range* 0 n) m))

(put-line `3 comb 5 = @(comb-n-m 5 3)`)


choices = ^([email protected],~&l); [email protected]^& ~&al?\&! ~&arh2fabt2RDfalrtPXPRT


[comb [m lst] let
   [ [m zero?] [[[]]]
     [lst null?] [[]]
     [true] [m pred lst rest comb [lst first swap cons]  map
            m lst rest comb concat]
   ] when].


Option Explicit
Option Base 0
'Option Base 1

Private ArrResult

Sub test()
    'compute
    Main_Combine 5, 3

    'return
    Dim j As Long, i As Long, temp As String
    For i = LBound(ArrResult, 1) To UBound(ArrResult, 1)
        temp = vbNullString
        For j = LBound(ArrResult, 2) To UBound(ArrResult, 2)
            temp = temp & " " & ArrResult(i, j)
        Next
        Debug.Print temp
    Next
    Erase ArrResult
End Sub

Private Sub Main_Combine(M As Long, N As Long)
Dim MyArr, i As Long
    ReDim MyArr(M - 1)
    If LBound(MyArr) > 0 Then ReDim MyArr(M) 'Case Option Base 1
    For i = LBound(MyArr) To UBound(MyArr)
        MyArr(i) = i
    Next i
    i = IIf(LBound(MyArr) > 0, N, N - 1)
    ReDim ArrResult(i, LBound(MyArr))
    Combine MyArr, N, LBound(MyArr), LBound(MyArr)
    ReDim Preserve ArrResult(UBound(ArrResult, 1), UBound(ArrResult, 2) - 1)
    'In VBA Excel we can use Application.Transpose instead of personal Function Transposition
    ArrResult = Transposition(ArrResult)
End Sub

Private Sub Combine(MyArr As Variant, Nb As Long, Deb As Long, Ind As Long)
Dim i As Long, j As Long, N As Long
    For i = Deb To UBound(MyArr, 1)
        ArrResult(Ind, UBound(ArrResult, 2)) = MyArr(i)
        N = IIf(LBound(ArrResult, 1) = 0, Nb - 1, Nb)
        If Ind = N Then
            ReDim Preserve ArrResult(UBound(ArrResult, 1), UBound(ArrResult, 2) + 1)
            For j = LBound(ArrResult, 1) To UBound(ArrResult, 1)
                ArrResult(j, UBound(ArrResult, 2)) = ArrResult(j, UBound(ArrResult, 2) - 1)
            Next j
        Else
            Call Combine(MyArr, Nb, i + 1, Ind + 1)
        End If
    Next i
End Sub

Private Function Transposition(ByRef MyArr As Variant) As Variant
Dim T, i As Long, j As Long
    ReDim T(LBound(MyArr, 2) To UBound(MyArr, 2), LBound(MyArr, 1) To UBound(MyArr, 1))
    For i = LBound(MyArr, 1) To UBound(MyArr, 1)
        For j = LBound(MyArr, 2) To UBound(MyArr, 2)
            T(j, i) = MyArr(i, j)
        Next j
    Next i
    Transposition = T
    Erase T
End Function


Function Dec2Bin(n)
	q = n
	Dec2Bin = ""
	Do Until q = 0
		Dec2Bin = CStr(q Mod 2) & Dec2Bin
		q = Int(q / 2)
	Loop
	Dec2Bin = Right("00000" & Dec2Bin,6)
End Function

Sub Combination(n,k)
	Dim arr()
	ReDim arr(n-1)
	For h = 0 To n-1
		arr(h) = h + 1
	Next
	Set list = CreateObject("System.Collections.Arraylist")
	For i = 1 To 2^n
		bin = Dec2Bin(i)
		c = 0
		tmp_combo = ""
		If Len(Replace(bin,"0","")) = k Then
			For j = Len(bin) To 1 Step -1
				If CInt(Mid(bin,j,1)) = 1 Then
					tmp_combo = tmp_combo & arr(c) & ","
				End If
				c = c + 1
			Next
			list.Add Mid(tmp_combo,1,(k*2)-1)
		End If
	Next
	list.Sort
	For l = 0 To list.Count-1
		WScript.StdOut.Write list(l)
		WScript.StdOut.WriteLine
	Next
End Sub

'Testing with n = 5 / k = 3
Call Combination(5,3)


import "./perm" for Comb

var fib = Fiber.new { Comb.generate((0..4).toList, 3) }
while (true) {
    var c = fib.call()
    if (!c) return
    System.print(c)
}


code ChOut=8, CrLf=9, IntOut=11;
def M=3, N=5;
int A(N-1);

proc Combos(D, S);      \Display all size M combinations of N in sorted order
int  D, S;              \depth of recursion, starting value of N
int  I;
[if D<M then            \depth < size
      for I:= S to N-1 do
        [A(D):= I;
        Combos(D+1, I+1);
        ]
else [for I:= 0 to M-1 do
        [IntOut(0, A(I));  ChOut(0, ^ )];
     CrLf(0);
     ];
];

Combos(0, 0)


fcn comb(k,seq){	// no repeats, seq is finite
   seq=seq.makeReadOnly();	// because I append to parts of seq
   fcn(k,seq){
      if(k<=0)    return(T(T));
      if(not seq) return(T);
      self.fcn(k-1,seq[1,*]).pump(List,seq[0,1].extend)
	   .extend(self.fcn(k,seq[1,*]));
   }(k,seq);
}


LDA $0200 ;get the color of the top-left pixel of the screen
LDA $05FF ;get the color of the bottom-right pixel of the screen.


;input: cx = x coordinate of pixel, dx = y coordinate of pixel, bh = page number
mov ah,0Dh
int 10h


PROC Main()
  BYTE POINTER ptr
  BYTE
    w=[160],h=[160],x=[0],y=[0],c,k,update=[1],
    CH=$02FC ;Internal hardware value for last key pressed
  CARD size=[6400],i

  Graphics(15) ;Graphics 160x160 with 4 colors with text window
  ptr=PeekC(88)

  ; Fill screen with random colors
  FOR i=1 TO size
  DO
    ptr^=Rand(0)
    ptr==+1
  OD

  PrintE("Use arrow keys to change position and Esc to exit.")
  DO
    IF update THEN
      c=Locate(x,y)
      PrintF("x=%B y=%B c=%B%E",x,y,c)
    FI

    k=CH
    CH=$FF
    update=1
    IF k=134 THEN
      IF x=0 THEN x=w-1
      ELSE x==-1 FI
    ELSEIF k=135 THEN
      IF x=w-1 THEN x=0
      ELSE x==+1 FI
    ELSEIF k=142 THEN
      IF y=0 THEN y=h-1
      ELSE y==-1 FI
    ELSEIF k=143 THEN
      IF y=h-1 THEN y=0
      ELSE y==+1 FI
    ELSEIF k=28 THEN
      EXIT
    ELSE
      update=0
    FI
  OD
RETURN


Opt('MouseCoordMode',1)  ; 1 = (default) absolute screen coordinates
$pos = MouseGetPos()
$c   = PixelGetColor($pos[0], $pos[1])
ConsoleWrite("Color at x=" & $pos[0] & ",y=" & $pos[1] & _
		" ==> " & $c & " = 0x" & Hex($c) & @CRLF)


INCLUDE canvas
FULLSCREEN
color = GETINK(100, 100, 4)
WAITKEY


MOUSE ON

WHILE 1
  m=MOUSE(0)
  PRINT POINT(MOUSE(1),MOUSE(2))
WEND


'Example: Find color of a screen pixel in QBasic (adapted from QBasic Help file).
'  POINT(x%, y%)  returns color of pixel at coordinates x,y.
SCREEN 7   'Choose color graphics screen (1,2,4,7,8,9,11,12,13).
LINE (0, 0)-(100, 100), 2  'Draw diagonal line in color attribute 2.
LOCATE 14, 1               'Locate below diagonal line to show output.
FOR y% = 1 TO 10
  FOR x% = 1 TO 10
    PRINT POINT(x%, y%);   'POINT(x%, y%) displays pixel color.
  NEXT x%
  PRINT
NEXT y%
END


#include <X11/Xlib.h>
void
get_pixel_color (Display *d, int x, int y, XColor *color)
{
  XImage *image;
  image = XGetImage (d, RootWindow (d, DefaultScreen (d)), x, y, 1, 1, AllPlanes, XYPixmap);
  color->pixel = XGetPixel (image, 0, 0);
  XFree (image);
  XQueryColor (d, DefaultColormap(d, DefaultScreen (d)), color);
}

// Your code
XColor c;
get_pixel_color (display, 30, 40, &c);
printf ("%d %d %d\n", c.red, c.green, c.blue);


using System;
using System.Drawing;
using System.Windows.Forms;

class Program
{
    static Color GetPixel(Point position)
    {
        using (var bitmap = new Bitmap(1, 1))
        {
            using (var graphics = Graphics.FromImage(bitmap))
            {
                graphics.CopyFromScreen(position, new Point(0, 0), new Size(1, 1));
            }
            return bitmap.GetPixel(0, 0);
        }
    }

    static void Main()
    {
        Console.WriteLine(GetPixel(Cursor.Position));
    }
}


using namespace System;
using namespace System::Drawing;
using namespace System::Windows::Forms;

[STAThreadAttribute]
int main()
{
	Point^ MousePoint = gcnew Point();
	Control^ TempControl = gcnew Control();
	MousePoint = TempControl->MousePosition;
	Bitmap^ TempBitmap = gcnew Bitmap(1,1);
	Graphics^ g = Graphics::FromImage(TempBitmap);
	g->CopyFromScreen((Point)MousePoint, Point(0, 0), Size(1, 1));
	Color color = TempBitmap->GetPixel(0,0);
	Console::WriteLine("R: "+color.R.ToString());
	Console::WriteLine("G: "+color.G.ToString());
	Console::WriteLine("B: "+color.B.ToString());
}


(defn get-color-at [x y]
  (.getPixelColor (java.awt.Robot.) x y))


(in-package :cg-user)

(defun print-hex (n)
  (let ((*print-base* 16.) (*print-radix* t))
    (print n)) t)

(defun get-byte (n byte)
  (logand (ash n (* byte -8)) #xFF))

(defun get-pixel (x y)
  (let ((pixval (caar (contents (get-screen-pixmap :box (make-box x y (+ x 1) (+ y 1)))))))
    (mapcar #'(lambda (i) (get-byte pixval i)) '(2 1 0 3))))

(defun get-mouse-pixel ()
  (let ((pos (cursor-position (screen *system*))))
    (get-pixel (position-x pos) (position-y pos))))

(print-hex (get-mouse-pixel))


program ScreenPixel;

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils,
  Graphics;

// Use this function in a GUI application to return the color
function GetPixelColourAsColor(const PixelCoords: TPoint): TColor;
var
  dc: HDC;
begin
  // Get Device Context of windows desktop
  dc := GetDC(0);
  // Read the color of the pixel at the given coordinates
  Result := GetPixel(dc,PixelCoords.X,PixelCoords.Y);
end;

// Use this function to get a string representation of the current colour
function GetPixelColourAsString(const PixelCoords: TPoint): string;
var
  r,g,b: Byte;
  col: TColor;
begin
  col := GetPixelColourAsColor(PixelCoords);

  // Convert the Delphi TColor value to it's RGB components
  r := col and $FF;
  g := (col shr 8) and $FF;
  b := (col shr 16) and $FF;

  // Format the result
  Result := 'R('+IntToStr(r)+') G('+IntToStr(g)+') G('+IntToStr(b)+')';

  {
    Alternatively, format the result as follows to get a
    string representation of the Delphi TColor value

    Result := ColorToString(GetPixel(dc,curP.X,curP.Y));
  }

end;

var
  s: string;
  P: TPoint;
begin
  s := '';

  Writeln('Move mouse over a pixel. Hit return to get colour of selected pixel.');

  repeat
    Readln(s);
    if s = '' then
      begin
        GetCursorPos(P);
        Writeln('Colour at cursor position X:'+
                IntToStr(P.X)+' Y:'+
                IntToStr(P.Y) +' = '+
                GetPixelColourAsString(P)
                );
        Writeln('');
        Writeln('Move mouse and hit enter again.');
      end;
  until
    SameText(s,'quit');

end.


open System.Drawing
open System.Windows.Forms

let GetPixel x y =
    use img = new Bitmap(1,1)
    use g = Graphics.FromImage(img)
    g.CopyFromScreen(new Point(x,y), new Point(0,0), new Size(1,1))
    let clr = img.GetPixel(0,0)
    (clr.R, clr.G, clr.B)

let GetPixelAtMouse () =
    let pt = Cursor.Position
    GetPixel pt.X pt.Y


package main

import (
    "fmt"
    "github.com/go-vgo/robotgo"
)

func main() {
    // get position of mouse cursor
    x, y := robotgo.GetMousePos()

    // get color of pixel at that position
    color := robotgo.GetPixelColor(x, y)
    fmt.Printf("Color of pixel at (%d, %d) is 0x%s\n", x, y, color)
}


import java.awt.Robot

class GetPixelColor {
    static void main(args) {
        println getColorAt(args[0] as Integer, args[1] as Integer)
    }

    static getColorAt(x, y) {
        new Robot().getPixelColor(x, y)
    }
}


link graphics,printf

procedure main()

   WOpen("canvas=hidden")                   # hide for query
   height := WAttrib("displayheight") - 45  # adjust for ...
   width  := WAttrib("displaywidth") - 20   # ... window 7 borders
   WClose(&window)

   W := WOpen("size="||width||","||height,"bg=black") |
        stop("Unable to open window")

   every 1 to 10 do {   # generate some random rectangles within the frame
      x := ?width
      y := ?(height-100)
      WAttrib("fg="||?["red","green","blue","purple","yellow"])
      FillRectangle(x,x+50,y,y+50)
      }

   while Event() do
      printf("x=%d,y=%d pixel=%s\n",&x,&y,Pixel(&x,&y,&x,&y))

   WDone(W)                                  # q to exit
end


GetDC=:        'user32.dll GetDC >i i'&cd NB. hdx: GetDC hwnd
GetPixel=:     'gdi32.dll  GetPixel >l i i i'&cd NB. rgb: GetPixel hdc x y
GetCursorPos=: 'user32.dll GetCursorPos i *i'&cd NB. success: point


public static Color getColorAt(int x, int y){
   return new Robot().getPixelColor(x, y);
}


# Windows GDI version
function getpixelcolors(x, y)
    hdc = ccall((:GetDC, "user32.dll"), UInt32, (UInt32,), 0)
    pxl = ccall((:GetPixel, "gdi32.dll"), UInt32, (UInt32, Cint, Cint), hdc, Cint(x), Cint(y))
    return pxl & 0xff, (pxl >> 8) & 0xff, (pxl >> 16) & 0xff
end

const x = 120
const y = 100
cols = getpixelcolors(x, y)
println("At screen point (x=$x, y=$y) the color RGB components are red: $(cols[1]), green: $(cols[2]), and blue: $(cols[3])")


import java.awt.*

fun getMouseColor(): Color {
    val location = MouseInfo.getPointerInfo().location
    return getColorAt(location.x, location.y)
}

fun getColorAt(x: Int, y: Int): Color {
    return Robot().getPixelColor(x, y)
}


on getScreenPixelColor (x, y)
  sx = xtra("ScrnXtra3").new()
  img = sx.ScreenToImage(rect(x, y, x+1, y+1))
  return img.getPixel(0, 0)
end


Module CheckColor {
      \\ Print hex code for color, and html code for color
      Every 25 {
            move mouse.x, mouse.y
            color$=Hex$(-point, 3)  ' point has a negative value
            Print Over "0x"+color$+",  #"+Right$(color$,2)+Mid$(color$, 3,2)+Left$(color$,2)
            if mouse<>0 then exit
      }
      Print
}
CheckColor


getPixel[{x_?NumberQ, y_?NumberQ}, screenNumber_Integer: 1] := ImageValue[CurrentScreenImage[n], {x, y}]