// version 1.2.31

import java.text.SimpleDateFormat
import java.util.Date
import java.io.File
import java.io.IOException

val file = File("simdb.csv")

class Item(
    val name: String,
    val date: String,
    val category: String
) : Comparable<Item> {

    override fun compareTo(other: Item) = date.compareTo(other.date)

    override fun toString() = "$name, $date, $category"
}

fun addItem(input: Array<String>) {
    if (input.size < 2) {
        printUsage()
        return
    }
    val sdf = SimpleDateFormat("yyyy-MM-dd HH:mm:ss")
    val date = sdf.format(Date())
    val cat = if (input.size == 3) input[2] else "none"
    store(Item(input[1], date, cat))
}

fun printLatest(a: Array<String>) {
    val db = load()
    if (db.isEmpty()) {
        println("No entries in database.")
        return
    }
    // no need to sort db as items are added chronologically
    if (a.size == 2) {
        var found = false
        for (item in db.reversed()) {
            if (item.category == a[1]) {
                println(item)
                found = true
                break
            }
        }
        if (!found) println("There are no items for category '${a[1]}'")
    }
    else println(db[db.lastIndex])
}

fun printAll() {
    val db = load()
    if (db.isEmpty()) {
        println("No entries in database.")
        return
    }
    // no need to sort db as items are added chronologically
    for (item in db) println(item)
}

fun load(): MutableList<Item> {
    val db = mutableListOf<Item>()
    try {
        file.forEachLine { line ->
            val item = line.split(", ")
            db.add(Item(item[0], item[1], item[2]))
        }
    }
    catch (e: IOException) {
        println(e)
        System.exit(1)
    }
    return db
}

fun store(item: Item) {
    try {
        file.appendText("$item\n")
    }
    catch (e: IOException) {
        println(e)
    }
}

fun printUsage() {
    println("""
        |Usage:
        |  simdb cmd [categoryName]
        |  add     add item, followed by optional category
        |  latest  print last added item(s), followed by optional category
        |  all     print all
        |  For instance: add "some item name" "some category name"
    """.trimMargin())
}

fun main(args: Array<String>) {
    if (args.size !in 1..3) {
        printUsage()
        return
    }
    file.createNewFile()  // create file if it doesn't already exist
    when (args[0].toLowerCase()) {
        "add"    -> addItem(args)
        "latest" -> printLatest(args)
        "all"    -> printAll()
        else     -> printUsage()
    }
}


import algorithm, json, os, strformat, strutils, times

const FileName = "simdb.json"

type

  Item = object
    name: string
    date: string
    category: string

  Database = seq[Item]

  DbError = object of CatchableError

proc load(): Database =
  if fileExists(FileName):
    let node = try: FileName.parseFile()
               except JsonParsingError:
                 raise newException(DbError, getCurrentExceptionMsg())
    result = node.to(DataBase)

proc store(db: Database) =
  try:
    FileName.writeFile $(%* db)
  except IOError:
    quit "Unable to save database.", QuitFailure

proc addItem(args: seq[string]) =
  var db = try: load()
           except DbError: quit getCurrentExceptionMsg(), QuitFailure

  let date = now().format("yyyy-MM-dd HH:mm:ss")
  let cat = if args.len == 2: args[1] else: "none"
  db.add Item(name: args[0], date: date, category: cat)
  db.store()

proc printLatest(args: seq[string]) =
  let db = try: load()
           except DbError: quit getCurrentExceptionMsg(), QuitFailure
  if db.len == 0:
    echo "No entries in database."
    return

  # No need to sort db as items are added chronologically.
  if args.len == 1:
    var found = false
    for item in reversed(db):
      if item.category == args[0]:
        echo item
        found = true
        break
    if not found:
      echo &"There are no items for category '{args[0]}'"
  else:
    echo db[^1]

proc printAll() =
  let db = try: load()
           except DbError: quit getCurrentExceptionMsg(), QuitFailure
  if db.len == 0:
    echo "No entries in database."
    return
  for item in db:
    echo item

proc printUsage() =
  echo &"""
Usage:
  {getAppFilename().splitPath().tail} cmd [categoryName]

  add     add item, followed by optional category
  latest  print last added item(s), followed by optional category
  all     print all

  For instance: add "some item name" "some category name"
  """
  quit QuitFailure

if paramCount() notin 1..3: printUsage()

var params = commandLineParams()
let command = params[0].toLowerAscii
params.delete(0)
case command
of "add":
  if params.len == 0: printUsage()
  addItem(params)
of "latest":
  if params.len > 1: printUsage()
  printLatest(params)
of "all":
  if params.len != 0: printUsage()
  printAll()


#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

use JSON::PP;
use Time::Piece;

use constant {
    NAME     => 0,
    CATEGORY => 1,
    DATE     => 2,
    DB       => 'simple-db',
};

my $operation = shift // "";

my %dispatch = (
    n => \&add_new,
    l => \&print_latest,
    L => \&print_latest_for_categories,
    a => \&print_all,
);

if ($dispatch{$operation}) {
    $dispatch{$operation}->(@ARGV);
} else {
    die "Invalid option. Use one of n, l, L, a.\n"
}

sub add_new {
    my ($name, $category, $date) = @_;
    my $db = eval { load() } || {};
    if (defined $date) {
        eval { 'Time::Piece'->strptime($date, '%Y-%m-%d'); 1 }
            or die "Invalid date format: YYYY-MM-DD.\n";

    } else {
        $date //= localtime->ymd;
    }

    my @ids = keys %{ $db->{by_id} };
    my $max_id = max(num => @ids) || 0;
    $db->{by_id}{ ++$max_id } = [ $name, $category, $date ];
    save($db);
}

sub print_latest {
    build_indexes( my $db = load(), 0, 1 );
    _print_latest($db);
}

sub _print_latest {
    my ($db, $category) = @_;
    my @dates = keys %{ $db->{by_date} };
    @dates = grep {
        grep $db->{by_id}{$_}[CATEGORY] eq $category,
            @{ $db->{by_date}{$_} };
    } @dates if defined $category;

    my $last_date = max(str => @dates);
    say for map $db->{by_id}{$_}[NAME],
            grep ! defined $category
                 || $db->{by_id}{$_}[CATEGORY] eq $category,
            @{ $db->{by_date}{$last_date} };
}

sub max {
    my $type = shift;
    my $max = $_[0];
    { num => sub { $_ >  $max },
      str => sub { $_ gt $max},
    }->{$type}->() and $max = $_
        for @_[ 1 .. $#_ ];
    return $max
}

sub print_latest_for_categories {
    build_indexes( my $db = load(), 1, 1 );

    for my $category (sort keys %{ $db->{by_category} }){
        say "* $category";
        _print_latest($db, $category);
    }
}

sub print_all {
    build_indexes( my $db = load(), 0, 1 );

    for my $date (sort keys %{ $db->{by_date} }) {
        for my $id (@{ $db->{by_date}{$date} }) {
            say $db->{by_id}{$id}[NAME];
        }
    }
}

sub load {
    open my $in, '<', DB or die "Can't open database: $!\n";
    local $/;
    return { by_id => decode_json(<$in>) };
}

sub save {
    my ($db) = @_;
    open my $out, '>', DB or die "Can't save database: $!\n";
    print {$out} encode_json($db->{by_id});
    close $out;
}

sub build_indexes {
    my ($db, $by_category, $by_date) = @_;
    for my $id (keys %{ $db->{by_id} }) {
        push @{ $db->{by_category}{ $db->{by_id}{$id}[CATEGORY] } }, $id
            if $by_category;
        push @{ $db->{by_date}{ $db->{by_id}{$id}[DATE] } }, $id
            if $by_date;
    }
}


--
-- demo\rosetta\Simple_db.exw
-- ==========================
--
without js -- (file i/o, gets(0), getenv)
include timedate.e

constant filename = getenv(iff(platform()=WINDOWS?"APPDATA":"HOME"))&"/simple_db.csv"

procedure add(sequence cmd)
    if length(cmd)=0
    or length(cmd)>2 then
        printf(1,"usage: add name [cat]\n")
    else
        string name = cmd[1],
                cat = iff(length(cmd)=2?cmd[2]:"none")
            datestr = format_timedate(date(),"YYYY/MM/DD h:mmpm")
        integer fn = open(filename,"a")
        printf(fn,"%s,%s,%s\n",{name,cat,datestr})
        close(fn)
    end if
end procedure

procedure last(sequence cmd)
    integer fn = open(filename,"r")
    if fn=-1 then
        puts(1,"file not found\n")
        return
    end if
    integer lc = length(cmd)
    string last = iff(lc?"<no entries for that category>\n":"<empty>\n")
    while 1 do
        object line = gets(fn)
        if atom(line) then exit end if
        if lc=0 or split(line,',')[2]=cmd[1] then
            last = line
        end if
    end while
    puts(1,last)
    close(fn)
end procedure

sequence dates

function by_date(integer d1, integer d2)
    return compare(dates[d1],dates[d2])
end function

procedure sort_by_date()
-- (simple_db.csv should be edited manually to prove the date sort works)
    integer fn = open(filename,"r")
    if fn=-1 then
        puts(1,"file not found\n")
        return
    end if
    sequence lines = {}
    dates = {}
    while 1 do
        object line = gets(fn)
        if atom(line) then exit end if
        lines = append(lines,line)
        dates = append(dates,split(line,',')[3])
    end while
    close(fn)
    sequence tags = custom_sort(by_date,tagset(length(lines)))
    for i=1 to length(tags) do
        puts(1,lines[tags[i]])
    end for
end procedure

procedure process(sequence cmd)
    switch cmd[1] do
        case "add": add(cmd[2..$])
        case "last": last(cmd[2..$])
        case "sort": sort_by_date()
        default: printf(1,"unknown command: %s\n",{cmd[1]})
    end switch
end procedure

constant helptext = """
p demo\rosetta\Simple_db                    -- interactive mode, commands as below
p demo\rosetta\Simple_db add name [cat]     -- add entry
p demo\rosetta\Simple_db last [cat]         -- show last entry [in specified category]
p demo\rosetta\Simple_db sort               -- show full list sorted by date
"""
sequence cl = command_line()
if length(cl)<3 then
    -- interactive mode
    puts(1,helptext)
    while 1 do
        puts(1,">")
        object line = trim(gets(0))
        if atom(line) or length(line)=0 then exit end if
        puts(1,"\n")
        process(split(line))
    end while
else
    process(cl[3..$])
end if


#!/usr/bin/pil

(de usage ()
   (prinl
      "Usage:^J\
      sdb <file> add <title> <cat> <date> ...  Add a new entry^J\
      sdb <file> get <title>                   Retrieve an entry^J\
      sdb <file> latest                        Print the latest entry^J\
      sdb <file> categories                    Print the latest for each cat^J\
      sdb <file>                               Print all, sorted by date" ) )

(de printEntry (E)
   (apply println (cdddr E) (car E) (cadr E) (datStr (caddr E))) )

(ifn (setq *File (opt))
   (usage)
   (case (opt)
      (add
         (let (Ttl (opt)  Cat (opt))
            (if (strDat (opt))
               (rc *File Ttl (cons Cat @ (argv)))
               (prinl "Bad date") ) ) )
      (get
         (let Ttl (opt)
            (when (rc *File Ttl)
               (printEntry (cons Ttl @)) ) ) )
      (latest
         (printEntry (maxi caddr (in *File (read)))) )
      (categories
         (for Cat (by cadr group (in *File (read)))
            (printEntry (maxi caddr Cat)) ) )
      (NIL
         (mapc printEntry (by caddr sort (in *File (read)))) )
      (T (usage)) ) )

(bye)


mapping db = ([]);

mapping make_episode(string series, string title, string episode, array date)
{
    return ([ "series":series, "episode":episode, "title":title, "date":date ]);
}

void print_episode(mapping episode)
{
    write("  %-30s %10s %-30s (%{%d.%})\n",
          episode->series, episode->episode, episode->title, episode->date);
}

void print_series(mapping series)
{
    write("%-30s %-10s\n", series->series, series->status);
    map(series->episodes, print_episode);
}

void dump_db(mapping database)
{
    foreach(database; string name; mapping series)
    {
        print_series(series);
    }
}

array get_latest(mapping database)
{
    array latest = ({});
    foreach(database; string name; mapping series)
    {
       latest += ({ series->episodes[0] });
    }
    return latest;
}

int(0..1) compare_date(array a, array b)
{
    if (!arrayp(a) && !arrayp(b)) return false;
    if (!arrayp(a) || !sizeof(a)) return arrayp(b) && sizeof(b);
    if (!arrayp(b) || !sizeof(b)) return arrayp(a) && sizeof(a);
    if (a[0] == b[0]) return compare_date(a[1..], b[1..]);
    return a[0] < b[0];
}

int(0..1) compare_by_date(mapping a, mapping b)
{
    return compare_date(reverse(a->date), reverse(b->date));
}

void watch_list(mapping database)
{
    map(Array.sort_array(get_latest(database), compare_by_date),
        print_episode);
}

string prompt_read(string prompt)
{
    write("%s: ", prompt);
    return Stdio.stdin.gets();
}

array parse_date(string date)
{
    return (array(int))(date/".");
}

mapping prompt_for_episode()
{
    return make_episode(prompt_read("Series"),
                        prompt_read("Title"),
                        prompt_read("Episode"),
                        parse_date(prompt_read("Date watched")));
}

// pike offers encode_value() and decode_value() as standard ways
// to save and read data, but that is not a human readable format.
// therefore we are instead printing the structure as debug-output
// which is a readable form as long as it only contains integers,
// strings, mappings, arrays and multisets this format can be read by pike.
// to read it we are creating a class that contains the data as a value,
// which is then compiled and instantiated to allow us to pull the data out.
void save_db(string filename, mapping database)
{
    Stdio.write_file(filename, sprintf("%O", database));
}

void watch_save()
{
    save_db("pwatch", db);
}

mapping load_db(string filename)
{
    if (file_stat(filename))
        return compile_string("mixed data = " +
                              Stdio.read_file(filename) + ";")()->data;
    else return ([]);
}

mapping get_series(string name, mapping database)
{
    return database[name];
}

array get_episode_list(string series, mapping database)
{
    return database[series]->episodes;
}

void watch_new_series(string name, string status, mapping database)
{
    database[name] = (["series":name, "status":status, "episodes":({}) ]);
}

mapping get_or_add_series(string name, mapping database)
{
    if (!database[name])
    {
        string answer = prompt_read("Add new series? [y/n]: ");
        if (answer == "y")
            watch_new_series(name, "active", database);
    }
    return database[name];
}

void watch_add(mapping database)
{
    mapping episode = prompt_for_episode();
    string series_name = episode->series;
    mapping series = get_or_add_series(series_name, database);
    if (!series)
        watch_add(database);
    else
        series->episodes = Array.unshift(series->episodes, episode);
}

void watch_load()
{
    db = load_db("pwatch");
}

int main(int argc, array argv)
{
    watch_load();
    if (argc>1 && argv[1] == "add")
    {
        watch_add(db);
        watch_save();
    }
    else
        watch_list(db);
}


function db
{
    [CmdletBinding(DefaultParameterSetName="None")]
    [OutputType([PSCustomObject])]
    Param
    (
        [Parameter(Mandatory=$false,
                   Position=0,
                   ParameterSetName="Add a new entry")]
        [string]
        $Path = ".\SimpleDatabase.csv",

        [Parameter(Mandatory=$true,
                   ParameterSetName="Add a new entry")]
        [string]
        $Name,

        [Parameter(Mandatory=$true,
                   ParameterSetName="Add a new entry")]
        [string]
        $Category,

        [Parameter(Mandatory=$true,
                   ParameterSetName="Add a new entry")]
        [datetime]
        $Birthday,

        [Parameter(ParameterSetName="Print the latest entry")]
        [switch]
        $Latest,

        [Parameter(ParameterSetName="Print the latest entry for each category")]
        [switch]
        $LatestByCategory,

        [Parameter(ParameterSetName="Print all entries sorted by a date")]
        [switch]
        $SortedByDate
    )

    if (-not (Test-Path -Path $Path))
    {
        '"Name","Category","Birthday"' | Out-File -FilePath $Path
    }

    $db = Import-Csv -Path $Path | Foreach-Object {
        $_.Birthday = $_.Birthday -as [datetime]
        $_
    }

    switch ($PSCmdlet.ParameterSetName)
    {
        "Add a new entry"
        {
            [PSCustomObject]@{Name=$Name; Category=$Category; Birthday=$Birthday} | Export-Csv -Path $Path -Append
        }
        "Print the latest entry"
        {
            $db[-1]
        }
        "Print the latest entry for each category"
        {
            ($db | Group-Object -Property Category).Name | ForEach-Object {($db | Where-Object -Property Category -Contains $_)[-1]}
        }
        "Print all entries sorted by a date"
        {
            $db | Sort-Object -Property Birthday
        }
        Default
        {
            $db
        }
    }
}

db -Name Bev   -Category friend   -Birthday 3/3/1983
db -Name Bob   -Category family   -Birthday 7/19/1987
db -Name Gill  -Category friend   -Birthday 12/9/1986
db -Name Gail  -Category family   -Birthday 2/11/1986
db -Name Vince -Category family   -Birthday 3/10/1960
db -Name Wayne -Category coworker -Birthday 5/29/1962


#!/usr/bin/python3

'''\
Simple database for: http://rosettacode.org/wiki/Simple_database

'''

import argparse
from argparse import Namespace
import datetime
import shlex

def parse_args():
    'Set up, parse, and return arguments'

    parser = argparse.ArgumentParser(epilog=globals()['__doc__'])

    parser.add_argument('command', choices='add pl plc pa'.split(),
                        help='''\
add: Add a new entry
pl:  Print the latest entry
plc: Print the latest entry for each category/tag
pa:  Print all entries sorted by a date''')
    parser.add_argument('-d', '--description',
                        help='A description of the item. (e.g., title, name)')
    parser.add_argument('-t', '--tag',
                        help=('''A category or tag (genre, topic, relationship '''
                              '''such as “friend” or “family”)'''))
    parser.add_argument('-f', '--field', nargs=2, action='append',
                        help='Other optional fields with value (can be repeated)')

    return parser

def do_add(args, dbname):
    'Add a new entry'
    if args.description is None:
        args.description = ''
    if args.tag is None:
        args.tag = ''
    del args.command
    print('Writing record to %s' % dbname)
    with open(dbname, 'a') as db:
        db.write('%r\n' % args)

def do_pl(args, dbname):
    'Print the latest entry'
    print('Getting last record from %s' % dbname)
    with open(dbname, 'r') as db:
        for line in db: pass
    record = eval(line)
    del record._date
    print(str(record))

def do_plc(args, dbname):
    'Print the latest entry for each category/tag'
    print('Getting latest record for each tag from %s' % dbname)
    with open(dbname, 'r') as db:
        records = [eval(line) for line in db]
    tags = set(record.tag for record in records)
    records.reverse()
    for record in records:
        if record.tag in tags:
            del record._date
            print(str(record))
            tags.discard(record.tag)
            if not tags: break

def do_pa(args, dbname):
    'Print all entries sorted by a date'
    print('Getting all records by date from %s' % dbname)
    with open(dbname, 'r') as db:
        records = [eval(line) for line in db]
    for record in records:
        del record._date
        print(str(record))

def test():
    import time
    parser = parse_args()
    for cmdline in [
                    """-d Book -f title 'Windy places' -f type hardback --tag DISCOUNT add""",
                    """-d Book -f title 'RC spammers'  -f type paperback -t   DISCOUNT add""",
                    """-d Book -f title 'Splat it' -f type hardback -f special 'first edition' -t PREMIUM add""",
                    """pl""",
                    """plc""",
                    ]:
        args = parser.parse_args(shlex.split(cmdline))
        now = datetime.datetime.utcnow()
        args._date = now.isoformat()
        do_command[args.command](args, dbname)
        time.sleep(0.5)

do_command = dict(add=do_add, pl=do_pl, plc=do_plc, pa=do_pa)
dbname = '_simple_db_db.py'

if __name__ == '__main__':
    if 0:
        test()
    else:
        parser = parse_args()
        args = parser.parse_args()
        now = datetime.datetime.utcnow()
        args._date = now.isoformat()
        do_command[args.command](args, dbname)


#!/usr/bin/env racket
#lang racket

(define (*write file data) ; write data in human readable format (sexpr/line)
  (with-output-to-file file #:exists 'replace
    (lambda () (for ([x data]) (printf "~s\n" x)))))
(define *read file->list) ; read our "human readable format"

(command-line
 #:once-any
 [("-a") file title category date "Add an entry"
  (*write file `(,@(*read file) (,title ,category ,date)))]
 [("-d") file title "Delete an entry (all matching)"
  (*write file (filter-not (lambda (x) (equal? (car x) title)) (*read file)))]
 [("-p") file mode "Print entries, mode = latest, latest/cat, all, by-date"
  (define data (*read file))
  (define (show item)
    (match item [(list title cat date) (printf "[~a] ~a; ~a\n" cat title date)]))
  (case (string->symbol mode)
    [(all) (for-each show data)]
    [(by-date) (for-each show (sort data string<? #:key cadr))]
    [(latest) (show (last data))]
    [(latest/cat)
     (define (last/cat c) (for/last ([x data] #:when (equal? c (cadr x))) x))
     (for-each (compose1 show last/cat) (remove-duplicates (map cadr data)))]
    [else (error 'sdb "bad printout mode")])])


#!/usr/bin/env raku
use JSON::Fast ;
sub MAIN( :$server='0.0.0.0', :$port=3333, :$dbfile='db' ) {
    my %db;
    my %index;
    my $dbdata = slurp "$dbfile.json" ;
    my $indexdata = slurp "{$dbfile}_index.json" ;
    %db = from-json($dbdata) if $dbdata ;
    %index = from-json($indexdata) if $indexdata ;
  react {
    whenever IO::Socket::Async.listen( $server , $port ) -> $conn {
        whenever $conn.Supply.lines -> $line {
            my %response = 'status' => '' ;
            my $msg = from-json $line ;
            say $msg.perl ;
            given $msg<function> {
                when 'set' {
                    %db{ $msg<topic> } = $msg<message> ;
                    %response<status> = 'ok' ;
                    %index<last_> = $msg<topic> ;
                    for %index<keys_>.keys -> $key {
                        if $msg<message>{$key} {
                            %index<lastkey_>{ $key }{ $msg<message>{$key} } = $msg<topic> ;
                            %index<idx_>{ $key }{ $msg<message>{$key} }{ $msg<topic> } = 1 ;
                        }
                    }
                    spurt "$dbfile.json", to-json(%db);
                    spurt "{$dbfile}_index.json", to-json(%index);
                }
                when 'get' {
                    %response<topic> = $msg<topic> ;
                    %response<message> = %db{ $msg<topic> } ;
                    %response<status> = 'ok' ;
                }
                when 'dump' {
                    %response{'data'} = %db ;
                    %response<status> = 'ok' ;
                }
                when 'dumpindex' {
                    %response{'data'} = %index ;
                    %response<status> = 'ok' ;
                }
                when 'delete' {
                    %db{ $msg<topic> }:delete;
                    %response<status> = 'ok' ;
                    spurt "$dbfile.json", to-json(%db);
                    reindex();
                }
                when 'addindex' {
                    %response<status> = 'ok' ;
                    %index<keys_>{ $msg<key>} =1 ;
                    reindex();
                }
                when 'reportlast' {
                    %response{'data'} = %db{%index<last_>} ;
                    %response<status> = 'ok' ;
                }
                when 'reportlastindex' {
                    %response<key> = $msg<key> ;
                    for %index<lastkey_>{$msg<key>}.keys -> $value {
                        #%response{'data'}.push: %db{ %index<lastkey_>{ $msg<key>  }{ $value } } ;
                        %response{'data'}{$value} = %db{ %index<lastkey_>{ $msg<key>  }{ $value } } ;
                    }
                    %response<status> = 'ok' ;
                }
                when 'reportindex' {
                    %response<status> = 'ok' ;
                    for %index<idx_>{$msg<key>}.keys.sort -> $value  {
                        for %index<idx_>{ $msg<key> }{ $value }.keys.sort -> $topic {
                            %response<data>.push:  %db{ $topic }  ;
                            #%response<data>{$value} = %db{ $topic }  ;
                        }
                    }
                }
                when 'commit' {
                    spurt "$dbfile.json", to-json(%db);
                    spurt "{$dbfile}_index.json", to-json(%index);
                    %response<status> = 'ok' ;
                }
                default {
                    %response<status> = 'error';
                    %response<error> = 'no function or not supported';
                }
            }
            $conn.print( to-json(%response, :!pretty) ~ "\n" ) ;
            LAST { $conn.close ; }
            QUIT { default { $conn.close ; say "oh no, $_";}}
            CATCH { default { say .^name, ': ', .Str ,  " handled in $?LINE";}}
        }
    }
  }
    sub reindex {
        %index<idx_>:delete;
        for %db.keys -> $topic {
            my $msg = %db{$topic} ;
            for %index<keys_>.keys -> $key {
                if $msg{$key} {
                    %index<idx_>{ $key }{ $msg{$key} }{ $topic } = 1 ;
                }
            }
        }
        spurt "{$dbfile}_index.json", to-json(%index) ;
    }
}


rebol [author: "Nick Antonaccio"]
write/append %rdb ""  db: load %rdb
switch system/options/args/1 [
    "new" [write/append %rdb rejoin [now " " mold/only next system/options/args newline]]
    "latest" [print copy/part tail sort/skip db 4 -4]
    "latestcat" [
        foreach cat unique extract at db 3 4 [
            t: copy []
            foreach [a b c d] db [if c = cat [append t reduce [a b c d]]]
            print copy/part tail sort/skip t 4 -4
        ]
    ]
    "sort" [probe sort/skip db 4]
]
halt


/* REXX ---------------------------------------------------------------
* 05.10.2014
*--------------------------------------------------------------------*/
x05='05'x
mydb='sidb.txt'
Say 'Enter your commands, ?, or end'
Do Forever
  Parse Pull l
  Parse Var l command text
  Select
    When command='?' Then
      Call help
    When command='add' Then Do
      Parse Var text item ',' category ',' date
      If date='' Then
        date=date('S') /*yyyymmdd*/
      Say 'adding item' item'/'category 'dated' date
      Call lineout mydb,date item x05 category
      End
    When command='latest' Then Do
      Call lineout mydb
      Parse Var text category
      hidt='00000000'
      ol=''
      Do While lines(mydb)>0
        l=linein(mydb)
        Parse Var l dt a (x05) b
        If category=''|,
           category='-' & b='' |,
           b=category Then Do
          If dt>>hidt Then Do
            ol=l
            hidt=dt
            End
          End
        End
        If ol>'' Then
          Call o ol
        Else
          Say 'no matching item found'
      End
    When command='all' Then Do
      Call lineout mydb
      Parse Var text category
      Do While lines(mydb)>0
        l=linein(mydb)
        Parse Var l a (x05) b
        If category=''|,
           category='-' & b=''|,
           b=category Then
          Call o l
        End
      End
    When command='end' Then
      Leave
    Otherwise Do
      Say 'invalid command ('command')'
      Call help
      End
    End
  End
Say 'Bye'
Exit

o: Parse Value arg(1) With dt text
   Say left(dt,8) text
   Return

help:
  Say 'add item[,[category][,date]] to add an item'
  Say 'latest category to list the latest item of a category'
  Say 'latest to list the latest item'
  Say 'all category to list all items of a category'
  Say 'all to list all items'
  Say 'end to end this program'
  Say 'Use category - to list items without category'
  Return


require 'date'
require 'json'
require 'securerandom'

class SimpleDatabase
  def initialize(dbname, *fields)
    @dbname = dbname
    @filename = @dbname + ".dat"
    @fields = fields
    @maxl = @fields.collect {|f| f.length}.max
    @data = {
      'fields' => fields,
      'items' => {},
      'history' => [],
      'tags' => {},
    }
  end
  attr_reader :dbname, :fields

  def self.open(dbname)
    db = new(dbname)
    db.read
    db
  end

  def read()
    if not File.exists?(@filename)
      raise ArgumentError, "Database #@dbname has not been created"
    end
    @data = JSON.parse(File.read(@filename))
    @fields = @data['fields']
    @maxl = @fields.collect {|f| f.length}.max
  end

  def write()
    File.open(@filename, 'w') {|f| f.write(JSON.generate(@data))}
  end

  def add(*values)
    id = SecureRandom.uuid
    @data['items'][id] = Hash[ @fields.zip(values) ]
    @data['history'] << [Time.now.to_f, id]
    id
  end

  def tag(id, *tags)
    tags.each do |tag|
      if @data['tags'][tag].nil?
        @data['tags'][tag] = [id]
      else
        @data['tags'][tag] << id
      end
    end
    id
  end

  def latest
    @data['history'].sort_by {|val| val[0]}.last.last
  end

  def get_item(id)
    @data['items'][id]
  end

  def tags()
    @data['tags'].keys.sort
  end

  def ids_for_tag(tag)
    @data['tags'][tag]
  end

  def tags_for_id(id)
    @data['tags'].keys.inject([]) do |tags, tag|
      tags << tag if @data['tags'][tag].include?(id)
      tags
    end
  end

  def display(id)
    item = get_item(id)
    fmt = "%#{@maxl}s - %s\n"
    puts fmt % ['id', id]
    @fields.each {|f| print fmt % [f, item[f]]}
    puts fmt % ['tags', tags_for_id(id).join(',')]
    added = @data['history'].find {|x| x[1] == id}.first
    puts fmt % ['date added', Time.at(added).ctime]
    puts ""
  end

  def each()
    @data['history'].each {|time, id| yield id}
  end

  def each_item_with_tag(tag)
    @data['tags'][tag].each {|id| yield id}
  end
end
def usage()
  puts <<END
usage: #{$0} command args ...

commands:
  help
  create dbname field ...
  fields dbname
  add dbname value ...
  tag dbname id tag ...
  tags dbname
  list dbname [tag ...]
  latest dbname
  latest_by_tag dbname
END
end

def open_database(args)
  dbname = args.shift
  begin
    SimpleDatabase.open(dbname)
  rescue ArgumentError => e
    STDERR.puts e.message
    exit 1
  end
end

def process_command_line(command, *args)
  case command
  when 'help'
    usage

  when 'create'
    db = SimpleDatabase.new(*args)
    db.write
    puts "Database #{args[0]} created"

  when 'fields'
    db = open_database(args)
    puts "Database #{db.dbname} fields:"
    puts db.fields.join(',')

  when 'add'
    db = open_database(args)
    id = db.add(*args)
    db.write
    puts "Database #{db.dbname} added id #{id}"

  when 'tag'
    db = open_database(args)
    id = args.shift
    db.tag(id, *args)
    db.write
    db.display(id)

  when 'tags'
    db = open_database(args)
    puts "Database #{db.dbname} tags:"
    puts db.tags.join(',')

  when 'list'
    db = open_database(args)
    if args.empty?
      db.each {|id| db.display(id)}
    else
      args.each do |tag|
        puts "Items tagged #{tag}"
        db.each_item_with_tag(tag) {|id| db.display(id)}
      end
    end

  when 'latest'
    db = open_database(args)
    db.display(db.latest)

  when 'latest_by_tag'
    db = open_database(args)
    db.tags.each do |tag|
      puts tag
      db.display(db.ids_for_tag(tag).last)
    end

  else
    puts "Error: unknown command '#{command}'"
    usage
  end
end

process_command_line *ARGV


sqliteconnect    #sql,  "f:\client.db"  ' Connect to the DB

' -------------------------------
' show user options
' -------------------------------
[sho]
cls ' clear screen
button #acd, "Add a new entry",                          [add]
button #acd, "Print the latest entry", 			 [last]
button #acd, "Print the latest entry for each category", [lastCat]
button #acd, "Print all entries sorted by a date",       [date]
button #ex, "Exit",                                      [exit]
wait

' ------------------------------------
' add a new entry (user input screen)
' ------------------------------------
[add]
cls ' clear the screen
html "
"
html "
Client Maintenance

"
html "Client Num	"
       textbox #clientNum,clientNum$,5

html "

Name	"
     textbox #name,name$,30

html "

Client Date	"
     textbox #clientDate,clientDate$,19

html "

Category	"
     textbox #category,category$,10

html "

"
     button #acd, "Add", [addIt]
     button #ex, "Exit", [sho]
html "

"
wait

' ---------------------------------------------
' Get data from the screen
' ---------------------------------------------
[addIt]
clientNum    =       #clientNum contents$()
name$        = trim$(#name contents$())
clientDate$  = trim$(#clientDate contents$())
category$    = trim$(#category contents$())
dbVals$      = clientNum;",'";name$;"','";clientDate$;"','";category$;"'"
sql$         = "INSERT into client VALUES ("; dbVals$ ; ")"
#sql execute(sql$)
goto [sho]

' ------------------------------------
' Select last entry
' ------------------------------------
[last]
sql$ = "SELECT *,client.rowid as rowid FROM client ORDER BY rowid desc LIMIT 1"
what$ = "---- Last Entry ----"
goto [shoQuery]

' ------------------------------------
' Select by category (Last date only)
' ------------------------------------
[lastCat]
sql$ = "SELECT * FROM client
WHERE client.clientDate = (SELECT max(c.clientDate)
FROM client as c WHERE c.category = client.category)
ORDER BY category"
what$ = "---- Last Category Sequence ----"
goto [shoQuery]

' ------------------------------------
' Select by date
' ------------------------------------
[date]
sql$ = "SELECT * FROM client ORDER BY clientDate"
what$ = "---- By Date ----"

[shoQuery]
cls
print what$
html "
"
html "
Client
Num	Name	Client
Date	Category
" ' heading
#sql	execute(sql$)
WHILE  #sql hasanswer()
  #row = #sql #nextrow()
  clientNum	= #row clientNum()
  name$		= #row name$()
  clientDate$	= #row clientDate$()
  category$	= #row category$()

  html "
";clientNum;"	";name$;"	";clientDate$;"	";category$;"
"
WEND
html "
"
button #c, "Continue", [sho]
wait

' ------ the end -------
[exit]
end


object SimpleDatabase extends App {
  type Entry = Array[String]
  def asTSV(e: Entry) = e mkString "\t"
  def fromTSV(s: String) = s split "\t"
  val header = asTSV(Array("TIMESTAMP", "DESCRIPTION", "CATEGORY", "OTHER"))

  def read(filename: String) = try {
    scala.io.Source.fromFile(filename).getLines.drop(1).map(fromTSV)
  } catch {
    case e: java.io.FileNotFoundException => Nil
  }

  def write(filename: String, all: Seq[Entry]) = {
    import java.nio.file.{Files,Paths}
    import scala.collection.JavaConversions.asJavaIterable
    Files.write(Paths.get(filename), asJavaIterable(header +: all.map(asTSV)))
    all.size
  }

  def add(filename: String, description: String, category: String = "none", optional: Seq[String] = Nil) {
    val format = new java.text.SimpleDateFormat("yyyy-MM-dd HH:mm:ss")
    val e = Array(format.format(new java.util.Date), description, category) ++ optional
    println(write(filename, read(filename).toBuffer :+ e) + " entries")
  }

  def print(filename: String, filter: Seq[Entry] => TraversableOnce[Entry]) =
    filter(read(filename).toList.sortBy(_.headOption)) map(_ mkString ",") foreach println

  args match {
    case Array(f, "latest") => print(f, _ takeRight 1)
    case Array(f, "latest", cat) => print(f, _ filter(_.lift(2) == Some(cat)) takeRight 1)
    case Array(f, "all") => print(f, _.toSeq)
    case Array(f, "all", "latest") => print(f, _ groupBy (_ lift 2 getOrElse "") map{case (_, cat) => cat.last})
    case Array(f, "add", desc) => add(f, desc, category = "")
    case Array(f, "add", desc, cat, opt @ _*) => add(f, desc, cat, opt)
    case _ => println("Usage: SimpleDatabase filename.tsv [all [latest]| latest [CATEGORY] | add [DESCRIPTION [CATEGORY [OPTIONAL]...]]]")
  }
}


#!/usr/bin/env tclsh8.6
package require Tcl 8.6
namespace eval udb {
    variable db {}

    proc Load {filename} {
	variable db
	if {[catch {set f [open $filename]}]} {
	    set db {}
	    return
	}
	set db [read $f]
	close $f
    }
    proc Store {filename} {
	variable db
	if {[catch {set f [open $filename w]}]} return
	dict for {nm inf} $db {
	    puts $f [list $nm $inf]
	}
	close $f
    }

    proc add {title category {date "now"} args} {
	variable db
	if {$date eq "now"} {
	    set date [clock seconds]
	} else {
	    set date [clock scan $date]
	}
	dict set db $title [list $category $date $args]
	return
    }
    proc Rec {nm cat date xtra} {
	dict create description $nm category $cat date [clock format $date] \
	    {*}$xtra _names [dict keys $xtra]
    }
    proc latest {{category ""}} {
	variable db
	if {$category eq ""} {
	    set d [lsort -stride 2 -index {1 1} -integer -decreasing $db]
	    dict for {nm inf} $d break
	    return [list [Rec $nm {*}$inf]]
	}
	set latestbycat {}
	dict for {nm inf} [lsort -stride 2 -index {1 1} -integer $db] {
	    dict set latestbycat [lindex $inf 0] [list $nm {*}$inf]
	}
	return [list [Rec {*}[dict get $latestbycat $category]]]
    }
    proc latestpercategory {} {
	variable db
	set latestbycat {}
	dict for {nm inf} [lsort -stride 2 -index {1 1} -integer $db] {
	    dict set latestbycat [lindex $inf 0] [list $nm {*}$inf]
	}
	set result {}
	dict for {- inf} $latestbycat {
	    lappend result [Rec {*}$inf]
	}
	return $result
    }
    proc bydate {} {
	variable db
	set result {}
	dict for {nm inf} [lsort -stride 2 -index {1 1} -integer $db] {
	    lappend result [Rec $nm {*}$inf]
	}
	return $result
    }

    namespace export add latest latestpercategory bydate
    namespace ensemble create
}

if {$argc < 2} {
    puts stderr "wrong # args: should be \"$argv0 dbfile subcommand ?args...?\""
    exit 1
}
udb::Load [lindex $argv 0]
set separator ""
if {[catch {udb {*}[lrange $argv 1 end]} msg]} {
    puts stderr [regsub "\"udb " $msg "\"$argv0 dbfile "]
    exit 1
}
foreach row $msg {
    puts -nonewline $separator
    apply {row {
	dict with row {
	    puts "Title: $description"
	    puts "Category: $category"
	    puts "Date: $date"
	    foreach v $_names {
		puts "${v}: [dict get $row $v]"
	    }
	}
    }} $row
    set separator [string repeat - 70]\n
}

udb::Store [lindex $argv 0]


#!/usr/local/bin/toffee

prog = require 'commander'
fs = require 'fs-extra'

if not fs.exists! 'data.json'
  fs.outputJson! 'data.json', {}

prog
  .command('add <name> <category> [date]')
  .description('Add a new entry')
  .option('-n <text>', 'notes')
  .option('-t <tags>', 'tags')
  .action addentry

prog
  .command('latest')
  .description('Print the latest entry')
  .action latest

prog
  .command('catlatest')
  .description('Print the latest entry for each category')
  .action catlatestout

prog
  .command('list')
  .description('Print all entries sorted by date')
  .action bydate

addentry = (name, category, dt, options) ->
  if dt? then dat = new Date(dt) else dat = new Date()
  update =
    name: name
    category: category
    tags: options?.T
    notes: options?.N
    date: dat.getTime()
  e, data = fs.readJson! 'data.json'
  if not data[category]?
    data[category] = []
  data[category].push update
  fs.outputJson 'data.json', data

byDateNew = (a, b) ->
  if a.date<b.date then return 1
  if b.date>a.date then return -1
  return 0

catlatest = (cb) ->
  e, data = fs.readJson! 'data.json'
  ret = []
  for cat, list of data
    list.sort byDateNew
    ret.push list[0]
  cb ret

printFormatted = (entry) ->
  tmp = entry.date
  entry.date = new Date(entry.date).toDateString()
  console.log entry
  entry.date = tmp

latest = ->
  newpercat = catlatest!
  newpercat.sort byDateNew
  printFormatted newpercat[0]

catlatestout = ->
  items = catlatest!
  for item in items
    printFormatted item

bydate = ->
  e, data = fs.readJson! 'data.json'
  entries = []
  for cat, list of data
    for item in list
      entries.push item
  entries.sort byDateNew
  for entry in entries
    printFormatted entry

prog.parse process.argv


#!/bin/sh

db_create() {
	mkdir ./"$1" && mkdir "./$1/.tag" && echo "Create DB \`$1'"
}

db_delete() {
	rm -r ./"$1" && echo "Delete DB \`$1'"
}

db_show() {
	if [ -z "$2" ]; then show_help; fi
	for x in "./$1/$2/"*; do
		echo "$x:" | sed "s/.*\///"
		cat "$x" | sed "s/^/    /"
		echo
	done

	printf "Tags: "
	ls "./$1/$2/.tag"
}

db_tag() {
	local db="$1" item="$2"
	shift
	shift
	for tag in $@; do
		mkdir "./$db/.tag/$tag"
		ln -s "$PWD/$db/$item" "./$db/.tag/$tag/"
		touch "./$db/$item/.tag/$tag"
	done
}

show_help() {
	echo "Usage: $0 command [args]"
	echo "Commands:"
	cat $0 | grep ") ##" | grep -v grep | sed 's/) ## /:\t/'
	exit
}

if [ -z "$1" ]; then show_help; fi

action=$1 it=database
shift
case $action in
	create) ## db -- create $it
		db_create "[email protected]" ;;

	drop) ## db -- delete $it
		db_delete "[email protected]" ;;

	add) ## db item -- add new item to $it
		mkdir -p "./$1/$2/.tag" && touch "./$1/$2/Description" ;;

	rem) ## db item -- delete item from $it
		rm -r "./$1/$2"
		rm "./$1/.tag/"*"/$2"
		;;

	show) ## db item -- show item
		db_show "[email protected]" ;;

	newtag) ## db new-tag-name -- create new tag name
		mkdir "./$1/.tag/$2" ;;

	prop) ## db item property-name property-content -- add property to item
		echo "$4" > "./$1/$2/$3" ;;

	tag) ## db item tag [more-tags...] -- mark item with tags
		db_tag "[email protected]" ;;

	last) ## db -- show latest item
		ls "$1" --sort=time | tail -n 1
		;;

	list) ## db -- list all items
		ls "$1" -1 --sort=time
		;;

	last-all) ## db -- list items in each category
		for x in "$1/.tag/"*; do
			echo "$x" | sed 's/.*\//Tag: /'
			printf "    "
			ls "$x" --sort=time | tail -n 1
			echo
		done
		;;

	help) ## this message
		show_help
		;;

	*)	echo Bad DB command: $1
		show_help
		;;
esac


/* simdb.wren */

import "os" for Process
import "/ioutil" for File, FileFlags, FileUtil
import "/trait" for Comparable, Reversed
import "/date" for Date
import "/sort" for Sort
import "/str" for Str

var fileName = "simdb.csv"

Date.default = Date.isoDate

class Item is Comparable {
    construct new(name, date, category) {
        _name = name
        _date = date
        _category = category
    }

    name     { _name }
    date     { _date }
    category { _category }

    compare(other) { _date.compare(other.date) }

    toString { "%(name), %(date.toString), %(category)" }
}

var printUsage = Fn.new {
    System.print("""
Usage:
  wren simdb.wren cmd [categoryName]
  add     add item name and date, followed by optional category
  latest  print item with latest date, followed by optional category
  all     print all
  For instance: add "some item name", "some item date", "some category name"
  Dates should be in format: yyyy-mm-dd
""")
}

var load = Fn.new {
    var db = []
    var lines = FileUtil.readLines(fileName)
    for (line in lines) {
        if (line == "") break   // end of file
        var item = line.split(", ")
        db.add(Item.new(item[0], Date.parse(item[1]), item[2]))
    }
    return db
}

var store = Fn.new { |item|
    File.openWithFlags(fileName, FileFlags.writeOnly) { |f|
        f.writeBytes("%(item)\n")
    }
}

var addItem = Fn.new { |input|
    if (input.count < 2) {
        printUsage.call()
        return
    }
    var date = Date.parse(input[1])
    var cat = (input.count == 3) ? input[2] : "none"
    store.call(Item.new(input[0], date, cat))
}

var printLatest = Fn.new { |a|
    var db = load.call()
    if (db.isEmpty) {
        System.print("No entries in database.")
        return
    }
    Sort.quick(db)  // sort by ascending date
    if (a.count == 1) {
        var found = false
        for (item in Reversed.new(db)) {
            if (item.category == a[0]) {
                System.print(item)
                found = true
                break
            }
        }
        if (!found) System.print("There are no items for category '%(a[0])'.")
    } else System.print(db[-1])
}

var printAll = Fn.new {
    var db = load.call()
    if (db.isEmpty) {
        System.print("No entries in database.")
        return
    }
    Sort.quick(db)  // sort by ascending date
    for (item in db) System.print(item)
}

var args = Process.arguments
if (!(1..4).contains(args.count)) {
    printUsage.call()
    return
}
// create file if it doesn't already exist
if (!File.exists(fileName)) {
    var f = File.create(fileName)
    f.close()
}

var cmd = Str.lower(args[0])
if (cmd == "add") {
    addItem.call(args[1..-1])
} else if (cmd == "latest") {
    printLatest.call(args[1..-1])
} else if (cmd == "all") {
    printAll.call()
} else {
    printUsage.call()
}


DATA: lv_date TYPE datum.

lv_date = 0.

WRITE: / lv_date.


with Ada.Text_IO; use Ada.Text_IO;
with Ada.Calendar; use Ada.Calendar;
with Ada.Calendar.Formatting; use Ada.Calendar.Formatting;
with Ada.Calendar.Conversions; use Ada.Calendar.Conversions;
procedure ShowEpoch is
   etime : Time := To_Ada_Time (0);
begin
   Put_Line (Image (Date => etime));
end ShowEpoch;


use AppleScript version "2.4" -- OS X 10.10 (Yosemite) or later
use framework "Foundation"
use scripting additions

local CocoaEpoch, UnixEpoch

-- Get the date 0 seconds from the Cocoa epoch.
set CocoaEpoch to current application's class "NSDate"'s dateWithTimeIntervalSinceReferenceDate:(0)
-- The way it's rendered in its 'description' is good enough for the current purpose.
set CocoaEpoch to CocoaEpoch's |description|() as text

-- Get the date 0 seconds from the Unix epoch and format it in the same way.
set UnixEpoch to (do shell script "date -ur 0 '+%F %T %z'")

return "Cocoa epoch:  " & CocoaEpoch & linefeed & "Unix epoch:  " & UnixEpoch


print to :date 0            ; convert UNIX timestamp: 0 to date

print now
print to :integer now       ; convert current date to UNIX timestamp


# syntax: GAWK -f SHOW_THE_EPOCH.AWK
# requires GNU Awk 4.0.1 or later
BEGIN {
    print(strftime("%Y-%m-%d %H:%M:%S",0,1))
    exit(0)
}


      INSTALL @lib$+"DATELIB"
      PRINT FN_date$(0, "dd-MMM-yyyy")


#include <time.h>
#include <stdio.h>

int main() {
    time_t t = 0;
    printf("%s", asctime(gmtime(&t)));
    return 0;
}


using System;

class Program
{
    static void Main()
    {
        Console.WriteLine(new DateTime());
    }
}


#include <iostream>
#include <chrono>
#include <ctime>
int main()
{
    std::chrono::system_clock::time_point epoch;
    std::time_t t = std::chrono::system_clock::to_time_t(epoch);
    std::cout << std::asctime(std::gmtime(&t)) << '\n';
    return 0;
}


       IDENTIFICATION DIVISION.
       PROGRAM-ID. epoch.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  epoch-date.
           03  year                PIC 9(4).
           03  month               PIC 99.
           03  dday                PIC 99.

       PROCEDURE DIVISION.
           MOVE FUNCTION DATE-OF-INTEGER(1) TO epoch-date

           DISPLAY year "-" month "-" dday

           GOBACK
           .


(multiple-value-bind (second minute hour day month year) (decode-universal-time 0 0)
 	  (format t "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D" year month day hour minute second))


main() {
  print(new Date.fromEpoch(0,new TimeZone.utc()));
}


program ShowEpoch;

{$APPTYPE CONSOLE}

uses SysUtils;

begin
  Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', 0));
end.


2> calendar:universal_time().
{{2013,9,13},{8,3,16}}
3> calendar:datetime_to_gregorian_seconds(calendar:universal_time()).
63546278932
4> calendar:gregorian_seconds_to_datetime(63546278932).
{{2013,9,13},{8,8,52}}
11> calendar:gregorian_seconds_to_datetime(0).
{{0,1,1},{0,0,0}}


printfn "%s" ((new System.DateTime()).ToString("u"))


USING: calendar calendar.format io ;

0 micros>timestamp timestamp>ymdhms print


include lib/longjday.4th
0 posix>jday .longjday  cr


' FB 1.05.0 Win64

#Include "vbcompat.bi"

' The first argument to the Format function is a date serial
' and so the first statement below displays the epoch.

Dim f As String = "mmmm d, yyyy hh:mm:ss"
Print Format( 0 , f)      '' epoch
Print Format( 0.5, f)     '' noon on the same day
Print Format(-0.5, f)     '' noon on the previous day
Print Format(1000000, f)  '' one million days after the epoch
Print Format(-80000, f)   '' eighty thousand days before the epoch
Print
Print "Press any key to quit"
Sleep


window 1

print date$
print date$("d MMM yyyy")
print date$("EEE, MMM d, yyyy")
print date$("MMMM d, yyyy ")
print date$("MMMM d, yyyy G")
print "This is day ";date$("D");" of the year"
print
print time$
print time$("hh:mm:ss")
print time$("h:mm a")
print time$("h:mm a zzz")
print
print time$("h:mm a ZZZZ "); date$("MMMM d, yyyy G")

HandleEvents


package main
import ("fmt"; "time")

func main() {
    fmt.Println(time.Time{})
}


def date = new Date(0)
def format = new java.text.SimpleDateFormat('yyyy-MM-dd\'T\'HH:mm:ss.SSSZ')
format.timeZone = TimeZone.getTimeZone('UTC')
println (format.format(date))


import System.Time

main = putStrLn $ calendarTimeToString $ toUTCTime $ TOD 0 0


link printf,datetime

procedure main()
  # Unicon
  now := gettimeofday().sec
  if now = &now then printf("&now and gettimeofday().sec are equal\n")
  printf("Now (UTC) %s, (local) %s\n",gtime(now),ctime(now))
  printf("Epoch %s\n",gtime(0))
  # Icon and Unicon
  now := DateToSec(&date) + ClockToSec(&clock)
  printf("Now is also %s and %s\n",SecToDate(now),SecToDateLine(now))
end


import java.text.DateFormat;
import java.util.Date;
import java.util.TimeZone;

public class DateTest{
    public static void main(String[] args) {
        Date date = new Date(0);
        DateFormat format = DateFormat.getDateTimeInstance();
        format.setTimeZone(TimeZone.getTimeZone("UTC"));
        System.out.println(format.format(date));
    }
}


using Base.Dates  # just using Dates in versions > 0.6
println("Time zero (the epoch) is $(unix2datetime(0)).")


// version 1.1.2

import java.util.Date
import java.util.TimeZone
import java.text.DateFormat

fun main( args: Array<String>) {
    val epoch = Date(0)
    val format = DateFormat.getDateTimeInstance()
    format.timeZone = TimeZone.getTimeZone("UTC")
    println(format.format(epoch))
}


implement Epoch;

include "sys.m"; sys: Sys;
include "draw.m";
include "daytime.m"; daytime: Daytime;
	Tm: import daytime;

Epoch: module {
	init: fn(nil: ref Draw->Context, nil: list of string);
};

init(nil: ref Draw->Context, nil: list of string)
{
	sys = load Sys Sys->PATH;
	daytime = load Daytime Daytime->PATH;
	sys->print("%s\n", daytime->text(daytime->gmt(0)));
}


now = the systemDate
put now
-- date( 2018, 3, 21 )

babylonianDate = date(-1800,1,1)

-- print approx. year difference between "babylonianDate" and now
put (now-babylonianDate)/365.2425
-- 3818.1355


put 0 into somedate
convert somedate to internet date
put somedate

-- output GMT (localised)
-- Thu, 1 Jan 1970 10:00:00 +1000


Sub Click(Source As Button)
  'Create timestamp as of now
  Dim timeStamp As NotesDateTime
  Set timeStamp = New NotesDateTime ( Now )

  'Assign epoch start time to variable
  Dim epochTime As NotesDateTime
  Set epochTime = New NotesDateTime ( "01/01/1970 00:00:00 AM GMT" )  ''' These two commands only to get epoch time.

  'Calculate time difference between both dates
  Dim epochSeconds As Long
  epochSeconds = timeStamp.TimeDifference ( epochTime )

  'Print result
  Print epochSeconds

End Sub


/* NetRexx */
options replace format comments java crossref symbols nobinary

import java.text.DateFormat

edate = Date(0)
zulu  = DateFormat.getDateTimeInstance()
zulu.setTimeZone(TimeZone.getTimeZone('UTC'))
say zulu.format(edate)
return


import times

echo "Epoch for Posix systems:  ", fromUnix(0).utc
echo "Epoch for Windows system: ", fromWinTime(0).utc


#import <Foundation/Foundation.h>

int main(int argc, const char *argv[]) {
  @autoreleasepool {

    NSDate *t = [NSDate dateWithTimeIntervalSinceReferenceDate:0];
    NSDateFormatter *dateFormatter = [[NSDateFormatter alloc] init];
    [dateFormatter setTimeZone:[NSTimeZone timeZoneWithName:@"UTC"]];
    [dateFormatter setDateFormat:@"yyyy-MM-dd HH:mm:ss ZZ"];
    NSLog(@"%@", [dateFormatter stringFromDate:t]);

  }
  return 0;
}


open Unix

let months = [| "January"; "February"; "March"; "April"; "May"; "June";
      "July"; "August"; "September"; "October"; "November"; "December" |]

let () =
  let t = Unix.gmtime 0.0 in
  Printf.printf "%s %d, %d\n" months.(t.tm_mon) t.tm_mday (1900 + t.tm_year)


Program ShowEpoch;

uses
  SysUtils;

begin
  Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', Now));
  Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', 0));
end.


with javascript_semantics
constant d0 = {0,1,1,0,0,0,1,1}
include builtins\timedate.e
?format_timedate(d0,"YYYY-MM-DD")
?format_timedate(d0,"Dddd, Mmmm d, YYYY")


: (date 1)
-> (0 3 1)  # Year zero, March 1st


object cal = Calendar.ISO->set_timezone("UTC");
write( cal.Second(0)->format_iso_short() );


If OpenConsole()
  PrintN(FormatDate("Y = %yyyy  M = %mm  D = %dd, %hh:%ii:%ss", 0))

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


>>> import time
>>> time.asctime(time.gmtime(0))
'Thu Jan  1 00:00:00 1970'
>>>


#lang racket
(require racket/date)
(date->string (seconds->date 0 #f))


/*REXX program displays the number of days since the epoch for the DATE function (BIF). */

say '     today is: '  date()                    /*today's is format:     mm MON YYYY   */

days=date('Basedate')                            /*only the first char of option is used*/
say right(days, 40)         " days since the REXX base date of January 1st, year 1"

say ' and today is: '  date(, days, "B")         /*it should still be today (µSec later)*/
                    /*   ↑                ┌───◄─── This BIF (Built-In Function) is only */
                    /*   └─────────◄──────┘        for  newer  versions of  REXX  that  */
                    /*                             support the  2nd and 3rd  arguments. */


load "guilib.ring"

New qApp {
         win1 = new qMainWindow() {
                setwindowtitle("Using QDateEdit")
                setGeometry(100,100,250,100)
                oDate = new qdateedit(win1) {
                        setGeometry(20,40,220,30)
	                oDate.minimumDate()
                }
                show()
                }
                exec()
                }


extern crate time;

use time::{at_utc, Timespec};

fn main() {
    let epoch = at_utc(Timespec::new(0, 0));
    println!("{}", epoch.asctime());
}


import java.util.{Date, TimeZone, Locale}
import java.text.DateFormat

val df=DateFormat.getDateTimeInstance(DateFormat.LONG, DateFormat.LONG, Locale.ENGLISH)
df.setTimeZone(TimeZone.getTimeZone("UTC"))
println(df.format(new Date(0)))


; Display date at Time Zero in UTC.
(printf "~s~%" (time-utc->date (make-time 'time-utc 0 0) 0))


$ include "seed7_05.s7i";
  include "time.s7i";

const proc: main is func
  begin
    writeln(time.value);
  end func;


- Date.toString (Date.fromTimeUniv Time.zeroTime);
val it = "Thu Jan  1 00:00:00 1970" : string


% clock format 0 -gmt 1
Thu Jan 01 00:00:00 GMT 1970


$$ MODE TUSCRIPT
- epoch
number=1
dayofweeknr=DATE (date,day,month,year,number)
epoch=JOIN(year,"-",month,day)
PRINT "epoch: ", epoch," (daynumber ",number,")"
- today's daynumber
dayofweeknr=DATE (today,day,month,year,number)
date=JOIN (year,"-",month,day)
PRINT "today's date: ", date," (daynumber ", number,")"


Sub Main()
    Debug.Print Format(0, "dd mmm yyyy hh:mm")
End Sub


import "/date" for Date

Date.default = Date.isoFull
var dt = Date.fromNumber(0)
System.print(dt)

var dt2 = Date.unixEpoch
System.print(dt2)


zkl: Time.Clock.tickToTock(0,False)
L(1970,1,1,0,0,0) // y,m,d, h,m,s


	;;;	Display a Sierpinski triangle on a CGA screen
	;;;	(order 7 is the maximum that fits in 200 lines)
mode:	equ	0Fh	; INT 10H call to get current video mode
puts:	equ	9h	; MS-DOS call to print string
cgaseg:	equ	0B800h	; Location of CGA video memory
	cpu	8086
	bits	16
	org	100h
section	.text
	cmp	[80h],byte 2	; Argument length should be 2 (space + digit)
	jne	eusage
	mov	al,[82h]	; Get digit
	sub	al,'0'+2	; 2->0, 7->5
	cmp	al,5		; Then it must be <=5
	jbe	argok
eusage:	mov	dx,usage	; Print usage string
estop:	mov	ah,puts
	int	21h
	ret			; And stop
argok:	add	al,2		; Add 2, setting AL to the order
	mov	[order],al	; Store the order
	mov	ah,mode		; Get the current video mode
	int	10h
	cmp	al,7		; If MDA, we don't have graphics support
	mov	dx,errcga
	je	estop
	mov	[vmode],al	; Otherwise, store the old mode
	mov	ax,4		; and switch to mode 4 (320x200 graphics)
	int	10h
	mov	ch,1		; Size = 2^order
	mov	cl,[order]
	shl	ch,cl
	xor	dh,dh		; Start at coords (0,0)
	mov	bp,cgaseg	; Point ES at the CGA memory
mkscr:	mov	es,bp
	xor	di,di		; Start at the beginning
mkline:	xor	dl,dl		; Start at coords (0,Y)
mkbyte:	xor	al,al		; A byte has 4 pixels in it
	mov	cl,4
mkpx:	shl	al,1		; Make room for next pixel
	shl	al,1
	test	dl,dh		; X & Y == 0?
	jnz	nextpx
	or	al,3		; X & Y == 0, set pixel on
nextpx:	inc	dl		; Increment X coordinate
	dec	cl		; More pixels in this byte?
	jnz	mkpx		; If so, add them in
	stosb			; Otherwise, write it out to CGA memory
	cmp	dl,ch		; And if the line is not done yet,
	jb	mkbyte		; do the next byte on this line.
	shr	dl,1		; Move ahead to start of next line
	shr	dl,1
	mov	ax,80		; 80 bytes per line
	sub	al,dl
	add	di,ax
	add	dh,2		; Memory is interlaced so we're 2 lines further
	cmp	dh,ch		; If we're not done yet,
	jb	mkline		; Do the next line.
	add	bp,200h		; Move ahead 8k to the area for the odd lines
	cmp	bp,0BA00h	; Unless we were already there
	mov	dh,1		; We'll have to start at line 1
	jbe	mkscr
	xor	ah,ah		; Wait for a keypress to get back to DOS
	int	16h
	xor	ah,ah		; Then, restore the old video mode,
	mov	al,[vmode]
	int	10h
	ret			; And exit to DOS
section	.data
usage:	db	'SIERPCGA [2..7] - display Sierpinski triangle of order N$'
errcga:	db	'Need at least CGA.$'
section	.bss
order:	resb	1		; Order of Sierpinski triangle
vmode:	resb	1		; Store old video mode (to restore later)


PROC Draw(INT x0 BYTE y0,depth)
  BYTE i,x,y,size

  size=1 LSH depth

  FOR y=0 TO size-1
  DO
    FOR x=0 TO size-1
    DO
      IF (x&y)=0 THEN
        Plot(x0+x,y0+y)
      FI
    OD
  OD
RETURN

PROC Main()
  BYTE CH=$02FC,COLOR1=$02C5,COLOR2=$02C6

  Graphics(8+16)
  Color=1
  COLOR1=$0C
  COLOR2=$02

  Draw(96,32,7)

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


package {

    import flash.display.GraphicsPathCommand;
    import flash.display.Sprite;

    /**
     * A Sierpinski triangle.
     */
    public class SierpinskiTriangle extends Sprite {

        /**
         * Creates a new SierpinskiTriangle object.
         *
         * @param n The order of the Sierpinski triangle.
         * @param c1 The background colour.
         * @param c2 The foreground colour.
         * @param width The width of the triangle.
         * @param height The height of the triangle.
         */
        public function SierpinskiTriangle(n:uint, c1:uint, c2:uint, width:Number, height:Number):void {
            _init(n, c1, c2, width, height);
        }

        /**
         * Generates the triangle.
         *
         * @param n The order of the Sierpinski triangle.
         * @param c1 The background colour.
         * @param c2 The foreground colour.
         * @param width The width of the triangle.
         * @param height The height of the triangle.
         * @private
         */
        private function _init(n:uint, c1:uint, c2:uint, width:Number, height:Number):void {

            if ( n <= 0 )
                return;

            // Draw the outer triangle.

            graphics.beginFill(c1);
            graphics.moveTo(width / 2, 0);
            graphics.lineTo(0, height);
            graphics.lineTo(width, height);
            graphics.lineTo(width / 2, 0);

            // Draw the inner triangle.

            graphics.beginFill(c2);
            graphics.moveTo(width / 4, height / 2);
            graphics.lineTo(width * 3 / 4, height / 2);
            graphics.lineTo(width / 2, height);
            graphics.lineTo(width / 4, height / 2);

            if ( n == 1 )
                return;

            // Recursively generate three Sierpinski triangles of half the size and order n - 1 and position them appropriately.

            var sub1:SierpinskiTriangle = new SierpinskiTriangle(n - 1, c1, c2, width / 2, height / 2);
            var sub2:SierpinskiTriangle = new SierpinskiTriangle(n - 1, c1, c2, width / 2, height / 2);
            var sub3:SierpinskiTriangle = new SierpinskiTriangle(n - 1, c1, c2, width / 2, height / 2);

            sub1.x = width / 4;
            sub1.y = 0;
            sub2.x = 0;
            sub2.y = height / 2;
            sub3.x = width / 2;
            sub3.y = height / 2;

            addChild(sub1);
            addChild(sub2);
            addChild(sub3);

        }

    }

}


path subtriangle(path p, real node) {
    return
        point(p, node) --
        point(p, node + 1/2) --
        point(p, node - 1/2) --
        cycle;
}

void sierpinski(path p, int order) {
    if (order == 0)
        fill(p);
    else {
        sierpinski(subtriangle(p, 0), order - 1);
        sierpinski(subtriangle(p, 1), order - 1);
        sierpinski(subtriangle(p, 2), order - 1);
    }
}

sierpinski((0, 0) -- (5 inch, 1 inch) -- (2 inch, 6 inch) -- cycle, 10);


// patscc -O2 -flto -D_GNU_SOURCE -DATS_MEMALLOC_LIBC sierpinski.dats -o sierpinski -latslib -lSDL2
#include "share/atspre_staload.hats"

typedef point = (int, int)

extern fun midpoint(A: point, B: point): point = "mac#"

extern fun sierpinski_draw(n: int, A: point, B: point, C: point): void = "mac#"

extern fun triangle_remove(A: point, B: point, C: point): void = "mac#"

extern fun sdl_drawline(x1: int, y1: int, x2: int, y2: int): void = "ext#sdl_drawline"

extern fun line(A: point, B: point): void

extern fun ats_tredraw(): void = "mac#ats_tredraw"

implement midpoint(A, B) = (xmid, ymid) where {
  val xmid = (A.0 + B.0) / 2
  val ymid = (A.1 + B.1) / 2
}

implement triangle_remove(A, B, C) = (
  line(A, B);
  line(B, C);
  line(C, A);
)

implement sierpinski_draw(n, A, B, C) =
  if n > 0 then
    let
      val AB = midpoint(A, B)
      val BC = midpoint(B, C)
      val CA = midpoint(C, A)
    in
      triangle_remove(AB, BC, CA);
      sierpinski_draw(n-1, A, AB, CA);
      sierpinski_draw(n-1, B, BC, AB);
      sierpinski_draw(n-1, C, CA, BC);
    end

implement line(A, B) = sdl_drawline(A.0, A.1, B.0, B.1)

extern fun SDL_Init(): void = "ext#sdl_init"
extern fun SDL_Quit(): void = "ext#sdl_quit"
extern fun SDL_Loop(): void = "ext#sdl_loop"

implement ats_tredraw() = sierpinski_draw(7, (320, 0), (0, 480), (640, 480))

implement main0() = (
  SDL_Init();
  SDL_Loop();
  SDL_Quit();
)

%{
#include <SDL2/SDL.h>
#include <unistd.h>
extern void ats_tredraw();
SDL_Window *sdlwin;
SDL_Renderer *sdlren;
void sdl_init() {
  if (SDL_Init(SDL_INIT_VIDEO)) {
    exit(1);
  }
  if ((sdlwin = SDL_CreateWindow("sierpinski triangles", 100, 100, 640, 480, SDL_WINDOW_SHOWN)) == NULL) {
    SDL_Quit();
    exit(2);
  }
  if ((sdlren = SDL_CreateRenderer(sdlwin, -1, SDL_RENDERER_ACCELERATED | SDL_RENDERER_PRESENTVSYNC)) == NULL) {
    SDL_DestroyWindow(sdlwin);
    SDL_Quit();
    exit(3);
  }
}
void sdl_clear() {
  SDL_SetRenderDrawColor(sdlren, 0, 0, 0, SDL_ALPHA_OPAQUE);
  SDL_RenderClear(sdlren);
  SDL_SetRenderDrawColor(sdlren, 255, 255, 255, SDL_ALPHA_OPAQUE);
}
void sdl_loop() {
  SDL_Event event;
  while (1) {
    sdl_clear();
    ats_tredraw();
    SDL_RenderPresent(sdlren);
    while (SDL_PollEvent(&event)) {
      if (event.type == SDL_QUIT) {
        return;
      }
    }
  }
}
void sdl_quit() {
    SDL_DestroyRenderer(sdlren);
    SDL_DestroyWindow(sdlwin);
    SDL_Quit();
}

void sdl_drawline(int x1, int y1, int x2, int y2) {
  SDL_RenderDrawLine(sdlren, x1, y1, x2, y2);
}
%}


#NoEnv
#SingleInstance, Force
SetBatchLines, -1

; Parameters
Width := 512, Height := Width/2*3**0.5, n := 8 ; iterations = 8

; Uncomment if Gdip.ahk is not in your standard library
#Include ..\lib\Gdip.ahkl

If !pToken := Gdip_Startup() ; Start gdi+
{
	MsgBox, 48, gdiplus error!, Gdiplus failed to start. Please ensure you have gdiplus on your system
	ExitApp
}
; I've added a simple new function here, just to ensure if anyone is having any problems then to make sure they are using the correct library version
if (Gdip_LibraryVersion() < 1.30)
{
	MsgBox, 48, Version error!, Please download the latest version of the gdi+ library
	ExitApp
}
OnExit, Exit

; Create a layered window (+E0x80000 : must be used for UpdateLayeredWindow to work!) that is always on top (+AlwaysOnTop), has no taskbar entry or caption
Gui, -Caption +E0x80000 +LastFound +OwnDialogs +Owner +AlwaysOnTop
Gui, Show
hwnd1 := WinExist()
OnMessage(0x201, "WM_LBUTTONDOWN")

, hbm := CreateDIBSection(Width, Height)
, hdc := CreateCompatibleDC()
, obm := SelectObject(hdc, hbm)
, G := Gdip_GraphicsFromHDC(hdc)
, Gdip_SetSmoothingMode(G, 4)

; Sierpinski triangle by subtracting triangles
, pBrushBlack := Gdip_BrushCreateSolid(0xff000000)
, rectangle := 0 "," 0 "|" 0 "," Height "|" Width "," Height "|" Width "," 0
, Gdip_FillPolygon(G, pBrushBlack,  rectangle, FillMode=0)

, pBrushBlue := Gdip_BrushCreateSolid(0xff0000ff)
, triangle := Width/2 "," 0 "|" 0 "," Height "|" Width "," Height
, Gdip_FillPolygon(G, pBrushBlue,  triangle, FillMode=0)
, Gdip_DeleteBrush(pBrushBlue)

, UpdateLayeredWindow(hwnd1, hdc, (A_ScreenWidth-Width)/2, (A_ScreenHeight-Height)/2, Width, Height)

, k:=2, x:=0, y:=0, i:=1
Loop, % n
{
	Sleep 0.5*1000
	While x*y<Width*Height
	{
		triangle := x "," y "|" x+Width/2/k "," y+Height/k "|" x+Width/k "," y
		, Gdip_FillPolygon(G, pBrushBlack,  triangle, FillMode=0)
		, x += Width/k
		, (x >= Width) ? (x := i*Width/2/k, y += Height/k, i:=!i) : ""
	}
	UpdateLayeredWindow(hwnd1, hdc, (A_ScreenWidth-Width)/2, (A_ScreenHeight-Height)/2, Width, Height)
	, k*=2, x:=0, y:=0, i:=1
}

Gdip_DeleteBrush(pBrushBlack)

, UpdateLayeredWindow(hwnd1, hdc, (A_ScreenWidth-Width)/2, (A_ScreenHeight-Height)/2, Width, Height)
Sleep, 1*1000

; Bonus: Sierpinski triangle by random dots
Gdip_GraphicsClear(G, 0xff000000)
, pBrushBlue := Gdip_BrushCreateSolid(0xff0000ff)
, x1:=Width/2, y1:=0, x2:=0, y2:=Height, x3:=Width, y3:=Height
, x:= Width/2, y:=Height/2 ; I'm to lazy to pick a random point.
Loop, % n
{
	Loop, % 10*10**(A_Index/2)
	{
		Random, rand, 1, 3
		x := abs(x+x%rand%)/2
		, y := abs(y+y%rand%)/2
		, Gdip_FillEllipse(G, pBrushBlue, x, y, 1, 1)
	}
	UpdateLayeredWindow(hwnd1, hdc, (A_ScreenWidth-Width)/2, (A_ScreenHeight-Height)/2, Width, Height)
	Sleep, 0.5*1000
}
SelectObject(hdc, obm)
, DeleteObject(hbm)
, DeleteDC(hdc)
, Gdip_DeleteGraphics(G)
Return

Exit:
	Gdip_Shutdown(pToken)
	ExitApp

WM_LBUTTONDOWN()
{
	If (A_Gui = 1)
	PostMessage, 0xA1, 2
}


SCREEN 9
H=.5
P=300
FOR I=1 TO 9^6
    N=RND
    IF N > 2/3 THEN
        X=H+X*H:Y=Y*H
    ELSEIF N > 1/3 THEN
        X=H^2+X*H:Y=H+Y*H
    ELSE
        X=X*H:Y=Y*H
    END IF
    PSET(P-X*P,P-Y*P)
NEXT


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

long long x, y, dx, dy, scale, clen, cscale;
typedef struct { double r, g, b; } rgb;
rgb ** pix;

void sc_up()
{
	scale *= 2; x *= 2; y *= 2;
	cscale *= 3;
}

void h_rgb(long long x, long long y)
{
	rgb *p = &pix[y][x];

#	define SAT 1
	double h = 6.0 * clen / cscale;
	double VAL = 1;
	double c = SAT * VAL;
	double X = c * (1 - fabs(fmod(h, 2) - 1));

	switch((int)h) {
	case 0: p->r += c; p->g += X; return;
	case 1:	p->r += X; p->g += c; return;
	case 2: p->g += c; p->b += X; return;
	case 3: p->g += X; p->b += c; return;
	case 4: p->r += X; p->b += c; return;
	default:
		p->r += c; p->b += X;
	}
}

void iter_string(const char * str, int d)
{
	long long len;
	while (*str != '\0') {
		switch(*(str++)) {
		case 'X':
			if (d)	iter_string("XHXVX", d - 1);
			else{
				clen ++;
				h_rgb(x/scale, y/scale);
				x += dx;
				y -= dy;
			}
			continue;
		case 'V':
			len = 1LLU << d;
			while (len--) {
				clen ++;
				h_rgb(x/scale, y/scale);
				y += dy;
			}
			continue;
		case 'H':
			len = 1LLU << d;
			while(len --) {
				clen ++;
				h_rgb(x/scale, y/scale);
				x -= dx;
			}
			continue;
		}
	}
}

void sierp(long leng, int depth)
{
	long i;
	long h = leng + 20, w = leng + 20;

	/* allocate pixel buffer */
	rgb *buf = malloc(sizeof(rgb) * w * h);
	pix = malloc(sizeof(rgb *) * h);
	for (i = 0; i < h; i++)
		pix[i] = buf + w * i;
	memset(buf, 0, sizeof(rgb) * w * h);

        /* init coords; scale up to desired; exec string */
	x = y = 10; dx = leng; dy = leng; scale = 1; clen = 0; cscale = 3;
	for (i = 0; i < depth; i++) sc_up();
	iter_string("VXH", depth);

	/* write color PNM file */
	unsigned char *fpix = malloc(w * h * 3);
	double maxv = 0, *dbuf = (double*)buf;

	for (i = 3 * w * h - 1; i >= 0; i--)
		if (dbuf[i] > maxv) maxv = dbuf[i];
	for (i = 3 * h * w - 1; i >= 0; i--)
		fpix[i] = 255 * dbuf[i] / maxv;

	printf("P6\n%ld %ld\n255\n", w, h);
	fflush(stdout); /* printf and fwrite may treat buffer differently */
	fwrite(fpix, h * w * 3, 1, stdout);
}

int main(int c, char ** v)
{
	int size, depth;

	depth  = (c > 1) ? atoi(v[1]) : 10;
	size = 1 << depth;

	fprintf(stderr, "size: %d depth: %d\n", size, depth);
	sierp(size, depth + 2);

	return 0;
}


#include <windows.h>
#include <string>
#include <iostream>

const int BMP_SIZE = 612;

class myBitmap {
public:
    myBitmap() : pen( NULL ), brush( NULL ), clr( 0 ), wid( 1 ) {}
    ~myBitmap() {
        DeleteObject( pen ); DeleteObject( brush );
        DeleteDC( hdc ); DeleteObject( bmp );
    }
    bool create( int w, int h ) {
        BITMAPINFO bi;
        ZeroMemory( &bi, sizeof( bi ) );
        bi.bmiHeader.biSize        = sizeof( bi.bmiHeader );
        bi.bmiHeader.biBitCount    = sizeof( DWORD ) * 8;
        bi.bmiHeader.biCompression = BI_RGB;
        bi.bmiHeader.biPlanes      = 1;
        bi.bmiHeader.biWidth       =  w;
        bi.bmiHeader.biHeight      = -h;
        HDC dc = GetDC( GetConsoleWindow() );
        bmp = CreateDIBSection( dc, &bi, DIB_RGB_COLORS, &pBits, NULL, 0 );
        if( !bmp ) return false;
        hdc = CreateCompatibleDC( dc );
        SelectObject( hdc, bmp );
        ReleaseDC( GetConsoleWindow(), dc );
        width = w; height = h;
        return true;
    }
    void clear( BYTE clr = 0 ) {
        memset( pBits, clr, width * height * sizeof( DWORD ) );
    }
    void setBrushColor( DWORD bClr ) {
        if( brush ) DeleteObject( brush );
        brush = CreateSolidBrush( bClr );
        SelectObject( hdc, brush );
    }
    void setPenColor( DWORD c ) {
        clr = c; createPen();
    }
    void setPenWidth( int w ) {
        wid = w; createPen();
    }
    void saveBitmap( std::string path ) {
        BITMAPFILEHEADER fileheader;
        BITMAPINFO       infoheader;
        BITMAP           bitmap;
        DWORD            wb;
        GetObject( bmp, sizeof( bitmap ), &bitmap );
        DWORD* dwpBits = new DWORD[bitmap.bmWidth * bitmap.bmHeight];
        ZeroMemory( dwpBits, bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD ) );
        ZeroMemory( &infoheader, sizeof( BITMAPINFO ) );
        ZeroMemory( &fileheader, sizeof( BITMAPFILEHEADER ) );
        infoheader.bmiHeader.biBitCount = sizeof( DWORD ) * 8;
        infoheader.bmiHeader.biCompression = BI_RGB;
        infoheader.bmiHeader.biPlanes = 1;
        infoheader.bmiHeader.biSize = sizeof( infoheader.bmiHeader );
        infoheader.bmiHeader.biHeight = bitmap.bmHeight;
        infoheader.bmiHeader.biWidth = bitmap.bmWidth;
        infoheader.bmiHeader.biSizeImage = bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD );
        fileheader.bfType    = 0x4D42;
        fileheader.bfOffBits = sizeof( infoheader.bmiHeader ) + sizeof( BITMAPFILEHEADER );
        fileheader.bfSize    = fileheader.bfOffBits + infoheader.bmiHeader.biSizeImage;
        GetDIBits( hdc, bmp, 0, height, ( LPVOID )dwpBits, &infoheader, DIB_RGB_COLORS );
        HANDLE file = CreateFile( path.c_str(), GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
                                  FILE_ATTRIBUTE_NORMAL, NULL );
        WriteFile( file, &fileheader, sizeof( BITMAPFILEHEADER ), &wb, NULL );
        WriteFile( file, &infoheader.bmiHeader, sizeof( infoheader.bmiHeader ), &wb, NULL );
        WriteFile( file, dwpBits, bitmap.bmWidth * bitmap.bmHeight * 4, &wb, NULL );
        CloseHandle( file );
        delete [] dwpBits;
    }
    HDC getDC() const     { return hdc; }
    int getWidth() const  { return width; }
    int getHeight() const { return height; }
private:
    void createPen() {
        if( pen ) DeleteObject( pen );
        pen = CreatePen( PS_SOLID, wid, clr );
        SelectObject( hdc, pen );
    }
    HBITMAP bmp; HDC    hdc;
    HPEN    pen; HBRUSH brush;
    void    *pBits; int    width, height, wid;
    DWORD    clr;
};
class sierpinski {
public:
    void draw( int o ) {
        colors[0] = 0xff0000; colors[1] = 0x00ff33; colors[2] = 0x0033ff;
        colors[3] = 0xffff00; colors[4] = 0x00ffff; colors[5] = 0xffffff;
        bmp.create( BMP_SIZE, BMP_SIZE ); HDC dc = bmp.getDC();
        drawTri( dc, 0, 0, ( float )BMP_SIZE, ( float )BMP_SIZE, o / 2 );
        bmp.setPenColor( colors[0] ); MoveToEx( dc, BMP_SIZE >> 1, 0, NULL );
        LineTo( dc, 0, BMP_SIZE - 1 ); LineTo( dc, BMP_SIZE - 1, BMP_SIZE - 1 );
        LineTo( dc, BMP_SIZE >> 1, 0 ); bmp.saveBitmap( "./st.bmp" );
    }
private:
    void drawTri( HDC dc, float l, float t, float r, float b, int i ) {
        float w = r - l, h = b - t, hh = h / 2.f, ww = w / 4.f;
        if( i ) {
            drawTri( dc, l + ww, t, l + ww * 3.f, t + hh, i - 1 );
            drawTri( dc, l, t + hh, l + w / 2.f, t + h, i - 1 );
            drawTri( dc, l + w / 2.f, t + hh, l + w, t + h, i - 1 );
        }
        bmp.setPenColor( colors[i % 6] );
        MoveToEx( dc, ( int )( l + ww ),          ( int )( t + hh ), NULL );
        LineTo  ( dc, ( int )( l + ww * 3.f ),    ( int )( t + hh ) );
        LineTo  ( dc, ( int )( l + ( w / 2.f ) ), ( int )( t + h ) );
        LineTo  ( dc, ( int )( l + ww ),          ( int )( t + hh ) );
    }
    myBitmap bmp;
    DWORD colors[6];
};
int main(int argc, char* argv[]) {
    sierpinski s; s.draw( 12 );
    return 0;
}


void main() {
    import grayscale_image;

    enum order = 8,
         margin = 10,
         width = 2 ^^ order;

    auto im = new Image!Gray(width + 2 * margin, width + 2 * margin);
    im.clear(Gray.white);

    foreach (immutable y; 0 .. width)
        foreach (immutable x; 0 .. width)
            if ((x & y) == 0)
                im[x + margin, y + margin] = Gray.black;
    im.savePGM("sierpinski.pgm");
}


-module(sierpinski).
-author("zduchac").
-export([start/0]).

sierpinski(DC, Order) ->
    Size = 1 bsl Order,
    sierpinski(DC, Order, Size, 0, 0).

sierpinski(_, _, Size, _, Y) when Y =:= Size ->
    ok;
sierpinski(DC, Order, Size, X, Y) when X =:= Size ->
    sierpinski(DC, Order, Size, 0, Y + 1);
sierpinski(DC, Order, Size, X, Y) when X band Y =:= 0 ->
    wxDC:drawPoint(DC, {X, Y}),
    sierpinski(DC, Order, Size, X + 1, Y);
sierpinski(DC, Order, Size, X, Y) ->
    sierpinski(DC, Order, Size, X + 1, Y).

start() ->
    Wx = wx:new(),
    Frame = wxFrame:new(Wx, -1, "Raytracer", []),
    wxFrame:connect(Frame, paint, [{callback,
				    fun(_Evt, _Obj) ->
					    DC = wxPaintDC:new(Frame),
					    sierpinski(DC, 8),
					    wxPaintDC:destroy(DC)
				    end
				   }]),
    wxFrame:show(Frame).


PROGRAM SIERPINSKY

!$INCLUDE="PC.LIB"

BEGIN
   ORDER%=8
   SIZE%=2^ORDER%
   SCREEN(9)
   GR_WINDOW(0,0,520,520)
   FOR Y%=0 TO SIZE%-1 DO
     FOR X%=0 TO SIZE%-1 DO
        IF (X% AND Y%)=0 THEN PSET(X%*2,Y%*2,2) END IF
     END FOR
   END FOR
   GET(K$)
END PROGRAM


USING: accessors images images.loader kernel literals math
math.bits math.functions make sequences ;
IN: rosetta-code.sierpinski-triangle-graphical

CONSTANT: black B{ 33  33  33  255 }
CONSTANT: white B{ 255 255 255 255 }
CONSTANT: size  $[ 2 8 ^ ]           ! edit 8 to change order

! Generate Sierpinksi's triangle sequence. This is sequence
! A001317 in OEIS.

: sierpinski ( n -- seq )
    [ [ 1 ] dip [ dup , dup 2 * bitxor ] times ] { } make nip ;

! Convert a number to binary, then append a black pixel for each
! set bit or a white pixel for each unset bit to the image being
! built by make.

: expand ( n -- ) make-bits [ black white ? % ] each ;

! Append white pixels until the end of the row in the image
! being built by make.

: pad ( n -- ) [ size ] dip 1 + - [ white % ] times ;

! Generate the image data for a sierpinski triangle of a given
! size in pixels. The image is square so its dimensions are
! n x n.

: sierpinski-img ( n -- seq )
    sierpinski [ [ [ expand ] dip pad ] each-index ] B{ } make ;

: main ( -- )
    <image>
    ${ size size }      >>dim
    BGRA                >>component-order
    ubyte-components    >>component-type
    size sierpinski-img >>bitmap
    "sierpinski-triangle.png" save-graphic-image ;

MAIN: main


include lib/graphics.4th               \ graphics support is needed

520 pic_width !                        \ width of the image
520 pic_height !                       \ height of the image

9 constant order                       \ Sierpinski's triangle order

black 255 whiteout                     \ black ink, white background
grayscale_image                        \ we're making a gray scale image
                                       \ do we set a pixel or not?
: ?pixel over over and if drop drop else set_pixel then ;
: triangle 1 order lshift dup 0 do dup 0 do i j ?pixel loop loop drop ;

triangle s" triangle.ppm" save_image   \ done, save the image


# triangle_x(n) and triangle_y(n) return X,Y coordinates for the
# Sierpinski triangle point number n, for integer n.
triangle_x(n) = (n > 0 ? 2*triangle_x(int(n/3)) + digit_to_x(int(n)%3) : 0)
triangle_y(n) = (n > 0 ? 2*triangle_y(int(n/3)) + digit_to_y(int(n)%3) : 0)
digit_to_x(d) = (d==0 ? 0 : d==1 ? -1 : 1)
digit_to_y(d) = (d==0 ? 0 : 1)

# Plot the Sierpinski triangle to "level" many replications.
# "trange" and "samples" are chosen so the parameter t runs through
# integers t=0 to 3**level-1, inclusive.
#
level=6
set trange [0:3**level-1]
set samples 3**level
set parametric
set key off
plot triangle_x(t), triangle_y(t) with points


package main

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

func main() {
    const order = 8
    const width = 1 << order
    const margin = 10
    bounds := image.Rect(-margin, -margin, width+2*margin, width+2*margin)
    im := image.NewGray(bounds)
    gBlack := color.Gray{0}
    gWhite := color.Gray{255}
    draw.Draw(im, bounds, image.NewUniform(gWhite), image.ZP, draw.Src)

    for y := 0; y < width; y++ {
        for x := 0; x < width; x++ {
            if x&y == 0 {
                im.SetGray(x, y, gBlack)
            }
        }
    }
    f, err := os.Create("sierpinski.png")
    if err != nil {
        fmt.Println(err)
        return
    }
    if err = png.Encode(f, im); err != nil {
        fmt.Println(err)
    }
    if err = f.Close(); err != nil {
        fmt.Println(err)
    }
}


import Diagrams.Prelude
import Diagrams.Backend.Cairo.CmdLine

triangle = eqTriangle # fc black # lw 0

reduce t =     t
              ===
           (t ||| t)

sierpinski = iterate reduce triangle

main = defaultMain $ sierpinski !! 7


link wopen

procedure main(A)
   local width, margin, x, y

   width := 2 ^ (order := (0 < integer(\A[1])) | 8)
   wsize := width + 2 * (margin := 30 )
   WOpen("label=Sierpinski", "size="||wsize||","||wsize) |
      stop("*** cannot open window")

   every y := 0 to width - 1 do
      every x := 0 to width - 1 do
         if iand(x, y) = 0 then DrawPoint(x + margin, y + margin)

  Event()
end


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

/**
* SierpinskyTriangle.java
* Draws a SierpinskyTriangle in a JFrame
* The order of complexity is given from command line, but
* defaults to 3
*
* @author Istarnion
*/

class SierpinskyTriangle {

	public static void main(String[] args) {
		int i = 3;		// Default to 3
		if(args.length >= 1) {
			try {
				i = Integer.parseInt(args[0]);
			}
			catch(NumberFormatException e) {
				System.out.println("Usage: 'java SierpinskyTriangle [level]'\nNow setting level to "+i);
			}
		}
		final int level = i;

		JFrame frame = new JFrame("Sierpinsky Triangle - Java");
		frame.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);

		JPanel panel = new JPanel() {
			@Override
			public void paintComponent(Graphics g) {
				g.setColor(Color.BLACK);
				drawSierpinskyTriangle(level, 20, 20, 360, (Graphics2D)g);
			}
		};

		panel.setPreferredSize(new Dimension(400, 400));

		frame.add(panel);
		frame.pack();
		frame.setResizable(false);
		frame.setLocationRelativeTo(null);
		frame.setVisible(true);
	}

	private static void drawSierpinskyTriangle(int level, int x, int y, int size, Graphics2D g) {
		if(level <= 0) return;

		g.drawLine(x, y, x+size, y);
		g.drawLine(x, y, x, y+size);
		g.drawLine(x+size, y, x, y+size);

		drawSierpinskyTriangle(level-1, x, y, size/2, g);
		drawSierpinskyTriangle(level-1, x+size/2, y, size/2, g);
		drawSierpinskyTriangle(level-1, x, y+size/2, size/2, g);
	}
}


F scs(String x, y)
   I x.empty
      R y
   I y.empty
      R x
   I x[0] == y[0]
      R x[0]‘’scs(x[1..], y[1..])
   I scs(x, y[1..]).len <= scs(x[1..], y).len
      R y[0]‘’scs(x, y[1..])
   E
      R x[0]‘’scs(x[1..], y)

print(scs(‘abcbdab’, ‘bdcaba’))


<title>Sierpinski Triangle Fractal</title>

  Please click to start and/or change color:
  <input type="button" value=" Plot it! " onclick="pSierpinskiT();">

Sierpinski triangle fractal

  <canvas id="cvsId" width="640" height="640" style="border: 2px inset;"></canvas>


include "turtle" {search: "."};

# Compute the curve using a Lindenmayer system of rules
def rules:
 # "H" signfies Horizontal motion
 {X: "XX",
  H: "H--X++H++X--H",
  "": "H--X--X"};

def sierpinski($count):
  rules as $rules
  | def repeat($count):
      if $count == 0 then .
      else gsub("X"; $rules["X"]) | gsub("H"; $rules["H"])
      | repeat($count-1)
      end;
  $rules[""] | repeat($count) ;

def interpret($x):
  if   $x == "+" then turtleRotate(-60)
  elif $x == "-" then turtleRotate(60)
  else turtleForward(20)
  end;

def sierpinski_curve($n):
  sierpinski($n)
  | split("")
  | reduce .[] as $action (
      turtle([200,-200]) | turtleDown;
      interpret($action) ) ;

# viewBox = <min-x> <min-y> <width> <height>
# Input: {svg, minx, miny, maxx, maxy}
def svg:
  "<svg viewBox='\(.minx|floor) \(.miny - 4 |floor) \(.maxx - .minx|ceil) \(6 + .maxy - .miny|ceil)'",
  "     preserveAspectRatio='xMinYmin meet'",
  "     xmlns='http://www.w3.org/2000/svg' >",
  path("none"; "red"; 1),
  "</svg>";

sierpinski_curve(5)
| svg


using Luxor

function sierpinski(txy, levelsyet)
    nxy = zeros(6)
    if levelsyet > 0
        for i in 1:6
            pos = i < 5 ? i + 2 : i - 4
            nxy[i] = (txy[i] + txy[pos]) / 2.0
        end
        sierpinski([txy[1],txy[2],nxy[1],nxy[2],nxy[5],nxy[6]], levelsyet-1)
        sierpinski([nxy[1],nxy[2],txy[3],txy[4],nxy[3],nxy[4]], levelsyet-1)
        sierpinski([nxy[5],nxy[6],nxy[3],nxy[4],txy[5],txy[6]], levelsyet-1)
    else
        poly([Point(txy[1],txy[2]),Point(txy[3],txy[4]),Point(txy[5],txy[6])], :fill ,close=true)
    end
end

Drawing(800, 800)
sierpinski([400., 100., 700., 500., 100., 500.], 7)
finish()
preview()


import java.awt.*
import javax.swing.JFrame
import javax.swing.JPanel

fun main(args: Array<String>) {
    var i = 8     // Default
    if (args.any()) {
        try {
            i = args.first().toInt()
        } catch (e: NumberFormatException) {
            i = 8
            println("Usage: 'java SierpinskyTriangle [level]'\nNow setting level to $i")
        }
    }

    object : JFrame("Sierpinsky Triangle - Kotlin") {
        val panel = object : JPanel() {
            val size = 800

            init {
                preferredSize = Dimension(size, size)
            }

            public override fun paintComponent(g: Graphics) {
                g.color = Color.BLACK
                if (g is Graphics2D) {
                    g.drawSierpinskyTriangle(i, 20, 20, size - 40)
                }
            }
        }

        init {
            defaultCloseOperation = JFrame.EXIT_ON_CLOSE
            add(panel)
            pack()
            isResizable = false
            setLocationRelativeTo(null)
            isVisible = true
        }
    }
}

internal fun Graphics2D.drawSierpinskyTriangle(level: Int, x: Int, y: Int, size: Int) {
    if (level > 0) {
        drawLine(x, y, x + size, y)
        drawLine(x, y, x, y + size)
        drawLine(x + size, y, x, y + size)

        drawSierpinskyTriangle(level - 1, x, y, size / 2)
        drawSierpinskyTriangle(level - 1, x + size / 2, y, size / 2)
        drawSierpinskyTriangle(level - 1, x, y + size / 2, size / 2)
    }
}


with Ada.Text_IO;

procedure Shortest is

   function Scs (Left, Right : in String) return String is
      Left_Tail  : String renames Left  (Left'First  + 1 .. Left'Last);
      Right_Tail : String renames Right (Right'First + 1 .. Right'Last);
   begin
      if Left  = "" then return Right; end if;
      if Right = "" then return Left;  end if;

      if Left (Left'First) = Right (Right'First) then
         return Left (Left'First) & Scs (Left_Tail, Right_Tail);
      end if;

      declare
         S1 : constant String := Scs (Left, Right_Tail);
         S2 : constant String := Scs (Left_Tail, Right);
      begin
         return (if S1'Length <= S2'Length
                 then Right (Right'First) & S1
                 else Left  (Left'First)  & S2);
      end;
   end Scs;

   procedure Exercise (Left, Right : String) is
      use Ada.Text_Io;
   begin
      Put ("scs ( "); Put (Left); Put (" , "); Put (Right); Put ( " ) -> ");
      Put (Scs (Left, Right));
      New_Line;
   end Exercise;

begin
   Exercise ("abcbdab", "bdcaba");
   Exercise ("WEASELS", "WARDANCE");
end Shortest;


BEGIN
    PRIO SCS = 1;
    # returns the shortest common supersequence of x and y #
    OP   SCS = ( STRING x, y )STRING:
         IF   x = "" THEN y
         ELIF y = "" THEN x
         ELIF x[ LWB x ] = y[ LWB y ]
         THEN x[ LWB x ] + ( x[ LWB x + 1 : ] SCS y[ LWB y + 1 : ] )
         ELIF STRING x y sub = x SCS y[ LWB y + 1 : ];
              STRING x sub y = x[ LWB x + 1 : ] SCS y;
              INT x y sub size = ( UPB x y sub - LWB x y sub ) + 1;
              INT x sub y size = ( UPB x sub y - LWB x sub y ) + 1;
              x y sub size <= x sub y size
         THEN y[ LWB y ] + x y sub
         ELSE x[ LWB x ] + x sub y
         FI # SCS # ;

    print( ( "abcbdab" SCS "bdcaba", newline ) )
END


to sierpinski :n :length
  if :n = 0 [stop]
  repeat 3 [sierpinski :n-1 :length/2  fd :length rt 120]
end
seth 30 sierpinski 5 200


-- The argument 'tri' is a list of co-ords: {x1, y1, x2, y2, x3, y3}
function sierpinski (tri, order)
    local new, p, t = {}
    if order > 0 then
        for i = 1, #tri do
            p = i + 2
            if p > #tri then p = p - #tri end
            new[i] = (tri[i] + tri[p]) / 2
        end
        sierpinski({tri[1],tri[2],new[1],new[2],new[5],new[6]}, order-1)
        sierpinski({new[1],new[2],tri[3],tri[4],new[3],new[4]}, order-1)
        sierpinski({new[5],new[6],new[3],new[4],tri[5],tri[6]}, order-1)
    else
        love.graphics.polygon("fill", tri)
    end
end

-- Callback function used to draw on the screen every frame
function love.draw ()
    sierpinski({400, 100, 700, 500, 100, 500}, 7)
end


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

typedef struct link link_t;
struct link {
	int len;
	char letter;
	link_t *next;
};

// Stores a copy of a SCS of x and y in out.  Caller needs to make sure out is long enough.
int scs(char *x, char *y, char *out)
{
	int lx = strlen(x), ly = strlen(y);
	link_t lnk[ly + 1][lx + 1];

	for (int i = 0; i < ly; i++)
		lnk[i][lx] = (link_t) {ly - i, y[i], &lnk[i + 1][lx]};

	for (int j = 0; j < lx; j++)
		lnk[ly][j] = (link_t) {lx - j, x[j], &lnk[ly][j + 1]};

	lnk[ly][lx] = (link_t) {0};

	for (int i = ly; i--; ) {
		for (int j = lx; j--; ) {
			link_t *lp = &lnk[i][j];
			if (y[i] == x[j]) {
				lp->next = &lnk[i+1][j+1];
				lp->letter = x[j];
			} else if (lnk[i][j+1].len < lnk[i+1][j].len) {
				lp->next = &lnk[i][j+1];
				lp->letter = x[j];
			} else {
				lp->next = &lnk[i+1][j];
				lp->letter = y[i];
			}
			lp->len = lp->next->len + 1;
		}
	}

	for (link_t *lp = &lnk[0][0]; lp; lp = lp->next)
		*out++ = lp->letter;

	return 0;
}

int main(void)
{
	char x[] = "abcbdab", y[] = "bdcaba", res[128];
	scs(x, y, res);
	printf("SCS(%s, %s) -> %s\n", x, y, res);
	return 0;
}


import imageman

const
  Black = ColorRGBU [byte 0, 0, 0]  # For background.
  Red = ColorRGBU [byte 255, 0, 0]  # For triangle.

proc drawSierpinski(img: var Image; txy: array[1..6, float]; levelsYet: Natural) =
  var nxy: array[1..6, float]
  if levelsYet > 0:
    for i in 1..6:
      let pos = if i < 5: i + 2 else: i - 4
      nxy[i] = (txy[i] + txy[pos]) / 2
    img.drawSierpinski([txy[1], txy[2], nxy[1], nxy[2], nxy[5], nxy[6]], levelsYet - 1)
    img.drawSierpinski([nxy[1], nxy[2], txy[3], txy[4], nxy[3], nxy[4]], levelsyet - 1)
    img.drawSierpinski([nxy[5], nxy[6], nxy[3], nxy[4], txy[5], txy[6]], levelsyet - 1)
  else:
    img.drawPolyline(closed = true, Red,
        (txy[1].toInt, txy[2].toInt), (txy[3].toInt, txy[4].toInt),(txy[5].toInt, txy[6].toInt))

var image = initImage[ColorRGBU](800, 800)
image.fill(Black)
image.drawSierpinski([400.0, 100.0, 700.0, 500.0, 100.0, 500.0], 7)
image.savePNG("sierpinski_triangle.png", compression = 9)


use Game.SDL2;
use Game.Framework;

class Test {
  @framework : GameFramework;
  @colors : Color[];
  @step : Int;

  function : Main(args : String[]) ~ Nil {
    Test->New()->Run();
  }

  New() {
    @framework := GameFramework->New(GameConsts->SCREEN_WIDTH, GameConsts->SCREEN_HEIGHT, "Sierpinski Triangle");
    @framework->SetClearColor(Color->New(0,0,0));
    @colors := Color->New[1];
    @colors[0] := Color->New(178,34,34);
  }

  method : Run() ~ Nil {
    if(@framework->IsOk()) {
      e := @framework->GetEvent();

      quit := false;
      while(<>quit) {
        # process input
        while(e->Poll() <> 0) {
          if(e->GetType() = EventType->SDL_QUIT) {
            quit := true;
          };
        };

        @framework->FrameStart();
        @framework->Clear();
        Render(8, 20, 20, 450);
        @framework->Show();
        @framework->FrameEnd();
      };
    }
    else {
      "--- Error Initializing Environment ---"->ErrorLine();
      return;
    };

    leaving {
      @framework->Quit();
    };
  }

  method : Render(level : Int, x : Int, y : Int, size : Int) ~ Nil {
    if(level > -1) {
      renderer := @framework->GetRenderer();

      renderer->LineColor(x, y, x+size, y, @colors[0]);
      renderer->LineColor(x, y, x, y+size, @colors[0]);
      renderer->LineColor(x+size, y, x, y+size, @colors[0]);

      Render(level-1, x, y, size/2);
      Render(level-1, x+size/2, y, size/2);
      Render(level-1, x, y+size/2, size/2);
    };
  }
}

consts GameConsts {
  SCREEN_WIDTH := 640,
  SCREEN_HEIGHT := 480
}


public class ShortestCommonSupersequence
{
    Dictionary<(string, string), string> cache = new();

    public string scs(string x, string y)
    {
        if (x.Length == 0) return y;
        if (y.Length == 0) return x;

        if (cache.TryGetValue((x, y), out var result)) return result;

        if (x[0] == y[0])
        {
            return cache[(x, y)] = x[0] + scs(x.Substring(1), y.Substring(1));
        }

        var xr = scs(x.Substring(1), y);
        var yr = scs(x, y.Substring(1));
        if (yr.Length <= xr.Length)
        {
            return cache[(x, y)] = y[0] + yr;
        }
        else
        {
            return cache[(x, y)] = x[0] + xr;
        }
    }

    public static void Main(string[] args)
    {
        var scs = new ShortestCommonSupersequence();
        Console.WriteLine(scs.scs("abcbdab", "bdcaba"));
    }
}


#include <iostream>

std::string scs(std::string x, std::string y) {
    if (x.empty()) {
        return y;
    }
    if (y.empty()) {
        return x;
    }
    if (x[0] == y[0]) {
        return x[0] + scs(x.substr(1), y.substr(1));
    }
    if (scs(x, y.substr(1)).size() <= scs(x.substr(1), y).size()) {
        return y[0] + scs(x, y.substr(1));
    } else {
        return x[0] + scs(x.substr(1), y);
    }
}

int main() {
    auto res = scs("abcbdab", "bdcaba");
    std::cout << res << '\n';
    return 0;
}


open Graphics

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

let middle (x1, y1) (x2, y2) =
  ((x1 +. x2) /. 2.0,
   (y1 +. y2) /. 2.0)

let draw_line (x1, y1) (x2, y2) =
  moveto (round x1) (round y1);
  lineto (round x2) (round y2);
;;

let draw_triangle (p1, p2, p3) =
  draw_line p1 p2;
  draw_line p2 p3;
  draw_line p3 p1;
;;

let () =
  open_graph "";
  let width = float (size_x ()) in
  let height = float (size_y ()) in
  let pad = 20.0 in
  let initial_triangle =
    ( (pad, pad),
      (width -. pad, pad),
      (width /. 2.0, height -. pad) )
  in
  let rec loop step tris =
    if step <= 0 then tris else
      loop (pred step) (
        List.fold_left (fun acc (p1, p2, p3) ->
          let m1 = middle p1 p2
          and m2 = middle p2 p3
          and m3 = middle p3 p1 in
          let tri1 = (p1, m1, m3)
          and tri2 = (p2, m2, m1)
          and tri3 = (p3, m3, m2) in
          tri1 :: tri2 :: tri3 :: acc
        ) [] tris
      )
  in
  let res = loop 6 [ initial_triangle ] in
  List.iter draw_triangle res;
  ignore (read_key ())


\\ Sierpinski triangle fractal
\\ Note: plotmat() can be found here on
\\ http://rosettacode.org/wiki/Brownian_tree#PARI.2FGP page.
\\ 6/3/16 aev
pSierpinskiT(n)={
my(sz=2^n,M=matrix(sz,sz),x,y);
for(y=1,sz, for(x=1,sz, if(!bitand(x,y),M[x,y]=1);));\\fends
plotmat(M);
}
{\\ Test:
pSierpinskiT(9); \\ SierpT9.png
}


import std.stdio, std.functional, std.array, std.range;

dstring scs(in dstring x, in dstring y) nothrow @safe {
    alias mScs = memoize!scs;
    if (x.empty) return y;
    if (y.empty) return x;
    if (x.front == y.front)
        return x.front ~ mScs(x.dropOne, y.dropOne);
    if (mScs(x, y.dropOne).length <= mScs(x.dropOne, y).length)
        return y.front ~ mScs(x, y.dropOne);
    else
        return x.front ~ mScs(x.dropOne, y);
}

void main() @safe {
    scs("abcbdab", "bdcaba").writeln;
}


defmodule SCS do
  def scs(u, v) do
    lcs = LCS.lcs(u, v) |> to_charlist
    scs(to_charlist(u), to_charlist(v), lcs, []) |> to_string
  end

  defp scs(u, v, [], res), do: Enum.reverse(res) ++ u ++ v
  defp scs([h|ut], [h|vt], [h|lt], res),      do: scs(ut, vt, lt, [h|res])
  defp scs([h|_]=u, [vh|vt], [h|_]=lcs, res), do: scs(u, vt, lcs, [vh|res])
  defp scs([uh|ut], v, lcs, res),             do: scs(ut, v, lcs, [uh|res])
end

u = "abcbdab"
v = "bdcaba"
IO.puts "SCS(#{u}, #{v}) = #{SCS.scs(u, v)}"


USING: combinators io kernel locals math memoize sequences ;

MEMO:: scs ( x y -- seq )
    {
        { [ x empty? ] [ y ] }
        { [ y empty? ] [ x ] }
        { [ x first y first = ]
          [ x rest y rest scs x first prefix ] }
        { [ x y rest scs length x rest y scs length <= ]
          [ x y rest scs y first prefix ] }
        [ x rest y scs x first prefix ]
    } cond ;

"abcbdab" "bdcaba" scs print


package main

import (
    "fmt"
    "strings"
)

func lcs(x, y string) string {
    xl, yl := len(x), len(y)
    if xl == 0 || yl == 0 {
        return ""
    }
    x1, y1 := x[:xl-1], y[:yl-1]
    if x[xl-1] == y[yl-1] {
        return fmt.Sprintf("%s%c", lcs(x1, y1), x[xl-1])
    }
    x2, y2 := lcs(x, y1), lcs(x1, y)
    if len(x2) > len(y2) {
        return x2
    } else {
        return y2
    }
}

func scs(u, v string) string {
    ul, vl := len(u), len(v)
    lcs := lcs(u, v)
    ui, vi := 0, 0
    var sb strings.Builder
    for i := 0; i < len(lcs); i++ {
        for ui < ul && u[ui] != lcs[i] {
            sb.WriteByte(u[ui])
            ui++
        }
        for vi < vl && v[vi] != lcs[i] {
            sb.WriteByte(v[vi])
            vi++
        }
        sb.WriteByte(lcs[i])
        ui++
        vi++
    }
    if ui < ul {
        sb.WriteString(u[ui:])
    }
    if vi < vl {
        sb.WriteString(v[vi:])
    }
    return sb.String()
}

func main() {
    u := "abcbdab"
    v := "bdcaba"
    fmt.Println(scs(u, v))
}


my $levels = 6;
my $side   = 512;
my $height = get_height($side);

sub get_height { my($side) = @_; $side * sqrt(3) / 2 }

sub triangle {
    my($x1, $y1, $x2, $y2, $x3, $y3, $fill, $animate) = @_;
    my $svg;
    $svg .= qq{<polygon points="$x1,$y1 $x2,$y2 $x3,$y3"};
    $svg .= qq{ style="fill: $fill; stroke-width: 0;"} if $fill;
    $svg .= $animate
        ? qq{>\n  <animate attributeType="CSS" attributeName="opacity"\n  values="1;0;1" keyTimes="0;.5;1" dur="20s" repeatCount="indefinite" />\n</polygon>\n}
        : ' />';
    return $svg;
}

sub fractal {
    my( $x1, $y1, $x2, $y2, $x3, $y3, $r ) = @_;
    my $svg;
    $svg .= triangle( $x1, $y1, $x2, $y2, $x3, $y3 );
    return $svg unless --$r;
    my $side = abs($x3 - $x2) / 2;
    my $height = get_height($side);
    $svg .= fractal( $x1, $y1-$height*2, $x1-$side/2, $y1-3*$height, $x1+$side/2, $y1-3*$height, $r);
    $svg .= fractal( $x2, $y1, $x2-$side/2, $y1-$height, $x2+$side/2, $y1-$height, $r);
    $svg .= fractal( $x3, $y1, $x3-$side/2, $y1-$height, $x3+$side/2, $y1-$height, $r);
}

open my $fh, '>', 'run/sierpinski_triangle.svg';
print $fh <<'EOD',
<?xml version="1.0" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<svg width="100%" height="100%" version="1.1" xmlns="http://www.w3.org/2000/svg">
<defs>
  <radialGradient id="basegradient" cx="50%" cy="65%" r="50%" fx="50%" fy="65%">
    <stop offset="10%" stop-color="#ff0" />
    <stop offset="60%" stop-color="#f00" />
    <stop offset="99%" stop-color="#00f" />
  </radialGradient>
</defs>
EOD

triangle( $side/2, 0, 0, $height, $side, $height, 'url(#basegradient)' ),
triangle( $side/2, 0, 0, $height, $side, $height, '#000', 'animate' ),
'<g style="fill: #fff; stroke-width: 0;">',
fractal( $side/2, $height, $side*3/4, $height/2, $side/4, $height/2, $levels ),
'</g></svg>';


scs :: Eq a  => [a] -> [a] -> [a]
scs [] ys = ys
scs xs [] = xs
scs xss@(x:xs) yss@(y:ys)
  | x == y = x : scs xs ys
  | otherwise = ws
      where
      us = scs xs yss
      vs = scs xss ys
      ws  | length us < length vs = x : us
          | otherwise = y : vs

main = putStrLn $ scs "abcbdab" "bdcaba"