	;;; Display pinstripes on a PC, using 8086 assembly.
	;;; The 640x200 CGA video mode is used. If you are on an MDA, the
	;;; program does not run.
	bits	16
	cpu	8086
	;;; IBM BIOS (INT 10h) calls
vmode:	equ	0Fh	; Get current video mode
	;;; Video modes
MDATXT:	equ	7	; MDA text mode (to check current mode against)
CGAHI:	equ	6	; CGA "high resolution" mode (640x200)
	;;; Video memory
M_EVEN:	equ	0B800h	; Video memory segment for even scanlines
M_ODD:	equ	0BA00h	; Video memory segment for odd scanlines
section .text
	org	100h
	cld			; Make sure string instructions go forward
	mov	ah,vmode	; Get current video mode
	int	10h
	cmp	al,MDATXT	; Are we in MDA text mode?
	jne	gr_ok
	ret			; Then stop (no graphics support)
gr_ok:	mov	[oldmod],al	; otherwise, store old graphics mode,
	mov	ax,CGAHI 	; and switch to hi-res CGA mode
	int	10h
	;;;	There are 200 lines on the screen, but even and odd scanlines
	;;;	are stored separately. Because we're drawing vertical lines
	;;;	at a quarter of the screen, every odd scanline matches the
	;;;	even one before it. This means we really only need 100 lines,
	;;;	which means a quarter of the screen is 25 lines. There are
	;;;	640 pixels per line, so each quarter consists of 16.000 pixels,
	;;;	or 2000 bytes, or 1000 words.
	mov	bp,1000		; Keep a '1000' constant loaded
	mov	ax,M_EVEN	; Start with the even scan lines
	mov	dl,2		; Let DL = 2 (we are doing the loop twice)
screen:	mov	es,ax		; Let ES be the video segment
	xor	di,di		; Start at the beginning
	mov	si,one		; Starting with pattern one
	lodsw
	mov	cx,bp		; Write 1000 words of pattern one
	rep	stosw
	lodsw
	mov	cx,bp		; Write 1000 words of pattern two
	rep	stosw
	lodsb			; Pattern three is more complicated
	xchg	al,bl 		; Let BL be the 3rd byte,
	lodsw			; and AX be the first two.
	mov	bh,25		; We need to write 25 lines,
quart3:	mov	cx,26		; and every line we need to write 26*3 bytes
line3:	stosw
	xchg	al,bl
	stosb
	xchg	al,bl
	loop	line3
	stosw			; Plus two final bytes per line
	dec	bh
	jnz	quart3
	lodsw			; Finally, write 1000 words of pattern four
	mov	cx,bp
	rep	stosw
	mov	ax,M_ODD	; Then, do the odd scanlines
	dec	dl		; If we haven't already done them
	jnz	screen
	;;;	We are now done. Wait for a key, restore the old video mode,
	;;;	and exit.
	xor	ah,ah		; Wait for a key
	int	16h
	xor	ah,ah		; Restore the old video mode
	mov	al,[oldmod]
	int	10h
	ret			; And exit
section	.data
	;;; Pattern data
one:	dw	0AAAAh	; one on, one off pattern
two:	dw	0CCCCh	; two on, two off pattern
three:	db	38h	; three isn't divisible by 16
	dw	8EE3h	; we need 24 bits for the pattern to repeat
four:	dw	0F0F0h	; four on, four off pattern
section	.bss
oldmod:	resb	1	; place to keep old video mode, in order to
			; restore it.


PROC Main()
  BYTE
    CH=$02FC, ;Internal hardware value for last key pressed
    COLOR0=$02C4,COLOR1=$02C5,COLOR2=$02C6,COLOR4=$02C8
  CARD i

  Graphics(8+16)
  COLOR4=$04 ;gray
  COLOR1=$00 ;black
  COLOR2=$0F ;white

  FOR i=0 TO 319
  DO
    Color=i MOD 2
    Plot(i,0) DrawTo(i,47)

    Color=i/2 MOD 2
    Plot(i,48) DrawTo(i,95)

    Color=i/3 MOD 2
    Plot(i,96) DrawTo(i,143)

    Color=i/4 MOD 2
    Plot(i,144) DrawTo(i,191)
  OD

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


package  {

    import flash.display.Bitmap;
    import flash.display.BitmapData;
    import flash.display.Sprite;
    import flash.events.Event;

    public class Pinstripe extends Sprite {

        public function Pinstripe():void {
            if (stage) init();
            else addEventListener(Event.ADDED_TO_STAGE, init);
        }

        private function init(e:Event = null):void {

            var data:BitmapData = new BitmapData(stage.stageWidth, stage.stageHeight, false, 0xFFFFFFFF);
            data.lock();

            var w:uint = data.width, h:uint = data.height / 4;
            var x:uint, y:uint = 0, i:uint, px:uint, colour:uint, maxy:uint = h;

            for ( i = 1; i <= 4; i++ ) {

                for ( ; y < maxy; y++ ) {
                    colour = 0xFF000000;
                    px = 1;

                    for ( x = 0; x < w; x++ ) {

                        if ( px == i ) {
                            colour = (colour == 0xFF000000) ? 0xFFFFFFFF : 0xFF000000;
                            px = 1;
                        }
                        else px++;

                        data.setPixel32(x, y, colour);

                    }
                }

                maxy += h;

            }

            data.unlock();
            addChild(new Bitmap(data));
        }

    }

}


with SDL.Video.Windows.Makers;
with SDL.Video.Renderers.Makers;
with SDL.Events.Events;

procedure Pinstripe_Display is

   Width   : constant := 800;
   Height  : constant := 400;

   Window   : SDL.Video.Windows.Window;
   Renderer : SDL.Video.Renderers.Renderer;
   Event    : SDL.Events.Events.Events;

   use SDL;
   use type SDL.C.int;

   procedure Draw_Pinstripe (Line_Width   : in C.int;
                             Line_Height  : in C.int;
                             Screen_Width : in C.int;
                             Y            : in C.int)
   is
      Count : constant C.int := Screen_Width / (2 * Line_Width);
   begin
      Renderer.Set_Draw_Colour (Colour => (255, 255, 255, 255));
      for A in 0 .. Count loop
         Renderer.Fill (Rectangle => (X => 2 * A * Line_Width, Y => Y,
                                      Width  => Line_Width,
                                      Height => Line_Height));
      end loop;
   end Draw_Pinstripe;

   procedure Wait is
      use type SDL.Events.Event_Types;
   begin
      loop
         while SDL.Events.Events.Poll (Event) loop
            if Event.Common.Event_Type = SDL.Events.Quit then
               return;
            end if;
         end loop;
         delay 0.100;
      end loop;
   end Wait;

begin
   if not SDL.Initialise (Flags => SDL.Enable_Screen) then
      return;
   end if;

   SDL.Video.Windows.Makers.Create (Win      => Window,
                                    Title    => "Pinstripe",
                                    Position => SDL.Natural_Coordinates'(X => 10, Y => 10),
                                    Size     => SDL.Positive_Sizes'(Width, Height),
                                    Flags    => 0);
   SDL.Video.Renderers.Makers.Create (Renderer, Window.Get_Surface);
   Renderer.Set_Draw_Colour ((0, 0, 0, 255));
   Renderer.Fill (Rectangle => (0, 0, Width, Height));

   Draw_Pinstripe (1, Height / 4, Width, 0);
   Draw_Pinstripe (2, Height / 4, Width, 100);
   Draw_Pinstripe (3, Height / 4, Width, 200);
   Draw_Pinstripe (4, Height / 4, Width, 300);
   Window.Update_Surface;

   Wait;
   Window.Finalize;
   SDL.Finalise;
end Pinstripe_Display;


h	:= A_ScreenHeight
w	:= A_ScreenWidth
pToken	:= Gdip_Startup()
hdc	:= CreateCompatibleDC()
hbm	:= CreateDIBSection(w, h)
obm	:= SelectObject(hdc, hbm)
G	:= Gdip_GraphicsFromHDC(hdc)

OnExit, Exit

Gui -Caption +E0x80000 +LastFound +OwnDialogs +Owner +AlwaysOnTop
Gui Show, NA
hwnd	:= WinExist()

pBrushB := Gdip_BrushCreateSolid(0xFF000000)
pBrushW := Gdip_BrushCreateSolid(0xFFFFFFFF)
Loop 4
{
	n := A_Index
	Loop % w
		BorW := A_Index & 1 ? "B" : "W"
		,Gdip_FillRectangle(G, pBrush%BorW%
				    , A_Index*n-n, (n-1)*h/4, n, h/4)
}

UpdateLayeredWindow(hwnd, hdc, 0, 0, W, H)

Gdip_DeleteBrush(pBrushB)
Gdip_DeleteBrush(pBrushW)

SelectObject(hdc, obm)
DeleteObject(hbm)
DeleteDC(hdc)
Gdip_DeleteGraphics(G)
Return

Escape::
Exit:
Gdip_Shutdown(pToken)
ExitApp


      GWL_STYLE = -16
      HWND_TOPMOST = -1
      WS_VISIBLE = &10000000
      WS_CLIPCHILDREN = &2000000
      WS_CLIPSIBLINGS = &4000000

      SYS "GetSystemMetrics", 0 TO xscreen%
      SYS "GetSystemMetrics", 1 TO yscreen%
      SYS "SetWindowLong", @hwnd%, GWL_STYLE, WS_VISIBLE + \
      \                    WS_CLIPCHILDREN + WS_CLIPSIBLINGS
      SYS "SetWindowPos", @hwnd%, HWND_TOPMOST, 0, 0, xscreen%, yscreen%, 0
      VDU 26

      FOR X% = 0 TO xscreen%*4-4 STEP 4
        RECTANGLE FILL X%,yscreen%*3/2,2,yscreen%/2
      NEXT
      FOR X% = 0 TO xscreen%*4-8 STEP 8
        RECTANGLE FILL X%,yscreen%*2/2,4,yscreen%/2
      NEXT
      FOR X% = 0 TO xscreen%*4-12 STEP 12
        RECTANGLE FILL X%,yscreen%*1/2,6,yscreen%/2
      NEXT
      FOR X% = 0 TO xscreen%*4-16 STEP 16
        RECTANGLE FILL X%,yscreen%*0/2,8,yscreen%/2
      NEXT


#include<graphics.h>
#include<conio.h>

#define sections 4

int main()
{
	int d=DETECT,m,maxX,maxY,x,y,increment=1;
	initgraph(&d,&m,"c:/turboc3/bgi");

	maxX = getmaxx();
	maxY = getmaxy();

	for(y=0;y<maxY;y+=maxY/sections)
	{
		for(x=0;x<maxX;x+=increment)
		{
			setfillstyle(SOLID_FILL,(x/increment)%2==0?BLACK:WHITE); //The only line which differs
			bar(x,y,x+increment,y+maxY/sections);
		}
		increment++;
	}

	getch();
	closegraph();
	return 0;
}


using System.Drawing;

public class Pinstripe
{
    static void Main(string[] args)
    {
        var pinstripe = MakePinstripeImage(1366, 768);
        pinstripe.Save("pinstripe.png");
    }

    public static Bitmap MakePinstripeImage(int width, int height)
    {
        var image = new Bitmap(width, height);
        var quarterHeight = height / 4;

        for (var y = 0; y < height; y++)
        {
            var stripeWidth = (y / quarterHeight) + 1;

            for (var x = 0; x < width; x++)
            {
                var color = ((x / stripeWidth) % 2) == 0 ? Color.White : Color.Black;
                image.SetPixel(x, y, color);
            }
        }

        return image;
    }
}


#include <windows.h>

//--------------------------------------------------------------------------------------------------
class pinstripe
{
public:
    pinstripe()                        { createColors(); }
    void setDimensions( int x, int y ) { _mw = x; _mh = y; }
    void createColors()
    {
	colors[0] = 0; colors[1] = RGB( 255, 255, 255 );
    }

    void draw( HDC dc )
    {
        HPEN pen;
	int lh = _mh / 4, row, cp;
	for( int lw = 1; lw < 5; lw++ )
	{
	    cp = 0;
            row = ( lw - 1 ) * lh;
	    for( int x = 0 + lw > 1 ? lw > 3 ? 2 : 1 : 0; x < _mw; x += lw )
	    {
		pen = CreatePen( PS_SOLID, lw, colors[cp] );
	        ++cp %= 2;

		SelectObject( dc, pen );
		MoveToEx( dc, x, row, NULL );
		LineTo( dc, x, row + lh );
		DeleteObject( pen );
	    }
	}
    }

private:
    int _mw, _mh;
    DWORD colors[2];
};
//--------------------------------------------------------------------------------------------------
pinstripe pin;

//--------------------------------------------------------------------------------------------------
void PaintWnd( HWND hWnd )
{
    PAINTSTRUCT ps;
    HDC hdc = BeginPaint( hWnd, &ps );
    pin.draw( hdc );
    EndPaint( hWnd, &ps );
}
//--------------------------------------------------------------------------------------------------
LRESULT CALLBACK WndProc( HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam )
{
    switch( msg )
    {
	case WM_DESTROY: PostQuitMessage( 0 ); break;
	case WM_PAINT: PaintWnd( hWnd ); break;
	default:
	    return DefWindowProc( hWnd, msg, wParam, lParam );
    }
    return 0;
}
//--------------------------------------------------------------------------------------------------
HWND InitAll( HINSTANCE hInstance )
{
    WNDCLASSEX wcex;
    ZeroMemory( &wcex, sizeof( wcex ) );

    wcex.cbSize	       = sizeof( WNDCLASSEX );
    wcex.style	       = CS_HREDRAW | CS_VREDRAW;
    wcex.lpfnWndProc   = WndProc;
    wcex.hInstance     = hInstance;
    wcex.hCursor       = LoadCursor( NULL, IDC_ARROW );
    wcex.hbrBackground = ( HBRUSH )( COLOR_WINDOW + 1 );
    wcex.lpszClassName = "_BW_PS_";

    RegisterClassEx( &wcex );
    return CreateWindow( "_BW_PS_", ".: Pinstripe -- PJorente :.", WS_POPUP, CW_USEDEFAULT, 0, 200, 200, NULL, NULL, hInstance, NULL );
}
//--------------------------------------------------------------------------------------------------
int APIENTRY _tWinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance, LPTSTR lpCmdLine, int nCmdShow )
{
    srand( GetTickCount() );

    HWND hwnd = InitAll( hInstance );
    if( !hwnd ) return -1;

    int mw = GetSystemMetrics( SM_CXSCREEN ),
	mh = GetSystemMetrics( SM_CYSCREEN );

    pin.setDimensions( mw, mh );

    RECT rc = { 0, 0, mw, mh };

    AdjustWindowRectEx( &rc, WS_POPUP, FALSE, 0 );
    int w = rc.right  - rc.left,
	h = rc.bottom - rc.top;

    int posX = ( GetSystemMetrics( SM_CXSCREEN ) >> 1 ) - ( w >> 1 ),
	posY = ( GetSystemMetrics( SM_CYSCREEN ) >> 1 ) - ( h >> 1 );

    SetWindowPos( hwnd, HWND_TOP, posX, posY, w, h, SWP_NOZORDER );
    ShowWindow( hwnd, nCmdShow );
    UpdateWindow( hwnd );

    MSG msg;
    ZeroMemory( &msg, sizeof( msg ) );
    while( msg.message != WM_QUIT )
    {
	if( PeekMessage( &msg, NULL, 0, 0, PM_REMOVE ) != 0 )
	{
	    TranslateMessage( &msg );
	    DispatchMessage( &msg );
	}
    }
    return UnregisterClass( "_BW_PS_", hInstance );
}
//--------------------------------------------------------------------------------------------------


' version 14-03-2017
'    compile with: fbc -s console
' or compile with: fbc -s gui

Dim As UInteger ps, col, h, w, x, y1, y2
ScreenInfo w, h

' create display size window, 8bit color (palette), no frame
ScreenRes w, h, 8,, 8
' vga palette black = 0 and white = 15

h = h \ 4 : y2 = h -1

For ps = 1 To 4
    col = 0
    For x = 0 To (w - ps -1) Step ps
        Line (x, y1) - (x + ps -1, y2), col, bf
        col = 15 - col ' col alternate between 0 (black) and 15 (white)
    Next
    y1 += h : y2 += h
Next

' empty keyboard buffer
While InKey <> "" : Wend
'Print : Print "hit any key to end program"
Sleep
End


'WARNING this takes a time to display
'Use the 'gb.qt4' component

Public Sub Form_Open()
Dim iColour As Integer[] = [Color.Black, Color.white]
Dim hPanel As Panel
Dim siCount, siCounter, siSet As Short

With Me
  .Arrangement = Arrange.Row
  .Border = False
  .Height = Desktop.Height
  .Width = Desktop.Width
  .Fullscreen = True
End With

For siCounter = 1 To 4
  For siCount = 1 To Desktop.Width Step siCounter
    hpanel = New Panel(Me)
    hpanel.Width = siCounter
    hpanel.Height = Desktop.Height / 4
    HPanel.Background = iColour[siSet]
    Inc siSet
    If siSet > 1 Then siSet = 0
  Next
Next

End


package main

import "github.com/fogleman/gg"

var palette = [2]string{
    "FFFFFF", // white
    "000000", // black
}

func pinstripe(dc *gg.Context) {
    w := dc.Width()
    h := dc.Height() / 4
    for b := 1; b <= 4; b++ {
        for x, ci := 0, 0; x < w; x, ci = x+b, ci+1 {
            dc.SetHexColor(palette[ci%2])
            y := h * (b - 1)
            dc.DrawRectangle(float64(x), float64(y), float64(b), float64(h))
            dc.Fill()
        }
    }
}

func main() {
    dc := gg.NewContext(900, 600)
    pinstripe(dc)
    dc.SavePNG("w_pinstripe.png")
}


link graphics

procedure main()  # pinstripe

   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","fg=white") |
        stop("Unable to open window")

   maxbands := 4                             # bands to draw
   bandheight := height / maxbands           # height of each band
   every bands := 1 to maxbands do {         # for each band
         top   := 1 + bandheight * (bands-1) # .. top of band
         step  := 2^bands                    # .. number of steps (width)
         lines := step / 2                   # .. number (width) of stripes
         every c := 1 to width by step & l := 0 to lines-1 do
            DrawLine(c+l,top,c+l,top+bandheight-1)
         }
   WDone(W)                                  # q to exit
end


   load'viewmat'
   NB. size=. 2{.".wd'qm'          NB. J6
   NB. size=. getscreenwh_jgtk_ '' NB. J7
       size=. 3{".wd'qscreen'      NB. J8
   'rgb'viewmat- (4<[email protected]%~{:size)# ({.size) $&> 1 2 3 4#&.> <0 1


import java.awt.*;
import javax.swing.*;

public class PinstripeDisplay extends JPanel {

    final int bands = 4;

    public PinstripeDisplay() {
        setPreferredSize(new Dimension(900, 600));
    }

    @Override
    public void paintComponent(Graphics g) {
        super.paintComponent(g);
        int h = getHeight();
        for (int b = 1; b <= bands; b++) {
            for (int x = 0, colIndex = 0; x < getWidth(); x += b, colIndex++) {
                g.setColor(colIndex % 2 == 0 ? Color.white : Color.black);
                g.fillRect(x, (b - 1) * (h / bands), x + b, b * (h / bands));
            }
        }
    }

    public static void main(String[] args) {
        SwingUtilities.invokeLater(new Runnable() {
            @Override
            public void run() {
                JFrame f = new JFrame();
                f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
                f.setTitle("PinstripeDisplay");
                f.add(new PinstripeDisplay(), BorderLayout.CENTER);
                f.pack();
                f.setLocationRelativeTo(null);
                f.setVisible(true);
            }
        });
    }
}


using Luxor

function drawbars(w, h, sections, dk, lt)
    Drawing(w,h)
    background("white")
    width = 1
    height = h/sections
    for y in 0:height:h-1
        setline(width)
        for x in 0:w/width
            sethue(x % 2 == 0 ? dk: lt)
            line(Point(x*width,y), Point(x*width,y+height), :stroke)
        end
        width += 1
    end
end

drawbars(1920, 1080, 4, "black", "white")
finish()
preview()


// version 1.1.0

import java.awt.*
import javax.swing.*

class ColourPinstripeDisplay(): JPanel() {
    private companion object {
        val palette = arrayOf(Color.white, Color.black)
    }

    private val bands = 4

    init {
        preferredSize = Dimension(900, 600)
    }

    protected override fun paintComponent(g: Graphics) {
        super.paintComponent(g)
        for (b in 1..bands) {
            var colIndex = 0
            val h = height / bands
            for (x in 0 until width step b) {
                g.color = palette[colIndex % palette.size]
                g.fillRect(x, (b - 1) * h, b, h)
                colIndex++
            }
        }
    }
}

fun main(args: Array<String>) {
    SwingUtilities.invokeLater {
        val f = JFrame()
        f.defaultCloseOperation = JFrame.EXIT_ON_CLOSE
        f.title = "PinstripeDisplay"
        f.add(ColourPinstripeDisplay(), BorderLayout.CENTER)
        f.pack()
        f.setLocationRelativeTo(null)
        f.setVisible(true)
    }
}


nomainwin

UpperLeftX=1
UpperLeftY=1
WindowWidth=DisplayWidth
WindowHeight=DisplayHeight

graphicbox #gr.gr, -1, -1,  DisplayWidth+4, DisplayHeight+1
open "Pinstripe/Display" for window_popup as #gr
 #gr.gr "down"
 #gr.gr "trapclose [quit]"
 #gr.gr "color black"
 #gr.gr "backcolor black"

for w = 1 to 4
    y1=y2
    y2=y1+DisplayHeight/4
    for x = w to DisplayWidth+4 step w*2
         #gr.gr "place ";x;" ";y1;"; boxfilled ";x+w;" ";y2
    next
next
wait

[quit]
    close #gr
    end


10 MODE 2 ' finest resolution
20 sh=400 ' screen height
30 sw=640 ' screen width
40 INK 0,26 ' white ink for background pen (0)
50 INK 1,0  ' black ink for foreground pen (1)
60 FOR sn=1 TO 4 ' four sections
70 bh=INT (sh/4) ' bar height
80 bb=(4-sn)*bh  ' bar baseline
90 dw=0  ' currently drawn bar width
100 dc=0 ' current drawing colour
110 FOR l=0 TO sw -1 ' pan width for each section
120 PLOT l,bb,dc
130 DRAWR 0,bh-1,dc ' subtract 1 pixel (already plotted)
140 dw=dw+1
150 ' section number corresponds to maximum bar width
160 ' change bar colour, if maximum bar width exceeded
170 IF dw>sn THEN dw=0:dc=dc+1 ' next colour
180 IF dc>1 THEN dc=0
190 NEXT l
200 NEXT sn


function love.load()
    WIDTH = love.graphics.getWidth()
    ROW_HEIGHT = math.floor(love.graphics.getHeight()/4)
    love.graphics.setBackgroundColor({0,0,0})
    love.graphics.setLineWidth(1)
    love.graphics.setLineStyle("rough")
end

function love.draw()
    for j = 0, 3 do
        for i = 0, WIDTH, (j+1)*2 do
	    love.graphics.setColor({255,255,255})
	    for h = 0, j do
		love.graphics.line(i+h, j*ROW_HEIGHT, i+h, (j+1)*ROW_HEIGHT)
	    end
	end
    end
end


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

const
  Width = 420
  Height = 420

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

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

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

  const lineHeight = Height div 4

  var y = 0.0
  for lineWidth in [1.0, 2.0, 3.0, 4.0]:
    context.setLineWidth(lineWidth)
    var x = 0.0
    var colorIndex = 0
    while x < Width:
      context.setSource(Colors[colorIndex])
      context.moveTo(x, y)
      context.lineTo(x, y + lineHeight)
      context.stroke()
      colorIndex = 1 - colorIndex
      x += lineWidth
    y += lineHeight

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

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 pinstripe")

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

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

  window.showAll()

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

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


use Imager;

my($xsize,$ysize) = (640,400);
$img = Imager->new(xsize => $xsize, ysize => $ysize);

my $eps = 10**-14;
my $height = int $ysize / 4;
for my $width (1..4) {
    $stripes = int((1-$eps) + $xsize / $width / 2);
    @row = ((0) x $width, (1) x $width) x $stripes;
    for $x (0..$#row) {
        for $y (0..$height) {
            my $offset = $height*($width-1);
            $img->setpixel(x => $x, y => $y+$offset, color => $row[$x] ? 'black' : 'white')
        }
    }
}

$img->write(file => 'pinstripes-bw.png');


(let Pbm  # Create PBM of 384 x 288 pixels
   (make
      (for N 4
         (let
            (C 0
               L (make
                  (do (/ 384 N)
                     (do N (link C))
                     (setq C (x| 1 C)) ) ) )
            (do 72 (link L)) ) ) )
   (out '(display)  # Pipe to ImageMagick
      (prinl "P1")
      (prinl (length (car Pbm)) " " (length Pbm))
      (mapc prinl Pbm) ) )


#White = $FFFFFF ;color

;Create a Pinstripe image
Procedure PinstripeDisplay(width, height)
  Protected x, imgID, psHeight = height / 4, psWidth = 1, psTop, horzBand
  imgID = CreateImage(#PB_Any, width, height)
  If imgID
    StartDrawing(ImageOutput(imgID))
      Repeat
        x = 0
        Repeat
          Box(x, psTop, psWidth, psHeight, #White)
          x + 2 * psWidth
        Until x >= width
        psWidth + 1
        horzBand + 1
        psTop = horzBand * height / 4  ;move to the top of next horizontal band of image
      Until psTop >= height
    StopDrawing()
  EndIf
  ProcedureReturn imgID
EndProcedure

;Open a window and display the pinstripe
If OpenWindow(0, 0, 0, 1, 1,"PureBasic Pinstripe", #PB_Window_Maximize | #PB_Window_SystemMenu)
  PicID = PinstripeDisplay(WindowWidth(0), WindowHeight(0))
  ImageGadget(0, 0, 0, WindowWidth(0), WindowHeight(0), ImageID(PicID))
  While WaitWindowEvent() <> #PB_Event_CloseWindow
  Wend
EndIf


#Python task for Pinstripe/Display
#Tested for Python2.7 by Benjamin Curutchet

#Import PIL libraries
from PIL import Image
from PIL import ImageColor
from PIL import ImageDraw

#Create the picture (size parameter 1660x1005 like the example)
x_size = 1650
y_size = 1000
im = Image.new('RGB',(x_size, y_size))

#Create a full black picture
draw = ImageDraw.Draw(im)

#RGB code for the White Color
White  = (255,255,255)

#First loop in order to create four distinct lines
y_delimiter_list = []
for y_delimiter in range(1,y_size,y_size/4):
	y_delimiter_list.append(y_delimiter)

#Four different loops in order to draw columns in white depending on the
#number of the line

for x in range(1,x_size,2):
	for y in range(1,y_delimiter_list[1],1):
		draw.point((x,y),White)

for x in range(1,x_size-1,4):
	for y in range(y_delimiter_list[1],y_delimiter_list[2],1):
		draw.point((x,y),White)
		draw.point((x+1,y),White)

for x in range(1,x_size-2,6):
	for y in range(y_delimiter_list[2],y_delimiter_list[3],1):
		draw.point((x,y),White)
		draw.point((x+1,y),White)
		draw.point((x+2,y),White)

for x in range(1,x_size-3,8):
	for y in range(y_delimiter_list[3],y_size,1):
		draw.point((x,y),White)
		draw.point((x+1,y),White)
		draw.point((x+2,y),White)
		draw.point((x+3,y),White)

#Save the picture under a name as a jpg file.
print "Your picture is saved"
im.save('PictureResult.jpg')


#lang racket/gui

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

(define parts 4)

(define (paint-pinstripe canvas dc)
  (send dc set-pen "black" 0 'solid)
  (send dc set-brush "black" 'solid)
  (define H* (round (/ H parts)))
  (for ([row parts])
    (define Y (* row H*))
    (for ([X (in-range 0 W (* (add1 row) 2))])
      (send dc draw-rectangle X Y (add1 row) 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 "Pinstripe"] [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%))


my ($x,$y) = 1280,720;
my @colors = 0, 1;

spurt "pinstripes.pgm", qq:to/EOH/ orelse .die;
    P5
    # pinstripes.pgm
    $x $y
    1
    EOH

my $img = open "pinstripes.pgm", :a, :bin orelse .die;

my $vzones = $y div 4;
for 1..4 -> $w {
    my $stripes = ceiling $x / $w / +@colors;
    my $line = Buf.new: (flat((@colors Xxx $w) xx $stripes).Array).splice(0,$x); # DH change 2015-12-20
    $img.write: $line for ^$vzones;
}

$img.close;


# Project : Pinstripe/Display

load "guilib.ring"

paint = null

new qapp
        {
        win1 = new qwidget() {
                  setwindowtitle("Pinstripe/Display")
                  setgeometry(100,100,500,600)
                  label1 = new qlabel(win1) {
                              setgeometry(10,10,400,400)
                              settext("")
                  }
                  new qpushbutton(win1) {
                          setgeometry(150,500,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)
        }
        paint = new qpainter() {
                  begin(p1)
                  setpen(pen)

        xscreen = 100
        yscreen = 100
        color = new qcolor()
        color.setrgb(0,0,0,255)
        mybrush = new qbrush() {setstyle(1) setcolor(color)}
        setbrush(mybrush)
        for x = 0 to xscreen*4-4 step 4
             drawrect(x,yscreen*3/2,2,yscreen/2)
        next
        for x = 0 to xscreen*4-8 step 8
             drawrect(x,yscreen*2/2,4,yscreen/2)
        next
        for x = 0 to xscreen*4-12 step 12
             drawrect(x,yscreen*1/2,6,yscreen/2)
        next
        for x = 0 to xscreen*4-16 step 16
             drawrect(x,yscreen*0/2,8,yscreen/2)
        next

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


import java.awt._

import javax.swing._

object PinstripeDisplay extends App {

  SwingUtilities.invokeLater(() =>
    new JFrame("Pinstripe") {

      class Pinstripe_Display extends JPanel {

        override def paintComponent(g: Graphics): Unit = {
          val bands = 4

          super.paintComponent(g)
          for (b <- 1 to bands) {
            var colIndex = 0
            for (x <- 0 until getWidth by b) {
              g.setColor(if (colIndex % 2 == 0) Color.white
              else Color.black)
              g.fillRect(x, (b - 1) * (getHeight / bands), x + b, b * (getHeight / bands))
              colIndex += 1
            }
          }
        }

        setPreferredSize(new Dimension(900, 600))
      }

      add(new Pinstripe_Display, BorderLayout.CENTER)
      pack()
      setDefaultCloseOperation(WindowConstants.EXIT_ON_CLOSE)
      setLocationRelativeTo(null)
      setVisible(true)
    })

}


10 FOR W=1 TO 4
20 FOR I=0 TO 63 STEP 2*W
30 FOR J=1 TO W
40 FOR K=43-11*(W-1) TO 33-11*(W-1) STEP -1
50 PLOT I+J,K
60 NEXT K
70 NEXT J
80 NEXT I
90 NEXT W


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 white}

set dy [expr {[winfo screenheight .c]/4}]
set y 0
foreach dx {1 2 3 4} {
    for {set x 0} {$x < [winfo screenwidth .c]} {incr x $dx} {
	.c create rectangle $x $y [expr {$x+$dx}] [expr {$y+$dy}] \
            -fill [lindex $colors 0] -outline {}
	set colors [list {*}[lrange $colors 1 end] [lindex $colors 0]]
    }
    incr y $dy
}


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

class Game {
    static init() {
        Window.title = "Pinstripe"
        __width = 900
        __height = 600
        Canvas.resize(__width, __height)
        Window.resize(__width, __height)
        var colors = [
            Color.hex("FFFFFF"), // white
            Color.hex("000000")  // black
        ]
        pinstripe(colors)
    }

    static pinstripe(colors) {
        var w = __width
        var h = (__height/4).floor
        for (b in 1..4) {
            var x = 0
            var ci = 0
            while (x < w) {
                var y = h * (b - 1)
                Canvas.rectfill(x, y, b, h, colors[ci%2])
                x = x + b
                ci = ci + 1
            }
        }
    }

    static update() {}

    static draw(dt) {}
}


include c:\cxpl\codes;          \include 'code' declarations
int X, Y, W, C;
[SetVid($13);                   \320x200x8 graphics
for Y:= 0 to 200-1 do           \for all the scan lines...
    [W:= Y/50 + 1;              \width of stripe = 1, 2, 3, 4
    C:= 0;                      \set color to black so first pixel becomes white
    for X:= 0 to 320-1 do       \for all the pixels on a scan line...
        [if rem(X/W) = 0 then C:= C xor $0F;    \alternate B&W
        Point(X, Y, C);         \set pixel at X,Y to color C
        ];
    ];
X:= ChIn(1);                    \wait for keystroke
SetVid(3);                      \restore normal text display
]


	;;;	Display pinstripes on an MSX, using Z80 assembly.
	;;;	We'll use the monochrome 'text' mode to do it, by changing
	;;;	a few characters in the VDP font. This program will use
	;;;	either low resolution mode (240x192) or high resolution
	;;;	mode (480x192) depending on which is already active.
	;;;	(In MSX-DOS, `MODE 40` and `MODE 80` switch between them.)
	;;;
	;;;	The characters are 6x8, stored row-wise, and the low two
	;;;	bits are ignored. This means that one-pixel alternating
	;;;	pinstripes are created using the following pattern:
onep:	equ	0A8h	; 1 0 1 0 1 0 (0 0)
	;;;	A 2-pixel pattern needs two alternating characters:
twop1:	equ	0CCh	; 1 1 0 0 1 1 (0 0)
twop2:	equ	030h	; 0 0 1 1 0 0 (0 0)
	;;;	3 * 2 = 6, so the 3-pixel pattern fits in one character:
threep:	equ	0E0h	; 1 1 1 0 0 0 (0 0)
	;;;	And we need four characters for the 4-pixel pattern:
fourp1:	equ	0F0h	; 1 1 1 1 0 0 (0 0)
fourp2:	equ	03Ch	; 0 0 1 1 1 1 (0 0)
fourp3:	equ	0Ch	; 0 0 0 0 1 1 (0 0)
fourp4:	equ	0C0h	; 1 1 0 0 0 0 (0 0)
	;;;	-------------------------------------------------------------
bdos:	equ	5	; Use the BDOS routine to wait for a keypress
dirio:	equ	6	; after the drawing is done
	;;;	MSX ROM calls
calslt:	equ	1Ch	; Interslot call
rom:	equ	0FCC0h	; Main ROM slot
initxt:	equ	6Ch	; Initialize text mode
	;;;	RAM location
linlen:	equ	0F3B0h	; Contains line length, if <=40 we're in low res mode
	;;;	VDP data
vreg:	equ	99h	; Port on which the VDP registers are accessed
vdata:	equ	98h	; Port on which the VRAM is accessed
VWRITE:	equ	40h	; Bit 6 in VDP address = enable writing
	;;;	(these are for low-res mode, high-res mode has them doubled)
font:	equ	0800h	; Location of start of font data
qrtr:	equ	240	; Amount of bytes that fill a quarter of the screen
	;;;	-------------------------------------------------------------
	org	100h
	;;;	Redefine characters 0-7 to the eight characters we need
	ld	hl,font		; Get VDP font location
	call	reshl		; Correct for hires mode if necessary
	call	setadr		; Set the VDP to read from that address
	ld	hl,pats		; Pattern data
	ld	c,8		; Write 8 characters
wrpats:	ld	b,8		; 8 lines per character
	ld 	a,(hl)		; Load current pattern byte
wrpat:	out	(vdata),a	; Write it to the VDP,
	djnz	wrpat		; 8 times.
	inc	hl		; Next pattern
	dec	c		; Any patterns left?
	jr	nz,wrpats	; If so, write next pattern
	ld	hl,0		; Set the VDP to write to address 0
	call	setadr		; which is the beginning of the text screen.
	;;;	Figure out how big a quarter of the screen is
	ld	hl,qrtr		; Get value for low resolution,
	call	reshl		; Correct for high res mode if necessary
	push	hl		; Store number on the stack
	;;;	Write the first quarter of the screen: 1-pixel stripes
	;;;	(character 0).
	ld	b,0
	call	qrtrch
	;;;	Write the second quarter of the screen: 2-pixel stripes
	;;;	(characters 1 and 2 alternating).
	pop	hl		; Load size from the stack
	push	hl
	or	a		; Clear carry
	rr	h		; Divide by 2
	rr	l
q2loop:	ld	a,1		; Character 1,
	out	(vdata),a
	inc	a		; and character 2.
	nop			; Slowdown to make sure the VDP can keep up
	nop
	out	(vdata),a
	dec	hl
	ld 	a,h		; HL = 0?
	or	l
	jr	nz,q2loop	; If not, next 2 bytes
	;;;	Write the third quarter of the screen: 3-pixel stripes
	;;;	(character 3)
	ld	b,3
	call	qrtrch
	;;;	Write the fourth quarter of the screen: 4-pixel stripes
	;;;	(characters 4, 5, 6, and 7 alternating)
	pop	hl		; Load size from stack
	or	a		; Divide by 4
	rr	h
	rr	l
	or	a
	rr	h
	rr	l
q4loop:	ld	a,4		; Character 4
	ld	b,a		; 4 characters at a time
q4out:	out	(vdata),a	; Write the character,
	inc	a		; Next character,
	djnz	q4out		; 4 times.
	dec 	hl
	ld	a,h		; Done yet?
	or	l
	jr	nz,q4loop	; If not, next 4 bytes
	;;;	-------------------------------------------------------------
	;;;	We're done, now wait for a keypress.
clear:	ld	c,dirio		; First, wait while a key IS pressed
	ld	e,0FFh 		; (so we don't quit immediately if the user
	call	bdos		; has held the enter key a bit too long)
	and	a
	jr	nz,clear
wait:	ld	c,dirio		; Then, wait while a key is NOT pressed
	ld	e,0FFh
	call	bdos
	and	a
	jr	z,wait
	;;;	Afterwards, use a BIOS routine to reinitialize the screen
	;;;	(this will reload the default font).
	ld	iy,rom		; BIOS call to initialize text mode
	ld	ix,initxt
	jp	calslt
	;;;	-------------------------------------------------------------
	;;;	Subroutine: write character in B to a quarter of the screen
qrtrch:	pop	de		; Return address
	pop	hl		; Load size from the stack
	push	hl
	push	de		; Put return address back
qloop:	ld	a,b		; Write character in B
	out	(vdata),a
	dec	hl		; One fewer byte left
	ld	a,h		; Done yet?
	or	l
	jr	nz,qloop	; If not, next byte
	ret
	;;;	-------------------------------------------------------------
	;;;	Subroutine: double HL if we are in high resolution mode
reshl:	ld	a,(linlen)	; Check which mode we're in
	cp	41		; Higher than 40?
	ret	c		; If not, we're not in hires mode
	add	hl,hl		; We are in hires mode, so double HL
	ret
	;;;	-------------------------------------------------------------
	;;;	Subroutine: set the VDP to write to address HL.
setadr:	di			; No interrupts while we're messing with VDP
	xor	a		; High address bits for MSX-2 VDP are all 0
	out	(vreg),a	; (MSX-1 VDP will just ignore the zeroes)
	ld	a,14|128	; Write to register 14
	out	(vreg),a
	ld	a,l		; Write the low address byte
	out	(vreg),a
	ld	a,h
	or	VWRITE		; High address bits bits (5..0)
	out	(vreg),a	; Write high addr bits and write flag
	ei			; Reenable interrupts
	ret
	;;;	Patterns to replace the first characters with
pats:	db	onep,twop1,twop2,threep
	db	fourp1,fourp2,fourp3,fourp4


(defun remove-nth (i xs)
   (if (or (zp i) (endp (rest xs)))
       (rest xs)
       (cons (first xs)
             (remove-nth (1- i) (rest xs)))))

(defthm remove-nth-shortens
   (implies (consp xs)
            (< (len (remove-nth i xs)) (len xs))))

:set-state-ok t

(defun shuffle-r (xs ys state)
   (declare (xargs :measure (len xs)))
   (if (endp xs)
       (mv ys state)
       (mv-let (idx state)
               (random$ (len xs) state)
          (shuffle-r (remove-nth idx xs)
                     (cons (nth idx xs) ys)
                     state))))

(defun shuffle (xs state)
   (shuffle-r xs nil state))

(defun cross-r (x ys)
   (if (endp ys)
       nil
       (cons (cons x (first ys))
             (cross-r x (rest ys)))))

(defun cross (xs ys)
   (if (or (endp xs) (endp ys))
       nil
       (append (cross-r (first xs) ys)
               (cross (rest xs) ys))))

(defun make-deck ()
   (cross '(ace 2 3 4 5 6 7 8 9 10 jack queen king)
          '(hearts diamonds clubs spades)))

(defun print-card (card)
   (cw "~x0 of ~x1~%" (car card) (cdr card)))

(defun print-deck (deck)
   (if (endp deck)
       nil
       (progn$ (print-card (first deck))
               (print-deck (rest deck)))))

(defun draw-from-deck (deck)
   (mv (first deck) (rest deck)))


DEFINE PTR="CARD"
DEFINE MAXDECKSIZE="52"

TYPE Deck=[
  PTR cards ;BYTE ARRAY
  BYTE first,count]

BYTE FUNC IsEmpty(Deck POINTER d)
  IF d.count=0 THEN
    RETURN (1)
  FI
RETURN (0)

BYTE FUNC IsFull(Deck POINTER d)
  IF d.count=MAXDECKSIZE THEN
    RETURN (1)
  FI
RETURN (0)

BYTE FUNC Index(Deck POINTER d BYTE i)
RETURN ((d.first+i) MOD MAXDECKSIZE)

PROC InitEmpty(Deck POINTER d BYTE ARRAY crds)
  d.cards=crds
  d.first=0
  d.count=0
RETURN

PROC InitFull(Deck POINTER d BYTE ARRAY crds)
  BYTE i

  d.cards=crds
  d.first=0
  d.count=MAXDECKSIZE
  FOR i=0 TO MAXDECKSIZE-1
  DO
    crds(i)=i
  OD
RETURN

PROC Shuffle(Deck POINTER d)
  BYTE i,j,i2,j2,tmp
  BYTE ARRAY crds

  crds=d.cards
  i=d.count-1
  WHILE i>0
  DO
    j=Rand(i)
    i2=Index(d,i)
    j2=Index(d,j)
    tmp=crds(i2)
    crds(i2)=crds(j2)
    crds(j2)=tmp
    i==-1
  OD
RETURN

BYTE FUNC Deal(Deck POINTER d)
  BYTE ARRAY crds
  BYTE c

  IF IsEmpty(d) THEN
    PrintE("Error: deck is empty!")
    Break()
  FI

  crds=d.cards
  c=crds(d.first)
  d.count==-1
  d.first==+1
  IF d.first=MAXDECKSIZE THEN
    d.first=0
  FI
RETURN (c)

PROC Add(Deck POINTER d BYTE c)
  BYTE ARRAY crds
  BYTE i

  IF IsFull(d) THEN
    PrintE("Error: deck is full!")
    Break()
  FI

  crds=d.cards
  i=Index(d,d.count)
  crds(i)=c
  d.count==+1
RETURN

PROC PrintCard(BYTE c)
  BYTE s,v
  BYTE ARRAY fig=['J 'Q 'K 'A]
  BYTE ARRAY suit=[16 96 0 123]

  s=c/13 v=c MOD 13
  IF v<=8 THEN
    PrintB(v+2)
  ELSE
    Put(fig(v-9))
  FI
  Put(suit(s))
RETURN

PROC PrintDeck(Deck POINTER d)
  BYTE i,i2
  BYTE ARRAY crds

  crds=d.cards
  IF IsEmpty(d) THEN
    Print("Empty")
  ELSE
    FOR i=0 TO d.count-1
    DO
      i2=Index(d,i)
      PrintCard(crds(i2))
      IF i<d.count-1 THEN
        Put(' )
      FI
    OD
  FI
RETURN

PROC Main()
  BYTE LMARGIN=$52,oldLMARGIN,i,c
  BYTE ARRAY crds(MAXDECKSIZE),crds1(MAXDECKSIZE),crds2(MAXDECKSIZE)
  Deck d,d1,d2

  oldLMARGIN=LMARGIN
  LMARGIN=0 ;remove left margin on the screen
  Put(125) PutE() ;clear the screen

  PrintE("New deck:")
  InitFull(d,crds)
  PrintDeck(d) PutE() PutE()

  PrintE("Shuffle:")
  Shuffle(d)
  PrintDeck(d) PutE() PutE()

  PrintE("Deal cards:")
  InitEmpty(d1,crds1) InitEmpty(d2,crds2)
  FOR i=1 TO 5
  DO
    c=Deal(d) Add(d1,c)
    c=Deal(d) Add(d2,c)
  OD
  Print("  Player 1: ") PrintDeck(d1) PutE()
  Print("  Player 2: ") PrintDeck(d2) PutE() PutE()

  PrintE("Deck after dealing:")
  PrintDeck(d)

  LMARGIN=oldLMARGIN ;restore left margin on the screen
RETURN


MODE CARD = STRUCT(STRING pip, suit); # instance attributes #

# class members & attributes #
STRUCT(
  PROC(REF CARD, STRING, STRING)VOID init,
  FORMAT format,
  PROC(REF CARD)STRING repr,
  []STRING suits, pips
) class card = (
# PROC init = # (REF CARD self, STRING pip, suit)VOID:(
    pip OF self:=pip;
    suit OF self :=suit
  ),
# format = # $"("g" OF "g")"$,
# PROC repr = # (REF CARD self)STRING: (
    HEAP STRING out; putf(BOOK out,(format OF class card,self)); out
  ),
# suits = # ("Clubs","Hearts","Spades","Diamonds"),
# pips = # ("2","3","4","5","6","7","8","9","10","Jack","Queen","King","Ace")
);

MODE DECK = STRUCT(REF[]CARD deck); # instance attributes #

# class members & attributes #
STRUCT(
  PROC(REF DECK)VOID init, shuffle,
  PROC(REF DECK)STRING repr,
  PROC(REF DECK)CARD deal
) class deck = (

# PROC init = # (REF DECK self)VOID:(
    HEAP[ UPB suits OF class card * UPB pips OF class card ]CARD new;
    FOR suit TO UPB suits OF class card DO
      FOR pip TO UPB pips OF class card DO
        new[(suit-1)*UPB pips OF class card + pip] :=
           ((pips OF class card)[pip], (suits OF class card)[suit])
      OD
    OD;
    deck OF self := new
  ),

# PROC shuffle = # (REF DECK self)VOID:
    FOR card TO UPB deck OF self DO
      CARD this card = (deck OF self)[card];
      INT random card = random int(LWB deck OF self,UPB deck OF self);
      (deck OF self)[card] := (deck OF self)[random card];
      (deck OF self)[random card] := this card
    OD,

# PROC repr = # (REF DECK self)STRING: (
    FORMAT format = $"("n(UPB deck OF self-1)(f(format OF class card)", ")f(format OF class card)")"$;
    HEAP STRING out; putf(BOOK out,(format, deck OF self)); out
  ),

# PROC deal = # (REF DECK self)CARD: (
    (shuffle OF class deck)(self);
    (deck OF self)[UPB deck OF self]
  )
);

# associate a STRING with a FILE for easy text manipulation #
OP BOOK = (REF STRING string)REF FILE:(
  HEAP FILE book;
  associate(book, string);
  book
);

# Pick a random integer between from [lwb..upb] #
PROC random int = (INT lwb, upb)INT:
  ENTIER(random * (upb - lwb + 1) + lwb);

DECK deck;
(init OF class deck)(deck);
(shuffle OF class deck)(deck);
print (((repr OF class deck)(deck), new line))


(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
#include
"share/HATS/atspre_staload_libats_ML.hats"
//
(* ****** ****** *)
//
[email protected]
pip_type = int
[email protected]
suit_type = int
//
[email protected]
card_type = int
//
(* ****** ****** *)

typedef pip = pip_type
typedef suit = suit_type

(* ****** ****** *)

typedef card = card_type

(* ****** ****** *)
//
extern
fun
pip_make: natLt(13) -> pip
extern
fun
pip_get_name: pip -> string
extern
fun
pip_get_value: pip -> intBtwe(1, 13)
//
extern
fun
suit_make: natLt(4) -> suit
extern
fun
suit_get_name: suit -> string
extern
fun
suit_get_value: suit -> intBtwe(1, 4)
//
overload .name with pip_get_name
overload .name with suit_get_name
overload .value with pip_get_value
overload .value with suit_get_value
//
(* ****** ****** *)
//
(*
  | Two | Three | Four | Five
  | Six | Seven | Eight | Nine
  | Ten | Jack | Queen | King | Ace
*)
//
(*
  | Spade | Heart | Diamond | Club
*)
//
(* ****** ****** *)

local

assume
pip_type = natLt(13)

in (* in-of-local *)

implement
pip_make(x) = x
implement
pip_get_value(x) = x + 1

end // end of [local]

(* ****** ****** *)

local

assume
suit_type = natLt(4)

in (* in-of-local *)

implement
suit_make(x) = x
implement
suit_get_value(x) = x + 1

end // end of [local]

(* ****** ****** *)

implement
pip_get_name
  (x) =
(
case+
x.value()
of // case+
| 1 => "Ace"
| 2 => "Two"
| 3 => "Three"
| 4 => "Four"
| 5 => "Five"
| 6 => "Six"
| 7 => "Seven"
| 8 => "Eight"
| 9 => "Nine"
| 10 => "Ten"
| 11 => "Jack"
| 12 => "Queen"
| 13 => "King"
)

(* ****** ****** *)
//
implement
suit_get_name
  (x) =
(
case+
x.value()
of // case+
| 1 => "S" | 2 => "H" | 3 => "D" | 4 => "C"
) (* end of [suit_get_name] *)
//
(* ****** ****** *)
//
extern
fun
card_get_pip: card -> pip
extern
fun
card_get_suit: card -> suit
//
extern
fun
card_make: natLt(52) -> card
extern
fun
card_make_suit_pip: (suit, pip) -> card
//
(* ****** ****** *)

extern
fun
fprint_pip : fprint_type(pip)
extern
fun
fprint_suit : fprint_type(suit)
extern
fun
fprint_card : fprint_type(card)

(* ****** ****** *)

overload .pip with card_get_pip
overload .suit with card_get_suit

(* ****** ****** *)

implement
fprint_val<card> = fprint_card

(* ****** ****** *)

overload fprint with fprint_pip
overload fprint with fprint_suit
overload fprint with fprint_card

(* ****** ****** *)

local

assume
card_type = natLt(52)

in (* in-of-local *)
//
implement
card_get_pip
  (x) = pip_make(nmod(x, 13))
implement
card_get_suit
  (x) = suit_make(ndiv(x, 13))
//
implement
card_make(xy) = xy
//
implement
card_make_suit_pip(x, y) =
  (x.value()-1) * 13 + (y.value()-1)
//
end // end of [local]

(* ****** ****** *)
//
implement
fprint_pip(out, x) =
  fprint!(out, x.name())
implement
fprint_suit(out, x) =
  fprint!(out, x.name())
//
implement
fprint_card(out, c) =
  fprint!(out, c.suit(), "(", c.pip(), ")")
//
(* ****** ****** *)
//
absvtype
deck_vtype(n:int) = ptr
//
vtypedef deck(n:int) = deck_vtype(n)
//
(* ****** ****** *)
//
extern
fun
deck_get_size
  {n:nat}(!deck(n)): int(n)
//
extern
fun
deck_is_empty
  {n:nat}(!deck(n)): bool(n==0)
//
overload iseqz with deck_is_empty
//
(* ****** ****** *)
//
extern
fun
deck_free{n:int}(deck(n)): void
//
overload .free with deck_free
//
(* ****** ****** *)
//
extern
fun
deck_make_full((*void*)): deck(52)
//
(* ****** ****** *)
//
extern
fun
fprint_deck
  {n:nat}(FILEref, !deck(n)): void
//
overload fprint with fprint_deck
//
(* ****** ****** *)
//
extern
fun
deck_shuffle
  {n:nat}(!deck(n) >> _): void
//
overload .shuffle with deck_shuffle
//
(* ****** ****** *)
//
extern
fun
deck_takeout_top
  {n:pos}(!deck(n) >> deck(n-1)): card
//
(* ****** ****** *)

local
//
datavtype
deck(int) =
| {n:nat}
  Deck(n) of
  (
    int(n)
  , list_vt(card, n)
  ) // end of [Deck]
//
assume
deck_vtype(n:int) = deck(n)
//
in (* in-of-local *)

implement
deck_get_size
  (deck) =
(
let val+Deck(n, _) = deck in n end
)

implement
deck_is_empty
  (deck) =
(
let val+Deck(n, _) = deck in n = 0 end
)

(* ****** ****** *)
//
implement
deck_free(deck) =
(
let val+~Deck(n, xs) = deck in free(xs) end
) (* end of [deck_free] *)
//
(* ****** ****** *)

implement
deck_make_full
  ((*void*)) = let
//
val xys =
list_make_intrange(0, 52)
//
val cards =
list_vt_mapfree_fun<natLt(52)><card>(xys, lam xy => card_make(xy))
//
in
  Deck(52, cards)
end // end of [deck_make_full]

(* ****** ****** *)

implement
fprint_deck
  (out, deck) = let
//
val+Deck(n, xs) = deck
//
in
//
fprint_list_vt(out, xs)
//
end // end of [fprint_deck]

(* ****** ****** *)

implement
deck_shuffle
  (deck) =
  [email protected](deck) where
{
//
[email protected](n, xs) = deck
//
implement
list_vt_permute$randint<>
  (n) = randint(n)
//
val ((*void*)) =
  (xs := list_vt_permute(xs))
//
} (* end of [deck_shuffle] *)

(* ****** ****** *)

implement
deck_takeout_top
  (deck) = let
//
[email protected](n, xs) = deck
//
val+
~list_vt_cons(x0, xs_tl) = xs
//
val ((*void*)) = n := n - 1
val ((*void*)) = (xs := xs_tl)
//
in
  [email protected](deck); x0(*top*)
end // end of [deck_takeout_top]

end // end of [local]

(* ****** ****** *)

implement
main0((*void*)) =
{
//
val () =
println!
(
"Hello from [Playing_cards]!"
) (* println! *)
//
val out = stdout_ref
//
val theDeck =
  deck_make_full((*void*))
//
val ((*void*)) =
  fprintln!(out, "theDeck = ", theDeck)
//
val ((*void*)) =
  theDeck.shuffle((*void*))
//
val ((*void*)) =
  fprintln!(out, "theDeck = ", theDeck)
//
val ((*void*)) =
  loop_deal(theDeck) where
{
//
fun
loop_deal{n:nat}
(
  deck: !deck(n) >> deck(0)
) : void =
(
  if (
  iseqz(deck)
  ) then ((*void*))
    else
      let
        val card =
        deck_takeout_top(deck)
      in
        fprintln!(out, card); loop_deal(deck)
      end // end of [let]
    // end of [else]
)
//
} (* end of [val] *)
//
val ((*freed*)) = theDeck.free()
//
} (* end of [main0] *)

(* ****** ****** *)


suits := ["♠", "♦", "♥", "♣"]
values := [2,3,4,5,6,7,8,9,10,"J","Q","K","A"]
Gui, font, s14
Gui, add, button, w190 gNewDeck, New Deck
Gui, add, button, x+10 wp gShuffle, Shuffle
Gui, add, button, x+10 wp gDeal, Deal
Gui, add, text, xs w600 , Current Deck:
Gui, add, Edit, xs wp r4 vDeck
Gui, add, text, xs , Hands:
Gui, add, Edit, x+10 w60  vHands gHands
Gui, add, UpDown,, 1
Edits := 0

Hands:
Gui, Submit, NoHide
loop, % Edits
	GuiControl,Hide, Hand%A_Index%

loop, % Hands
	GuiControl,Show, % "Hand" A_Index

loop, % Hands - Edits
{
	Edits++
	Gui, add, ListBox, % "x" (Edits=1?"s":"+10") " w60 r13 vHand" Edits
}
Gui, show, AutoSize
return
;-----------------------------------------------
GuiClose:
ExitApp
return
;-----------------------------------------------
NewDeck:
cards := [], deck := Dealt:= ""

loop, % Hands
	GuiControl,, Hand%A_Index%, |

for each, suit in suits
	for each, value in values
		cards.Insert(value suit)

for each, card in cards
	deck .= card (mod(A_Index, 13) ? " " : "`n")
GuiControl,, Deck, % deck
GuiControl,, Dealt
GuiControl, Enable, Button2
GuiControl, Enable, Hands
return
;-----------------------------------------------
shuffle:
gosub, NewDeck
shuffled := [], deck := ""
loop, 52 {
	Random, rnd, 1, % cards.MaxIndex()
	shuffled[A_Index] := cards.RemoveAt(rnd)
}
for each, card in shuffled
{
	deck .= card (mod(A_Index, 13) ? " " : "`n")
	cards.Insert(card)
}
GuiControl,, Deck, % deck
return
;-----------------------------------------------
Deal:
Gui, Submit, NoHide
if ( Hands > cards.MaxIndex())
	return

deck := ""
loop, % Hands
	GuiControl,, Hand%A_Index%, % cards.RemoveAt(1)

GuiControl, Disable, Button2
GuiControl, Disable, Hands
GuiControl,, Dealt, % Dealt

for each, card in cards
	deck .= card (mod(A_Index, 13) ? " " : "`n")
GuiControl,, Deck, % deck
return
;-----------------------------------------------


#Region ;**** Directives created by AutoIt3Wrapper_GUI ****
#AutoIt3Wrapper_Change2CUI=y
#EndRegion ;**** Directives created by AutoIt3Wrapper_GUI ****
#include <Array.au3>

; ## GLOBALS ##
Global $SUIT = ["D", "H", "S", "C"]
Global $FACE = [2, 3, 4, 5, 6, 7, 8, 9, 10, "J", "Q", "K", "A"]
Global $DECK[52]

; ## CREATES A NEW DECK
Func NewDeck()

	For $i = 0 To 3
		For $x = 0 To 12
			_ArrayPush($DECK, $FACE[$x] & $SUIT[$i])
		Next
	Next

EndFunc   ;==>NewDeck

; ## SHUFFLE DECK
Func Shuffle()

	_ArrayShuffle($DECK)

EndFunc   ;==>Shuffle

; ## DEAL A CARD
Func Deal()

	Return _ArrayPop($DECK)

EndFunc   ;==>Deal

; ## PRINT DECK
Func Print()

	ConsoleWrite(_ArrayToString($DECK) & @CRLF)

EndFunc   ;==>Print

#Region ;#### USAGE ####
NewDeck()
Print()
Shuffle()
Print()
ConsoleWrite("DEALT: " & Deal() & @CRLF)
Print()
#EndRegion ;#### USAGE ####


DECLARE SUB setInitialValues (deck() AS STRING * 2)
DECLARE SUB shuffle (deck() AS STRING * 2)
DECLARE SUB showDeck (deck() AS STRING * 2)
DECLARE FUNCTION deal$ (deck() AS STRING * 2)

DATA "AS", "2S", "3S", "4S", "5S", "6S", "7S", "8S", "9S", "TS", "JS", "QS", "KS"
DATA "AH", "2H", "3H", "4H", "5H", "6H", "7H", "8H", "9H", "TH", "JH", "QH", "KH"
DATA "AC", "2C", "3C", "4C", "5C", "6C", "7C", "8C", "9C", "TC", "JC", "QC", "KC"
DATA "AD", "2D", "3D", "4D", "5D", "6D", "7D", "8D", "9D", "TD", "JD", "QD", "KD"

RANDOMIZE TIMER

REDIM cards(51) AS STRING * 2
REDIM cards2(51) AS STRING * 2

setInitialValues cards()
setInitialValues cards2()
shuffle cards()
PRINT "Dealt: "; deal$(cards())
PRINT "Dealt: "; deal$(cards())
PRINT "Dealt: "; deal$(cards())
PRINT "Dealt: "; deal$(cards())
showDeck cards()
showDeck cards2()

FUNCTION deal$ (deck() AS STRING * 2)
    'technically dealing from the BOTTOM of the deck... whatever
    DIM c AS STRING * 2
    c = deck(UBOUND(deck))
    REDIM PRESERVE deck(LBOUND(deck) TO UBOUND(deck) - 1) AS STRING * 2
    deal$ = c
END FUNCTION

SUB setInitialValues (deck() AS STRING * 2)
    DIM L0 AS INTEGER

    RESTORE
    FOR L0 = 0 TO 51
        READ deck(L0)
    NEXT
END SUB

SUB showDeck (deck() AS STRING * 2)
    FOR L% = LBOUND(deck) TO UBOUND(deck)
        PRINT deck(L%); " ";
    NEXT
    PRINT
END SUB

SUB shuffle (deck() AS STRING * 2)
    DIM w AS INTEGER
    DIM shuffled(51) AS STRING * 2
    DIM L0 AS INTEGER

    FOR L0 = 51 TO 0 STEP -1
        w = INT(RND * (L0 + 1))
        shuffled(L0) = deck(w)
        IF w <> L0 THEN deck(w) = deck(L0)
    NEXT

    FOR L0 = 0 TO 51
        deck(L0) = shuffled(L0)
    NEXT
END SUB


@echo off
setlocal enabledelayedexpansion

call:newdeck deck
echo new deck:
echo.
call:showcards deck
echo.
echo shuffling:
echo.
call:shuffle deck
call:showcards deck
echo.
echo dealing 5 cards to 4 players
call:deal deck 5 hand1 hand2 hand3 hand4
echo.
echo player 1 & call:showcards hand1
echo.
echo player 2 & call:showcards hand2
echo.
echo player 3 & call:showcards hand3
echo.
echo player 4 & call:showcards hand4
echo.
call:count %deck% cnt
echo %cnt% cards remaining in the deck
echo.
 call:showcards deck
echo.

exit /b

:getcard deck hand  :: deals 1 card to a player
   set "loc1=!%~1!"
   set "%~2=!%~2!!loc1:~0,3!"
   set "%~1=!loc1:~3!"
exit /b

:deal deck n player1 player2...up to 7
 set "loc=!%~1!"
 set "cards=%~2"
 set players=%3 %4 %5 %6 %7 %8 %9
 for /L %%j in (1,1,!cards!) do (
     for %%k in (!players!) do call:getcard loc %%k)
 set "%~1=!loc!"
 exit /b

:newdeck  [deck]   ::creates a deck of cards
 :: in the parentheses below there are ascii chars 3,4,5 and 6 representing the suits
 for %%i in ( ♠ ♦ ♥ ♣ ) do (
   for %%j in (20 31 42 53 64 75 86 97 T8 J9 QA KB AC) do set loc=!loc!%%i%%j
   )
 set "%~1=!loc!"
exit /b

:showcards  [deck]  :: prints a deck or a hand
 set "loc=!%~1!"
  for /L %%j in (0,39,117) do (
     set s=
     for /L %%i in (0,3,36) do (
        set /a n=%%i+%%j
        call set  s=%%s%% %%loc:~!n!,2%%
      )
  if "!s: =!" neq "" echo(!s!
  set /a n+=1
  if "%loc:~!n!,!%" equ "" goto endloop
  )
 :endloop
 exit /b

:count deck count
set "loc1=%1"
set /a cnt1=0
for %%i in (96 48 24 12 6 3 ) do if "!loc1:~%%i,1!" neq "" set /a cnt1+=%%i & set loc1=!loc1:~%%i!
set /a cnt1=cnt1/3+1
set "%~2=!cnt1!"
exit /b

:shuffle (deck)   :: shuffles a deck
 set "loc=!%~1!"
 call:count %loc%, cnt
 set /a cnt-=1
 for /L %%i in (%cnt%,-1,0) do (
    SET /A "from=%%i,to=(!RANDOM!*(%%i-1)/32768)"
	call:swap loc from to
  )
  set "%~1=!loc!"
 exit /b

 :swap deck from to   :: swaps two cards
    set "arr=!%~1!"
    set /a "from=!%~2!*3,to=!%~3!*3"
	set temp1=!arr:~%from%,3!
    set temp2=!arr:~%to%,3!
    set arr=!arr:%temp1%[email protected]@@!
    set arr=!arr:%temp2%=%temp1%!
    set arr=!arr:@@@=%temp2%!
	set "%~1=!arr!"
 exit /b


      DIM Deck{ncards%, card&(51)}, Suit$(3), Rank$(12)
      Suit$() = "Clubs", "Diamonds", "Hearts", "Spades"
      Rank$() = "Ace", "Two", "Three", "Four", "Five", "Six", "Seven", \
      \         "Eight", "Nine", "Ten", "Jack", "Queen", "King"

      PRINT "Creating a new deck..."
      PROCnewdeck(deck1{})
      PRINT "Shuffling the deck..."
      PROCshuffle(deck1{})
      PRINT "The first few cards are:"
      FOR card% = 1 TO 8
        PRINT FNcardname(deck1.card&(card%))
      NEXT
      PRINT "Dealing three cards from the deck:"
      FOR card% = 1 TO 3
        PRINT FNcardname(FNdeal(deck1{}))
      NEXT
      PRINT "Number of cards remaining in the deck = " ; deck1.ncards%
      END

      REM Make a new deck:
      DEF PROCnewdeck(RETURN deck{})
      LOCAL N%
      DIM deck{} = Deck{}
      FOR N% = 0 TO 51
        deck.card&(N%) = N%
        deck.ncards% += 1
      NEXT
      ENDPROC

      REM Shuffle a deck:
      DEF PROCshuffle(deck{})
      LOCAL N%
      FOR N% = 52 TO 2 STEP -1
        SWAP deck.card&(N%-1), deck.card&(RND(N%)-1)
      NEXT
      ENDPROC

      REM Deal from the 'bottom' of the deck:
      DEF FNdeal(deck{})
      IF deck.ncards% = 0 THEN ERROR 100, "Deck is empty"
      deck.ncards% -= 1
      = deck.card&(deck.ncards%)

      REM Return the name of a card:
      DEF FNcardname(card&)
      = Rank$(card& >> 2) + " of " + Suit$(card& AND 3)


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

int locale_ok = 0;

wchar_t s_suits[] = L"♠♥♦♣";
/* if your file can't contain unicode, use the next line instead */
//wchar_t s_suits[] = L"\x2660\x2665\x2666\x2663";

const char *s_suits_ascii[] = { "S", "H", "D", "C" };
const char *s_nums[] = { "WHAT",
	"A", "2", "3", "4", "5", "6", "7", "8", "9", "10", "J", "Q", "K",
	"OVERFLOW"
};

typedef struct { int suit, number, _s; } card_t, *card;
typedef struct { int n; card_t cards[52]; } deck_t, *deck;

void show_card(card c)
{
	if (locale_ok)
		printf(" %lc%s", s_suits[c->suit], s_nums[c->number]);
	else
		printf(" %s%s", s_suits_ascii[c->suit], s_nums[c->number]);
}

deck new_deck()
{
	int i, j, k;
	deck d = malloc(sizeof(deck_t));
	d->n = 52;
	for (i = k = 0; i < 4; i++)
		for (j = 1; j <= 13; j++, k++) {
			d->cards[k].suit = i;
			d->cards[k].number = j;
		}
	return d;
}

void show_deck(deck d)
{
	int i;
	printf("%d cards:", d->n);
	for (i = 0; i < d->n; i++)
		show_card(d->cards + i);
	printf("\n");
}

int cmp_card(const void *a, const void *b)
{
	int x = ((card)a)->_s, y = ((card)b)->_s;
	return x < y ? -1 : x > y;
}

card deal_card(deck d)
{
	if (!d->n) return 0;
	return d->cards + --d->n;
}

void shuffle_deck(deck d)
{
	int i;
	for (i = 0; i < d->n; i++)
		d->cards[i]._s = rand();
	qsort(d->cards, d->n, sizeof(card_t), cmp_card);
}

int main()
{
	int i, j;
	deck d = new_deck();

	locale_ok = (0 != setlocale(LC_CTYPE, ""));

	printf("New deck, "); show_deck(d);

	printf("\nShuffle and deal to three players:\n");
	shuffle_deck(d);
	for (i = 0; i < 3; i++) {
		for (j = 0; j < 5; j++)
			show_card(deal_card(d));
		printf("\n");
	}
	printf("Left in deck "); show_deck(d);

	/* freeing the data struct requires just free(), but it depends on the
	 * situation: there might be cards dealt out somewhere, which is not
	 * in the scope of this task.
	 */
	//free(d);
	return 0;
}


using System;
using System.Linq;
using System.Collections.Generic;

public struct Card
{
    public Card(string rank, string suit) : this()
    {
        Rank = rank;
        Suit = suit;
    }

    public string Rank { get; }
    public string Suit { get; }

    public override string ToString() => $"{Rank} of {Suit}";
}

public class Deck : IEnumerable<Card>
{
    static readonly string[] ranks = { "Two", "Three", "Four", "Five", "Six",
        "Seven", "Eight", "Nine", "Ten", "Jack", "Queen", "King", "Ace" };
    static readonly string[] suits = { "Clubs", "Diamonds", "Hearts", "Spades" };
    readonly List<Card> cards;

    public Deck() {
        cards = (from suit in suits
                from rank in ranks
                select new Card(rank, suit)).ToList();
    }

    public int Count => cards.Count;

    public void Shuffle() {
        // using Knuth Shuffle (see at http://rosettacode.org/wiki/Knuth_shuffle)
        var random = new Random();
        for (int i = 0; i < cards.Count; i++) {
            int r = random.Next(i, cards.Count);
            var temp = cards[i];
            cards[i] = cards[r];
            cards[r] = temp;
        }
    }

    public Card Deal() {
        int last = cards.Count - 1;
        Card card = cards[last];
        //Removing from the front will shift the other items back 1 spot,
        //so that would be an O(n) operation. Removing from the back is O(1).
        cards.RemoveAt(last);
        return card;
    }

    public IEnumerator<Card> GetEnumerator() {
        //Reverse enumeration of the list so that they are returned in the order they would be dealt.
        //LINQ's Reverse() copies the entire list. Let's avoid that.
        for (int i = cards.Count - 1; i >= 0; i--)
            yield return cards[i];
    }

    System.Collections.IEnumerator System.Collections.IEnumerable.GetEnumerator() => GetEnumerator();
}


#include <deque>
#include <algorithm>
#include <ostream>
#include <iterator>

namespace cards
{
class card
{
public:
    enum pip_type { two, three, four, five, six, seven, eight, nine, ten,
                    jack, queen, king, ace, pip_count };
    enum suite_type { hearts, spades, diamonds, clubs, suite_count };
    enum { unique_count = pip_count * suite_count };

    card(suite_type s, pip_type p): value(s + suite_count * p) {}

    explicit card(unsigned char v = 0): value(v) {}

    pip_type pip() { return pip_type(value / suite_count); }

    suite_type suite() { return suite_type(value % suite_count); }

private:
    unsigned char value;
};

const char* const pip_names[] =
    { "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten",
      "jack", "queen", "king", "ace" };

std::ostream& operator<<(std::ostream& os, card::pip_type pip)
{
    return os << pip_names[pip];
}

const char* const suite_names[] =
    { "hearts", "spades", "diamonds", "clubs" };

std::ostream& operator<<(std::ostream& os, card::suite_type suite)
{
    return os << suite_names[suite];
}

std::ostream& operator<<(std::ostream& os, card c)
{
    return os << c.pip() << " of " << c.suite();
}

class deck
{
public:
    deck()
    {
        for (int i = 0; i < card::unique_count; ++i) {
            cards.push_back(card(i));
        }
    }

    void shuffle() { std::random_shuffle(cards.begin(), cards.end()); }

    card deal() { card c = cards.front(); cards.pop_front(); return c; }

    typedef std::deque<card>::const_iterator const_iterator;
    const_iterator begin() const { return cards.cbegin(); }
    const_iterator end() const { return cards.cend(); }
private:
    std::deque<card> cards;
};

inline std::ostream& operator<<(std::ostream& os, const deck& d)
{
    std::copy(d.begin(), d.end(), std::ostream_iterator<card>(os, "\n"));
    return os;
}
}


import com.vasileff.ceylon.random.api { ... }

"""Run the example code for Rosetta Code ["Playing cards" task] (http://rosettacode.org/wiki/Playing_cards)."""
shared void run() {
    variable value deck = Deck();
    print("New deck (``deck.size`` cards): ``deck``
           ");

    deck = deck.shuffle();
    print("Shuffeled deck (``deck.size`` cards): ``deck``
           ");

    print("Deal three hands: ");
    for (i in 1..3) {
        value [hand, _deck] = deck.deal();
        print("- Dealt ``hand.size`` cards to hand ``i`` : ``join(hand)``");
        deck = _deck;
    }

    print("
           Deck (``deck.size`` cards) after dealing three hands: ``deck``");

}

abstract class Suit() of clubs | hearts | spades | diamonds {}

object clubs    extends Suit() { string = "♣"; }
object hearts   extends Suit() { string = "♥"; }
object spades   extends Suit() { string = "♠"; }
object diamonds extends Suit() { string = "♦"; }

abstract class Pip() of two | three | four | five | six | seven | eight | nine | ten | jack | queen | king | ace {}
object two   extends Pip() { string =  "2"; }
object three extends Pip() { string =  "3"; }
object four  extends Pip() { string =  "4"; }
object five  extends Pip() { string =  "5"; }
object six   extends Pip() { string =  "6"; }
object seven extends Pip() { string =  "7"; }
object eight extends Pip() { string =  "8"; }
object nine  extends Pip() { string =  "9"; }
object ten   extends Pip() { string = "10"; }
object jack  extends Pip() { string =  "J"; }
object queen extends Pip() { string =  "Q"; }
object king  extends Pip() { string =  "K"; }
object ace   extends Pip() { string =  "A"; }

class Card(shared Pip pip, shared Suit suit) {
    string = "``pip`` of ``suit``";
}

String join(Card[] cards) => ", ".join { *cards };

class Deck (cards = [ for (suit in `Suit`.caseValues) for (pip in `Pip`.caseValues) Card(pip, suit) ]) {
    shared Card[] cards;

    shared Deck shuffle(Random rnd = platformRandom())
            => if (nonempty cards)
               then Deck( [*randomize(cards, rnd)] )
               else this;

    shared Integer size => cards.size;

    shared Boolean empty => cards.empty;

    string => if (size > 13)
              then "\n  " + "\n  ". join { *cards.partition(13).map((cards) => join(cards)) }
              else join(cards);

    shared [Card[], Deck] deal(Integer handSize = 5) {
        if (handSize >= cards.size) {
            return [cards, Deck([])];
        }
        else {
            return [
                cards.initial(handSize),
                Deck(cards.skip(handSize).sequence())
            ];
        }
    }
}


(def suits [:club :diamond :heart :spade])
(def pips [:ace 2 3 4 5 6 7 8 9 10 :jack :queen :king])

(defn deck [] (for [s suits p pips] [s p]))

(def shuffle clojure.core/shuffle)
(def deal first)
(defn output [deck]
  (doseq [[suit pip] deck]
    (println (format "%s of %ss"
                     (if (keyword? pip) (name pip) pip)
                     (name suit)))))


% Represents one playing card.
card = cluster is make, parse, unparse, equal, all_cards
    rep = struct[pip: int, suit: char]
    own suits: string := "CHSD";
    own pips: sequence[string] := sequence[string]$
        ["A","2","3","4","5","6","7","8","9","10","J","Q","K"]

    find_pip = proc (pip: string) returns (int) signals (bad_format)
        for i: int in int$from_to(1, sequence[string]$size(pips)) do
            if pips[i] = pip then return(i) end
        end
        signal bad_format
    end find_pip

    make = proc (pip: int, suit: char) returns (cvt) signals (bad_format)
        if string$indexc(suit, suits) = 0
           cor ~(pip >= 1 cand pip <= 13)
            then signal bad_format
        end
        return(rep${pip: pip, suit: suit})
    end make

    parse = proc (s: string) returns (cvt) signals (bad_format)
        size: int := string$size(s)
        if size<2 cor size>3 then signal bad_format end
        pip: string := string$substr(s, 1, size-1)
        suit: char := string$rest(s, size-1)[1]
        return(down(make(find_pip(pip), suit))) resignal bad_format
    end parse

    unparse = proc (c: cvt) returns (string)
        return( pips[c.pip] || string$c2s(c.suit) )
    end unparse

    equal = proc (a, b: cvt) returns (bool)
        return( a.pip = b.pip cand a.suit = b.suit )
    end equal

    % Yield all cards in the canonical order
    all_cards = iter () yields (cvt)
        for suit: char in string$chars(suits) do
            for pip: int in int$from_to(1,sequence[string]$size(pips)) do
                yield(down(make(pip, suit)))
             end
        end
    end all_cards
end card

% Represents a deck
deck = cluster is new, shuffle, cards, deal, unparse
    rep = array[card]

    new = proc () returns (cvt)
        d: rep := rep$new()
        for c: card in card$all_cards() do rep$addh(d, c) end
        return(d)
    end new

    shuffle = proc (d: cvt)
        lo: int := rep$low(d)
        hi: int := rep$high(d)
        for i: int in int$from_to_by(hi, lo+1, -1) do
            j: int := lo + random$next(i-lo)
            c: card := d[i]
            d[i] := d[j]
            d[j] := c
        end
    end shuffle

    cards = iter (d: cvt) yields (card)
        for c: card in rep$elements(d) do yield(c) end
    end cards

    deal = proc (d: cvt) returns (card) signals (empty)
        if rep$empty(d) then signal empty end
        return(rep$reml(d))
    end deal

    unparse = proc (d: cvt) returns (string)
        ss: stream := stream$create_output()
        n: int := 0
        for c: card in cards(up(d)) do
            if n~=0 cand n//13=0 then stream$putc(ss, '\n')
            elseif n~=0 then stream$putc(ss, ' ')
            end
            stream$puts(ss, card$unparse(c))
            n := n+1
        end
        return(stream$get_contents(ss))
    end unparse
end deck

start_up = proc ()
    po: stream := stream$primary_output()
    % seed the RNG
    d_: date := now()
    random$seed(d_.second + 60*(d_.minute + 60*d_.hour))

    % make a new deck
    d: deck := deck$new()
    stream$putl(po, "New deck: ")
    stream$putl(po, deck$unparse(d))

    % shuffle the deck
    deck$shuffle(d)
    stream$putl(po, "\nShuffled deck: ")
    stream$putl(po, deck$unparse(d))

    % deal some cards
    stream$puts(po, "\nDealing 10 cards:")
    for i: int in int$from_to(1, 10) do
        stream$puts(po, " " || card$unparse(deck$deal(d)))
    end

    % show remaining deck
    stream$putl(po, "\n\nRemaining cards in deck:")
    stream$putl(po, deck$unparse(d))
end start_up


       identification division.
       program-id. playing-cards.

       environment division.
       configuration section.
       repository.
           function all intrinsic.

       data division.
       working-storage section.
       77 card             usage index.
       01 deck.
          05 cards occurs 52 times ascending key slot indexed by card.
             10 slot       pic 99.
             10 hand       pic 99.
             10 suit       pic 9.
             10 symbol     pic x(4).
             10 rank       pic 99.

       01 filler.
          05 suit-name     pic x(8) occurs 4 times.

      *> Unicode U+1F0Ax, Bx, Cx, Dx "f09f82a0" "82b0" "8380" "8390"
       01 base-s           constant as 4036985504.
       01 base-h           constant as 4036985520.
       01 base-d           constant as 4036985728.
       01 base-c           constant as 4036985744.

       01 sym              pic x(4) comp-x.
       01 symx             redefines sym pic x(4).
       77 s                pic 9.
       77 r                pic 99.
       77 c                pic 99.
       77 hit              pic 9.
       77 limiter          pic 9(6).

       01 spades           constant as 1.
       01 hearts           constant as 2.
       01 diamonds         constant as 3.
       01 clubs            constant as 4.

       01 players          constant as 3.
       01 cards-per        constant as 5.
       01 deal             pic 99.
       01 player           pic 99.

       01 show-tally       pic zz.
       01 show-rank        pic z(5).
       01 arg              pic 9(10).

       procedure division.
       cards-main.
       perform seed
       perform initialize-deck
       perform shuffle-deck
       perform deal-deck
       perform display-hands
       goback.

      *> ********
       seed.
           accept arg from command-line
           if arg not equal 0 then
               move random(arg) to c
           end-if
       .

       initialize-deck.
           move "spades" to suit-name(spades)
           move "hearts" to suit-name(hearts)
           move "diamonds" to suit-name(diamonds)
           move "clubs" to suit-name(clubs)

           perform varying s from 1 by 1 until s > 4
                     after r from 1 by 1 until r > 13
                   compute c = (s - 1) * 13 + r
                   evaluate s
                       when spades compute sym = base-s + r
                       when hearts compute sym = base-h + r
                       when diamonds compute sym = base-d + r
                       when clubs compute sym = base-c + r
                   end-evaluate
                   if r > 11 then compute sym = sym + 1 end-if
                   move s to suit(c)
                   move r to rank(c)
                   move symx to symbol(c)
                   move zero to slot(c)
                   move zero to hand(c)
           end-perform
       .

       shuffle-deck.
           move zero to limiter
           perform until exit
               compute c = random() * 52.0 + 1.0
               move zero to hit
               perform varying tally from 1 by 1 until tally > 52
                   if slot(tally) equal c then
                       move 1 to hit
                       exit perform
                   end-if
                   if slot(tally) equal 0 then
                       if tally < 52 then move 1 to hit end-if
                       move c to slot(tally)
                       exit perform
                   end-if
               end-perform
               if hit equal zero then exit perform end-if
               if limiter > 999999 then
                   display "too many shuffles, deck invalid" upon syserr
                   exit perform
               end-if
               add 1 to limiter
           end-perform
           sort cards ascending key slot
       .

       display-card.
       >>IF ENGLISH IS DEFINED
               move rank(tally) to show-rank
               evaluate rank(tally)
                   when 1 display "  ace" with no advancing
                   when 2 thru 10 display show-rank with no advancing
                   when 11 display " jack" with no advancing
                   when 12 display "queen" with no advancing
                   when 13 display " king" with no advancing
               end-evaluate
               display " of " suit-name(suit(tally)) with no advancing
       >>ELSE
               display symbol(tally) with no advancing
       >>END-IF
       .

       display-deck.
           perform varying tally from 1 by 1 until tally > 52
               move tally to show-tally
               display "Card: " show-tally
                       " currently in hand " hand(tally)
                       " is " with no advancing
               perform display-card
               display space
           end-perform
       .

       display-hands.
           perform varying player from 1 by 1 until player > players
               move player to tally
               display "Player " player ": " with no advancing
               perform varying deal from 1 by 1 until deal > cards-per
                  perform display-card
                  add players to tally
               end-perform
               display space
           end-perform
           display "Stock: " with no advancing
           subtract players from tally
           add 1 to tally
           perform varying tally from tally by 1 until tally > 52
               perform display-card
       >>IF ENGLISH IS DEFINED
               display space
       >>END-IF
           end-perform
           display space
       .

       deal-deck.
           display "Dealing " cards-per " cards to " players " players"
           move 1 to tally
           perform varying deal from 1 by 1 until deal > cards-per
                     after player from 1 by 1 until player > players
               move player to hand(tally)
               add 1 to tally
           end-perform
       .

       end program playing-cards.


#translated from JavaScript example
class Card
  constructor: (@pip, @suit) ->

  toString: => "#{@pip}#{@suit}"

class Deck
  pips = '2 3 4 5 6 7 8 9 10 J Q K A'.split ' '
  suits = '♣ ♥ ♠ ♦'.split ' '

  constructor: (@cards) ->
    if not @cards?
      @cards = []
      for suit in suits
        for pip in pips
          @cards.push new Card(pip, suit)

  toString: => "[#{@cards.join(', ')}]"

  shuffle: =>
    for card, i in @cards
      randomCard = parseInt @cards.length * Math.random()
      @cards[i] = @cards.splice(randomCard, 1, card)[0]

  deal: -> @cards.shift()


(defconstant +suits+
  '(club diamond heart spade)
  "Card suits are the symbols club, diamond, heart, and spade.")

(defconstant +pips+
  '(ace 2 3 4 5 6 7 8 9 10 jack queen king)
  "Card pips are the numbers 2 through 10, and the symbols ace, jack,
queen and king.")

(defun make-deck (&aux (deck '()))
  "Returns a list of cards, where each card is a cons whose car is a
suit and whose cdr is a pip."
  (dolist (suit +suits+ deck)
    (dolist (pip +pips+)
      (push (cons suit pip) deck))))

(defun shuffle (list)
  "Returns a shuffling of list, by sorting it with a random
predicate. List may be modified."
  (sort list #'(lambda (x y)
                 (declare (ignore x y))
                 (zerop (random 2)))))


import std.stdio, std.typecons, std.algorithm, std.traits, std.array,
       std.range, std.random;

enum Pip {Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten,
          Jack, Queen, King, Ace}
enum Suit {Diamonds, Spades, Hearts, Clubs}
alias Card = Tuple!(Pip, Suit);

auto newDeck() pure nothrow @safe {
    return cartesianProduct([EnumMembers!Pip], [EnumMembers!Suit]);
}

alias shuffleDeck = randomShuffle;

Card dealCard(ref Card[] deck) pure nothrow @safe @nogc {
    immutable card = deck.back;
    deck.popBack;
    return card;
}

void show(in Card[] deck) @safe {
    writefln("Deck:\n%(%s\n%)\n", deck);
}

void main() /*@safe*/ {
    auto d = newDeck.array;
    d.show;
    d.shuffleDeck;
    while (!d.empty)
        d.dealCard.writeln;
}


program Cards;

{$APPTYPE CONSOLE}

uses
  SysUtils, Classes;

type
  TPip = (pTwo, pThree, pFour, pFive, pSix, pSeven, pEight, pNine, pTen, pJack, pQueen, pKing, pAce);
  TSuite = (sDiamonds, sSpades, sHearts, sClubs);

const
  cPipNames: array[TPip] of string = ('2', '3', '4', '5', '6', '7', '8', '9', '10', 'J', 'Q', 'K', 'A');
  cSuiteNames: array[TSuite] of string = ('Diamonds', 'Spades', 'Hearts', 'Clubs');

type
  TCard = class
  private
    FSuite: TSuite;
    FPip: TPip;
  public
    constructor Create(aSuite: TSuite; aPip: TPip);
    function ToString: string; override;

    property Pip: TPip read FPip;
    property Suite: TSuite read FSuite;
  end;

  TDeck = class
  private
    FCards: TList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Shuffle;
    function Deal: TCard;
    function ToString: string; override;
  end;

{ TCard }

constructor TCard.Create(aSuite: TSuite; aPip: TPip);
begin
  FSuite := aSuite;
  FPip := aPip;
end;

function TCard.ToString: string;
begin
  Result := Format('%s of %s', [cPipNames[Pip], cSuiteNames[Suite]])
end;

{ TDeck }

constructor TDeck.Create;
var
  pip: TPip;
  suite: TSuite;
begin
  FCards := TList.Create;
  for suite := Low(TSuite) to High(TSuite) do
    for pip := Low(TPip) to High(TPip) do
      FCards.Add(TCard.Create(suite, pip));
end;

function TDeck.Deal: TCard;
begin
  Result := FCards[0];
  FCards.Delete(0);
end;

destructor TDeck.Destroy;
var
  i: Integer;
  c: TCard;
begin
  for i := FCards.Count - 1 downto 0 do begin
    c := FCards[i];
    FCards.Delete(i);
    c.Free;
  end;
  FCards.Free;
  inherited;
end;

procedure TDeck.Shuffle;
var
  i, j: Integer;
  temp: TCard;
begin
  Randomize;
  for i := FCards.Count - 1 downto 0 do begin
    j := Random(FCards.Count);
    temp := FCards[j];
    FCards.Delete(j);
    FCards.Add(temp);
  end;
end;

function TDeck.ToString: string;
var
  i: Integer;
begin
  for i := 0 to FCards.Count - 1 do
    Writeln(TCard(FCards[i]).ToString);
end;

begin
  with TDeck.Create do
  try
    Shuffle;
    ToString;
    Writeln;
    with Deal do
    try
      Writeln(ToString);
    finally
      Free;
    end;
  finally
    Free;
  end;

  Readln;
end.


defmodule Card do
  defstruct pip: nil, suit: nil
end

defmodule Playing_cards do
  @pips   ~w[2 3 4 5 6 7 8 9 10 Jack Queen King Ace]a
  @suits  ~w[Clubs Hearts Spades Diamonds]a
  @pip_value   Enum.with_index(@pips)
  @suit_value  Enum.with_index(@suits)

  def deal( n_cards, deck ), do: Enum.split( deck, n_cards )

  def deal( n_hands, n_cards, deck ) do
    Enum.reduce(1..n_hands, {[], deck}, fn _,{acc,d} ->
      {hand, new_d} = deal(n_cards, d)
      {[hand | acc], new_d}
    end)
  end

  def deck, do: (for x <- @suits, y <- @pips, do: %Card{suit: x, pip: y})

  def print( cards ), do: IO.puts (for x <- cards, do: "\t#{inspect x}")

  def shuffle( deck ), do: Enum.shuffle( deck )

  def sort_pips( cards ), do: Enum.sort_by( cards, &@pip_value[&1.pip] )

  def sort_suits( cards ), do: Enum.sort_by( cards, &(@suit_value[&1.suit]) )

  def task do
    shuffled = shuffle( deck )
    {hand, new_deck} = deal( 3, shuffled )
    {hands, _deck} = deal( 2, 3, new_deck )
    IO.write "Hand:"
    print( hand )
    IO.puts "Hands:"
    for x <- hands, do: print(x)
  end
end

Playing_cards.task


-module( playing_cards ).

-export( [deal/2, deal/3, deck/0, print/1, shuffle/1, sort_pips/1, sort_suites/1, task/0] ).

-record( card, {pip, suite} ).

-spec( deal( N_cards::integer(), Deck::[#card{}]) -> {Hand::[#card{}], Deck::[#card{}]} ).
deal( N_cards, Deck ) -> lists:split( N_cards, Deck ).
-spec( deal( N_hands::integer(), N_cards::integer(), Deck::[#card{}]) -> {List_of_hands::[[#card{}]], Deck::[#card{}]} ).
deal( N_hands, N_cards, Deck ) -> lists:foldl( fun deal_hands/2, {lists:duplicate(N_hands, []), Deck}, lists:seq(1, N_cards * N_hands) ).

deck() -> [#card{suite=X, pip=Y} || X <- suites(), Y <- pips()].

print( Cards ) -> [io:fwrite( "	~p", [X]) || X <- Cards], io:nl().

shuffle( Deck ) -> knuth_shuffle:list( Deck ).

sort_pips( Cards ) -> lists:keysort( #card.pip, Cards ).

sort_suites( Cards ) -> lists:keysort( #card.suite, Cards ).

task() ->
    Deck = deck(),
    Shuffled = shuffle( Deck ),
    {Hand, New_deck} = deal( 3, Shuffled ),
    {Hands, _Deck} = deal( 2, 3, New_deck ),
    io:fwrite( "Hand:" ),
    print( Hand ),
    io:fwrite( "Hands:~n" ),
    [print(X) || X <- Hands].

deal_hands( _N, {[Hand | T], [Card | Deck]} ) -> {T ++ [[Card | Hand]], Deck}.

pips() -> ["2", "3", "4", "5", "6", "7", "8", "9", "10", "Jack", "Queen", "King", "Ace"].

suites() -> ["Clubs", "Hearts", "Spades", "Diamonds"].


USING: formatting grouping io kernel math qw random sequences
vectors ;
IN: rosetta-code.playing-cards

CONSTANT: pips  qw{ A 2 3 4 5 6 7 8 9 10 J Q K }
CONSTANT: suits qw{ ♥ ♣ ♦ ♠ }

: <deck> ( -- vec ) 52 <iota> >vector ;

: card>str ( n -- str )
    13 /mod [ suits nth ] [ pips nth ] bi* prepend ;

: print-deck ( seq -- )
    13 group [ [ card>str "%-4s" printf ] each nl ] each ;

<deck>       ! make new deck
randomize    ! shuffle the deck
dup pop drop ! deal from the deck (and discard)
print-deck   ! print the deck


enum class Suit { clubs, diamonds, hearts, spades }
enum class Pips { ace, two, three, four, five,
  six, seven, eight, nine, ten, jack, queen, king
}

class Card
{
  readonly Suit suit
  readonly Pips pips

  new make (Suit suit, Pips pips)
  {
    this.suit = suit
    this.pips = pips
  }

  override Str toStr ()
  {
    "card: $pips of $suit"
  }
}

class Deck
{
  Card[] deck := [,]

  new make ()
  {
    Suit.vals.each |val|
    {
      Pips.vals.each |pip| { deck.add (Card(val, pip)) }
    }
  }

  Void shuffle (Int swaps := 50)
  {
    swaps.times { deck.swap(Int.random(0..deck.size-1), Int.random(0..deck.size-1)) }
  }

  Card[] deal (Int cards := 1)
  {
    if (cards > deck.size) throw ArgErr("$cards is larger than ${deck.size}")
    Card[] result := [,]
    cards.times { result.push (deck.removeAt (0)) }
    return result
  }

  Void show ()
  {
    deck.each |card| { echo (card.toStr) }
  }
}

class PlayingCards
{
  public static Void main ()
  {
    deck := Deck()
    deck.shuffle
    Card[] hand := deck.deal (7)
    echo ("Dealt hand is:")
    hand.each |card| { echo (card.toStr) }
    echo ("Remaining deck is:")
    deck.show
  }
}


require random.fs   \ RANDOM ( n -- 0..n-1 ) is called CHOOSE in other Forths

create pips  s" A23456789TJQK" mem,
create suits s" DHCS"          mem, \ diamonds, hearts, clubs, spades
: .card ( c -- )
  13 /mod swap
  pips  + [email protected] emit
  suits + [email protected] emit ;

create deck 52 allot
variable dealt

: new-deck
  52 0        do i deck i + c!             loop  0 dealt ! ;
: .deck
  52 dealt @ ?do   deck i + [email protected] .card space loop  cr ;
: shuffle
  51 0 do
    52 i - random i + ( rand-index ) deck +
    deck i + [email protected]  over [email protected]
    deck i + c!  swap c!
  loop ;
: cards-left ( -- n ) 52 dealt @ - ;
: deal-card ( -- c )
  cards-left 0= abort" Deck empty!"
  deck dealt @ + [email protected]  1 dealt +! ;
: .hand ( n -- )
  0 do deal-card .card space loop cr ;

new-deck shuffle .deck
5 .hand
cards-left .  \ 47


MODULE Cards

IMPLICIT NONE

  TYPE Card
    CHARACTER(5) :: value
    CHARACTER(8) :: suit
  END TYPE Card

  TYPE(Card) :: deck(52), hand(52)
  TYPE(Card) :: temp

  CHARACTER(5) :: pip(13) = (/"Two  ", "Three", "Four ", "Five ", "Six  ", "Seven", "Eight", "Nine ", "Ten  ", &
                              "Jack ", "Queen", "King ", "Ace  "/)
  CHARACTER(8) :: suits(4) = (/"Clubs   ", "Diamonds", "Hearts  ", "Spades  "/)
  INTEGER :: i, j, n, rand, dealt = 0
  REAL :: x

CONTAINS

  SUBROUTINE Init_deck
  ! Create deck
    DO i = 1, 4
      DO j = 1, 13
        deck((i-1)*13+j) = Card(pip(j), suits(i))
      END DO
    END DO
  END SUBROUTINE Init_deck

  SUBROUTINE Shuffle_deck
  ! Shuffle deck using Fisher-Yates algorithm
    DO i = 52-dealt, 1, -1
      CALL RANDOM_NUMBER(x)
      rand = INT(x * i) + 1
      temp = deck(rand)
      deck(rand) = deck(i)
      deck(i) = temp
    END DO
  END SUBROUTINE Shuffle_deck

  SUBROUTINE Deal_hand(number)
  ! Deal from deck to hand
    INTEGER :: number
    DO i = 1, number
      hand(i) = deck(dealt+1)
      dealt = dealt + 1
    END DO
  END SUBROUTINE

  SUBROUTINE Print_hand
  ! Print cards in hand
    DO i = 1, dealt
      WRITE (*, "(3A)") TRIM(deck(i)%value), " of ", TRIM(deck(i)%suit)
    END DO
    WRITE(*,*)
  END SUBROUTINE Print_hand

  SUBROUTINE Print_deck
  ! Print cards in deck
    DO i = dealt+1, 52
      WRITE (*, "(3A)") TRIM(deck(i)%value), " of ", TRIM(deck(i)%suit)
    END DO
    WRITE(*,*)
  END SUBROUTINE Print_deck

END MODULE Cards


#define NSWAPS 100

type card
    suit : 2 as ubyte
    face : 4 as ubyte
    'the remaining 2 bits are unused
end type

dim shared as string*8 Suits(0 to 3) = {"Spades", "Clubs", "Hearts", "Diamonds"}
dim shared as string*8 Faces(0 to 12) = {"Ace", "Two", "Three", "Four", "Five",_
     "Six", "Seven", "Eight", "Nine", "Ten", "Jack", "Queen", "King"}

sub newdeck( deck() as card )
    'produces an unshuffled deck of 52 cards
    redim preserve deck(0 to 51) as card
    for s as ubyte = 0 to 3
        for f as ubyte = 0 to 12
            deck(13*s + f).suit = s
            deck(13*s + f).face = f
        next f
    next s
end sub

function deal( deck() as card ) as card
    'deals one card from the top of the deck, returning that
    'card and removing it from the deck
    dim as card dealt = deck(ubound(deck))
    redim preserve deck(0 to ubound(deck) - 1)
    return dealt
end function

function card_name( c as card ) as string
    'returns the name of a single given card
    return Faces(c.face) + " of " + Suits(c.suit)
end function

sub print_deck( deck() as card )
    'displays the contents of the deck,
    'with the top card (next to be dealt) first
    for i as byte = ubound(deck) to 0 step -1
        print card_name( deck(i) )
    next i
end sub

sub shuffle_deck( deck() as card )
    dim as integer n = ubound(deck)+1
    for i as integer = 1 to NSWAPS
        swap deck( int(rnd*n) ), deck( int(rnd*n) )
    next i
end sub

redim as card deck(0 to 0)  'allocate a new deck
newdeck(deck())             'set up the new deck
print "Dealing a card: ", card_name( deal( deck() ) )
for j as integer = 1 to 41  'deal another 41 cards and discard them
    deal(deck())
next j
shuffle_deck(deck())        'shuffle the remaining cards
print_deck(deck())          'display the last ten cards


package cards

import (
	"math/rand"
)

// A Suit represents one of the four standard suites.
type Suit uint8

// The four standard suites.
const (
	Spade   Suit = 3
	Heart   Suit = 2
	Diamond Suit = 1
	Club    Suit = 0
)

func (s Suit) String() string {
	const suites = "CDHS" // or "♣♢♡♠"
	return suites[s : s+1]
}

// Rank is the rank or pip value of a card from Ace==1 to King==13.
type Rank uint8

// The ranks from Ace to King.
const (
	Ace   Rank = 1
	Two   Rank = 2
	Three Rank = 3
	Four  Rank = 4
	Five  Rank = 5
	Six   Rank = 6
	Seven Rank = 7
	Eight Rank = 8
	Nine  Rank = 9
	Ten   Rank = 10
	Jack  Rank = 11
	Queen Rank = 12
	King  Rank = 13
)

func (r Rank) String() string {
	const ranks = "A23456789TJQK"
	return ranks[r-1 : r]
}

// A Card represets a specific playing card.
// It's an encoded representation of Rank and Suit
// with a valid range of [0,51].
type Card uint8

// NewCard returns the Card representation for the specified rank and suit.
func NewCard(r Rank, s Suit) Card {
	return Card(13*uint8(s) + uint8(r-1))
}

// RankSuit returns the rank and suit of the card.
func (c Card) RankSuit() (Rank, Suit) {
	return Rank(c%13 + 1), Suit(c / 13)
}

// Rank returns the rank of the card.
func (c Card) Rank() Rank {
	return Rank(c%13 + 1)
}

// Suit returns the suit of the card.
func (c Card) Suit() Suit {
	return Suit(c / 13)
}

func (c Card) String() string {
	return c.Rank().String() + c.Suit().String()
}

// A Deck represents a set of zero or more cards in a specific order.
type Deck []Card

// NewDeck returns a regular 52 deck of cards in A-K order.
func NewDeck() Deck {
	d := make(Deck, 52)
	for i := range d {
		d[i] = Card(i)
	}
	return d
}

// String returns a string representation of the cards in the deck with
// a newline ('\n') separating the cards into groups of thirteen.
func (d Deck) String() string {
	s := ""
	for i, c := range d {
		switch {
		case i == 0: // do nothing
		case i%13 == 0:
			s += "\n"
		default:
			s += " "
		}
		s += c.String()
	}
	return s
}

// Shuffle randomises the order of the cards in the deck.
func (d Deck) Shuffle() {
	for i := range d {
		j := rand.Intn(i + 1)
		d[i], d[j] = d[j], d[i]
	}
}

// Contains returns true if the specified card is withing the deck.
func (d Deck) Contains(tc Card) bool {
	for _, c := range d {
		if c == tc {
			return true
		}
	}
	return false
}

// AddDeck adds the specified deck(s) to this one at the end/bottom.
func (d *Deck) AddDeck(decks ...Deck) {
	for _, o := range decks {
		*d = append(*d, o...)
	}
}

// AddCard adds the specified card to this deck at the end/bottom.
func (d *Deck) AddCard(c Card) {
	*d = append(*d, c)
}

// Draw removes the selected number of cards from the top of the deck,
// returning them as a new deck.
func (d *Deck) Draw(n int) Deck {
	old := *d
	*d = old[n:]
	return old[:n:n]
}

// DrawCard draws a single card off the top of the deck,
// removing it from the deck.
// It returns false if there are no cards in the deck.
func (d *Deck) DrawCard() (Card, bool) {
	if len(*d) == 0 {
		return 0, false
	}
	old := *d
	*d = old[1:]
	return old[0], true
}

// Deal deals out cards from the deck one at a time to multiple players.
// The initial hands (decks) of each player are provided as arguments and the
// modified hands are returned. The initial hands can be empty or nil.
// E.g. Deal(7, nil, nil, nil) deals out seven cards to three players
// each starting with no cards.
// If there are insufficient cards in the deck the hands are partially dealt and
// the boolean return is set to false (true otherwise).
func (d *Deck) Deal(cards int, hands ...Deck) ([]Deck, bool) {
	for i := 0; i < cards; i++ {
		for j := range hands {
			if len(*d) == 0 {
				return hands, false
			}
			hands[j] = append(hands[j], (*d)[0])
			*d = (*d)[1:]
		}
	}
	return hands, true
}


import groovy.transform.TupleConstructor

enum Pip {
    ACE, TWO, THREE, FOUR, FIVE, SIX, SEVEN, EIGHT, NINE, TEN, JACK, QUEEN, KING
}
enum Suit {
    DIAMONDS, SPADES, HEARTS, CLUBS
}

@TupleConstructor
class Card {
    final Pip pip
    final Suit suit

    String toString() { "$pip of $suit" }
}

class Deck {
    private LinkedList cards = []

    Deck() { reset() }

    void reset() {
        cards = []
        Suit.values().each { suit ->
            Pip.values().each { pip ->
                cards << new Card(pip, suit)
            }
        }
    }

    Card deal() { cards.poll() }

    void shuffle() { Collections.shuffle cards }

    String toString() { cards.isEmpty() ? "Empty Deck" : "Deck $cards" }
}


import System.Random

data Pip = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten |
           Jack | Queen | King | Ace
  deriving (Ord, Enum, Bounded, Eq, Show)

data Suit = Diamonds | Spades | Hearts | Clubs
  deriving (Ord, Enum, Bounded, Eq, Show)

type Card = (Pip, Suit)

fullRange :: (Bounded a, Enum a) => [a]
fullRange = [minBound..maxBound]

fullDeck :: [Card]
fullDeck = [(pip, suit) | pip <- fullRange, suit <- fullRange]

insertAt :: Int -> a -> [a] -> [a]
insertAt 0 x ys     = x:ys
insertAt n _ []     = error "insertAt: list too short"
insertAt n x (y:ys) = y : insertAt (n-1) x ys

shuffle :: RandomGen g => g -> [a] -> [a]
shuffle g xs = shuffle' g xs 0 [] where
  shuffle' g []     _ ys = ys
  shuffle' g (x:xs) n ys = shuffle' g' xs (n+1) (insertAt k x ys) where
    (k,g') = randomR (0,n) g


(import [random [shuffle]])
(setv pips (.split "2 3 4 5 6 7 8 9 10 J Q K A"))
(setv suits (.split "♥ ♦ ♣ ♠"))
(setv cards_per_hand 5)

(defn make_deck [pips suits]
    (lfor
        x pips
        y suits
        (+ x y)))

(defn deal_hand [num_cards deck]
    (setv delt (cut deck None num_cards))
    (setv new_deck (lfor
                       x deck
                       :if (not (in x delt))
                       x))
    [delt new_deck])

(if (= __name__ "__main__")
    (do
    (setv deck (make_deck pips suits))
    (shuffle deck)
    (setv [first_hand deck] (deal_hand cards_per_hand deck))
    (setv [second_hand deck] (deal_hand cards_per_hand deck))
    (print "\nThe first hand delt was:" (.join " " (map str first_hand)))
    (print "\nThe second hand delt was:" (.join " " (map str second_hand)))
    (print "\nThe remaining cards in the deck are...\n" (.join " " (map str deck)))))


procedure main(arglist)

   cards   := 2                                             # cards per hand
   players := 5                                             # players to deal to

   write("New deck : ", showcards(D := newcarddeck()))      # create and show a new deck
   write("Shuffled : ", showcards(D := shufflecards(D)))    # shuffle it

   H := list(players)
   every H[1 to players] := []                              # hands for each player

   every ( c := 1 to cards 	) & ( p := 1 to players ) do
      put(H[p], dealcard(D))                                # deal #players hands of #cards

   every write("Player #",p := 1 to players,"'s hand : ",showcards(H[p]))
   write("Remaining: ",showcards(D))                        # show the rest of the deck
end

record card(suit,pip)                                       #: datatype for a card suit x pip

procedure newcarddeck()			                    #: return a new standard deck
local D

   every put(D := [], card(suits(),pips()))
   return D
end

procedure suits()				            #: generate suits
   suspend !["H","S","D","C"]
end

procedure pips()					    #: generate pips
   suspend !["2","3","4","5","6","7","8","9","10","J","Q","K","A"]
end

procedure shufflecards(D)			            #: shuffle a list of cards
   every !D :=: ?D                                          # see INL#9
   return D
end

procedure dealcard(D)				            #: deal a card (from the top)
   return get(D)
end

procedure showcards(D)			                    #: return a string of all cards in the given list (deck/hand/etc.)
local s
   every (s := "") ||:= card2string(!D) || " "
   return s
end

procedure card2string(x)			            #: return a string version of a card
   return x.pip || x.suit
end


NB. playingcards.ijs
NB. Defines a Rosetta Code playing cards class
NB. Multiple decks may be used, one for each instance of this class.

coclass 'rcpc'    NB. Rosetta Code playing cards class

NB. Class objects
Ranks=: _2 ]\ ' A 2 3 4 5 6 7 8 910 J Q K'
Suits=: ucp '♦♣♥♠'
DeckPrototype=: (] #: [email protected]:*/)Ranks ,&# Suits

NB. Class methods
create=: monad define
 1: TheDeck=: DeckPrototype
)

destroy=: codestroy

sayCards=: ({&[email protected]{. , {&[email protected]{:)"1

shuffle=: monad define
 1: TheDeck=: ({~ [email protected]#) TheDeck
)

NB.*dealCards v Deals y cards [to x players]
NB. x is: optional number of players, defaults to one
NB. Used monadically, the player-axis is omitted from output.
dealCards=: verb define
 {. 1 dealCards y
:
 'Too few cards in deck' assert (# TheDeck) >: ToBeDealt=. x*y
 CardsOffTop=. ToBeDealt {. TheDeck
 TheDeck    =: ToBeDealt }. TheDeck
 (x,y)$ CardsOffTop
)

NB.*pcc v "Print" current contents of the deck.
pcc=: monad define
 sayCards TheDeck
)

newDeck_z_=: conew&'rcpc'


public enum Pip { Two, Three, Four, Five, Six, Seven,
    Eight, Nine, Ten, Jack, Queen, King, Ace }


function Card(pip, suit) {
    this.pip = pip;
    this.suit = suit;

    this.toString = function () {
        return this.pip + ' ' + this.suit;
    };
}

function Deck() {
    var pips = '2 3 4 5 6 7 8 9 10 Jack Queen King Ace'.split(' ');
    var suits = 'Clubs Hearts Spades Diamonds'.split(' ');
    this.deck = [];
    for (var i = 0; i < suits.length; i++)
        for (var j = 0; j < pips.length; j++)
            this.deck.push(new Card(pips[j], suits[i]));

    this.toString = function () {
        return '[' + this.deck.join(', ') + ']';
    };

    this.shuffle = function () {
        for (var i = 0; i < this.deck.length; i++)
            this.deck[i] = this.deck.splice(
                parseInt(this.deck.length * Math.random()), 1, this.deck[i])[0];
    };

    this.deal = function () {
        return this.deck.shift();
    };
}


type DeckDesign{T<:Integer,U<:String}
    rlen::T
    slen::T
    ranks::Array{U,1}
    suits::Array{U,1}
    hlen::T
end

type Deck{T<:Integer}
    cards::Array{T,1}
    design::DeckDesign
end

Deck(n::Integer, des::DeckDesign) = Deck([n], des)

function pokerlayout()
    r = [map(string, 2:10), "J", "Q", "K", "A"]
    r = map(utf8, r)
    s = ["\u2663", "\u2666", "\u2665", "\u2660"]
    DeckDesign(13, 4, r, s, 5)
end

function fresh(des::DeckDesign)
    Deck(collect(1:des.rlen*des.slen), des)
end


   v:"A23456789TJQK" / values
   s:"SHCD"          / suites

   / create a new deck
   newdeck:{deck::,/s,'\:v}
   newdeck();


const val FACES = "23456789TJQKA"
const val SUITS = "shdc"

fun createDeck(): List<String> {
    val cards = mutableListOf<String>()
    FACES.forEach { face -> SUITS.forEach { suit -> cards.add("$face$suit") } }
    return cards
}

fun dealTopDeck(deck: List<String>, n: Int) = deck.take(n)

fun dealBottomDeck(deck: List<String>, n: Int) = deck.takeLast(n).reversed()

fun printDeck(deck: List<String>) {
    for (i in deck.indices) {
        print("${deck[i]}  ")
        if ((i + 1) % 13 == 0 || i == deck.size - 1) println()
    }
}

fun main(args: Array<String>) {
    var deck = createDeck()
    println("After creation, deck consists of:")
    printDeck(deck)
    deck = deck.shuffled()
    println("\nAfter shuffling, deck consists of:")
    printDeck(deck)
    val dealtTop = dealTopDeck(deck, 10)
    println("\nThe 10 cards dealt from the top of the deck are:")
    printDeck(dealtTop)
    val dealtBottom = dealBottomDeck(deck, 10)
    println("\nThe 10 cards dealt from the bottom of the deck are:")
    printDeck(dealtBottom)
}