# applies fn to successive elements of the array of values #
# the result is 0 if there are no values                   #
PROC reduce = ( []INT values, PROC( INT, INT )INT fn )INT:
     IF UPB values < LWB values
     THEN # no elements #
          0
     ELSE # there are some elements #
          INT result := values[ LWB values ];
          FOR pos FROM LWB values + 1 TO UPB values
          DO
              result := fn( result, values[ pos ] )
          OD;
          result
     FI; # reduce #

# test the reduce procedure #
BEGIN print( ( reduce( ( 1, 2, 3, 4, 5 ), ( INT a, b )INT: a + b ), newline ) ) # sum #
    ; print( ( reduce( ( 1, 2, 3, 4, 5 ), ( INT a, b )INT: a * b ), newline ) ) # product #
    ; print( ( reduce( ( 1, 2, 3, 4, 5 ), ( INT a, b )INT: a - b ), newline ) ) # difference #
END


---------------------- CATAMORPHISMS ---------------------

-- the arguments available to the called function f(a, x, i, l) are
-- a: current accumulator value
-- x: current item in list
-- i: [ 1-based index in list ] optional
-- l: [ a reference to the list itself ] optional

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- the arguments available to the called function f(a, x, i, l) are
-- a: current accumulator value
-- x: current item in list
-- i: [ 1-based index in list ] optional
-- l: [ a reference to the list itself ] optional

-- foldr :: (a -> b -> a) -> a -> [b] -> a
on foldr(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from lng to 1 by -1
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldr

--- OTHER FUNCTIONS DEFINED IN TERMS OF FOLDL AND FOLDR --

-- concat :: [String] -> string
on concat(xs)
    foldl(my append, "", xs)
end concat

-- product :: Num a => [a] -> a
on product(xs)
    script
        on |λ|(a, b)
            a * b
        end |λ|
    end script

    foldr(result, 1, xs)
end product

-- str :: a -> String
on str(x)
    x as string
end str

-- sum :: Num a => [a] -> a
on sum(xs)
    script
        on |λ|(a, b)
            a + b
        end |λ|
    end script

    foldl(result, 0, xs)
end sum

--------------------------- TEST -------------------------
on run
    set xs to {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}

    {sum(xs), product(xs), concat(map(str, xs))}

    --> {55, 3628800, "10987654321"}
end run

-------------------- GENERIC FUNCTIONS -------------------

-- append :: String -> String -> String
on append(a, b)
    a & b
end append

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    -- The list obtained by applying f
    -- to each element of xs.
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn


; find the sum, with seed:0 (default)
print fold [1 2 3 4] => (+)

; find the product, with seed:1
print fold [1 2 3 4] .seed:1 => (*)


arraybase 1
global n
dim n = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}

print "  +: "; " "; cat(10, "+")
print "  -: "; " "; cat(10, "-")
print "  *: "; " "; cat(10, "*")
print "  /: "; " "; cat(10, "/")
print "  ^: "; " "; cat(10, "^")
print "max: "; " "; cat(10, "max")
print "min: "; " "; cat(10, "min")
print "avg: "; " "; cat(10, "avg")
print "cat: "; " "; cat(10, "cat")
end

function min(a, b)
    if a < b then return a else return b
end function
function max(a, b)
    if a > b then return a else return b
end function

function cat(cont, op$)
    temp = n[1]
    temp$ = ""
    for i = 2 to cont
        if op$ = "+" then temp += n[i]
        if op$ = "-" then temp -= n[i]
        if op$ = "*" then temp *= n[i]
        if op$ = "/" then temp /= n[i]
        if op$ = "^" then temp = temp ^ n[i]
        if op$ = "max" then temp = max(temp, n[i])
        if op$ = "min" then temp = min(temp, n[i])
        if op$ = "avg" then temp += n[i]
        if op$ = "cat" then temp$ += string(n[i])
    next i
    if op$ = "avg" then temp /= cont
    if op$ = "cat" then temp = int(string(n[1]) + temp$)
    return temp
end function


      DIM a(4)
      a() = 1, 2, 3, 4, 5
      PRINT FNreduce(a(), "+")
      PRINT FNreduce(a(), "-")
      PRINT FNreduce(a(), "*")
      END

      DEF FNreduce(arr(), op$)
      REM!Keep tmp, arr()
      LOCAL I%, tmp
      tmp = arr(0)
      FOR I% = 1 TO DIM(arr(), 1)
        tmp = EVAL("tmp " + op$ + " arr(I%)")
      NEXT
      = tmp


get "libhdr"

let reduce(f, v, len, seed) =
    len = 0 -> seed,
    reduce(f, v+1, len-1, f(!v, seed))

let start() be
$(  let add(x, y) = x+y
    let mul(x, y) = x*y

    let nums = table 1,2,3,4,5,6,7

    writef("%N*N", reduce(add, nums, 7, 0))
    writef("%N*N", reduce(mul, nums, 7, 1))
$)


•Show +´ 30‿1‿20‿2‿10
•Show +˝ 30‿1‿20‿2‿10
•Show tab ← (2+↕5) |⌜ 9+↕3
•Show +˝ tab


( ( fold
  =   f xs init first rest
    .   !arg:(?f.?xs.?init)
      & ( !xs:&!init
        |   !xs:%?first ?rest
          & !f$(!first.fold$(!f.!rest.!init))
        )
  )
&   out
  $ ( fold
    $ ( (=a b.!arg:(?a.?b)&!a+!b)
      . 1 2 3 4 5
      . 0
      )
    )
& (product=a b.!arg:(?a.?b)&!a*!b)
& out$(fold$(product.1 2 3 4 5.1))
);


#include <stdio.h>

typedef int (*intFn)(int, int);

int reduce(intFn fn, int size, int *elms)
{
    int i, val = *elms;
    for (i = 1; i < size; ++i)
        val = fn(val, elms[i]);
    return val;
}

int add(int a, int b) { return a + b; }
int sub(int a, int b) { return a - b; }
int mul(int a, int b) { return a * b; }

int main(void)
{
    int nums[] = {1, 2, 3, 4, 5};
    printf("%d\n", reduce(add, 5, nums));
    printf("%d\n", reduce(sub, 5, nums));
    printf("%d\n", reduce(mul, 5, nums));
    return 0;
}


var nums = Enumerable.Range(1, 10);

int summation = nums.Aggregate((a, b) => a + b);

int product = nums.Aggregate((a, b) => a * b);

string concatenation = nums.Aggregate(String.Empty, (a, b) => a.ToString() + b.ToString());

Console.WriteLine("{0} {1} {2}", summation, product, concatenation);


#include <iostream>
#include <numeric>
#include <functional>
#include <vector>

int main() {
	std::vector<int> nums = { 1, 2, 3, 4, 5 };
	auto nums_added = std::accumulate(std::begin(nums), std::end(nums), 0, std::plus<int>());
	auto nums_other = std::accumulate(std::begin(nums), std::end(nums), 0, [](const int& a, const int& b) {
		return a + 2 * b;
	});
	std::cout << "nums_added: " << nums_added << std::endl;
	std::cout << "nums_other: " << nums_other << std::endl;
}


; Basic usage
> (reduce * '(1 2 3 4 5))
120
; Using an initial value
> (reduce + 100 '(1 2 3 4 5))
115


% Reduction.
% First type = sequence type (must support S$elements and yield R)
% Second type = right (input) datatype
% Third type = left (output) datatype
reduce = proc [S,R,L: type] (f: proctype (L,R) returns (L),
                             id: L,
                             seq: S)
         returns (L)
         where S has elements: itertype (S) yields (R)

    for elem: R in S$elements(seq) do
        id := f(id, elem)
    end
    return(id)
end reduce

% This is necessary to get rid of the exceptions
add = proc (a,b: int) returns (int) return (a+b) end add
mul = proc (a,b: int) returns (int) return (a*b) end mul

% Usage
start_up = proc ()
    % abbreviation - reducing int->int->int function over an array[int]
    int_reduce = reduce[array[int], int, int]

    po: stream := stream$primary_output()
    nums: array[int] := array[int]$[1,2,3,4,5,6,7,8,9,10]

    % find the sum and the product using reduce
    sum: int := int_reduce(add, 0, nums)
    product: int := int_reduce(mul, 1, nums)

    stream$putl(po, "The sum of [1..10] is: " || int$unparse(sum))
    stream$putl(po, "The product of [1..10] is: " || int$unparse(product))
end start_up


; Basic usage
> (reduce #'* '(1 2 3 4 5))
120
; Using an initial value
> (reduce #'+ '(1 2 3 4 5) :initial-value 100)
115
; Using only a subsequence
> (reduce #'+ '(1 2 3 4 5) :start 1 :end 4)
9
; Apply a function to each element first
> (reduce #'+ '((a 1) (b 2) (c 3)) :key #'cadr)
6
; Right-associative reduction
> (reduce #'expt '(2 3 4) :from-end T)
2417851639229258349412352
; Compare with
> (reduce #'expt '(2 3 4))
4096


void main() {
    import std.stdio, std.algorithm, std.range, std.meta, std.numeric,
           std.conv, std.typecons;

    auto list = iota(1, 11);
    alias ops = AliasSeq!(q{a + b}, q{a * b}, min, max, gcd);

    foreach (op; ops)
        writeln(op.stringof, ": ", list.reduce!op);

    // std.algorithm.reduce supports multiple functions in parallel:
    reduce!(ops[0], ops[3], text)(tuple(0, 0.0, ""), list).writeln;
}


$ list = "1,2,3,4,5"
$ call reduce list "+"
$ show symbol result
$
$ numbers = "5,4,3,2,1"
$ call reduce numbers "-"
$ show symbol result
$
$ call reduce list "*"
$ show symbol result
$ exit
$
$ reduce: subroutine
$ local_list = 'p1
$ value = f$integer( f$element( 0, ",", local_list ))
$ i = 1
$ loop:
$  element = f$element( i, ",", local_list )
$  if element .eqs. "," then $ goto done
$  value = value 'p2 f$integer( element )
$  i = i + 1
$  goto loop
$ done:
$ result == value
$ exit
$ endsubroutine


reduce f lst init:
	if lst:
		f reduce @f lst init pop-from lst
	else:
		init

!. reduce @+ [ 1 10 200 ] 4
!. reduce @- [ 1 10 200 ] 4


;; rem : the foldX family always need an initial value
;; fold left a list
(foldl + 0 (iota 10)) ;; 0 + 1 + .. + 9
  → 45

;; fold left a sequence
(lib 'sequences)
(foldl * 1 [ 1 .. 10])
    → 362880 ;; 10!

;; folding left and right
(foldl / 1 ' ( 1 2 3 4))
    → 8/3
(foldr / 1 '(1 2 3 4))
    → 3/8

;;scanl gives the list (or sequence) of intermediate values :
(scanl * 1 '( 1 2 3 4 5))
   → (1 1 2 6 24 120)


import system'collections;
import system'routines;
import extensions;
import extensions'text;

public program()
{
    var numbers := new Range(1,10).summarize(new ArrayList());

    var summary := numbers.accumulate(new Variable(0), (a,b => a + b));

    var product := numbers.accumulate(new Variable(1), (a,b => a * b));

    var concatenation := numbers.accumulate(new StringWriter(), (a,b => a.toPrintable() + b.toPrintable()));

    console.printLine(summary," ",product," ",concatenation)
}


-module(catamorphism).

-export([test/0]).

test() ->
	Nums = lists:seq(1,10),
	Summation =
		lists:foldl(fun(X, Acc) -> X + Acc end, 0, Nums),
	Product =
		lists:foldl(fun(X, Acc) -> X * Acc end, 1, Nums),
	Concatenation =
		lists:foldr(
			fun(X, Acc) -> integer_to_list(X) ++ Acc end,
			"",
			Nums),
	{Summation, Product, Concatenation}.


FOLDROW
=LAMBDA(op,
    LAMBDA(a,
        LAMBDA(xs,
            LET(
                b, op(a)(HEADROW(xs)),

                IF(1 < COLUMNS(xs),
                    FOLDROW(op)(b)(
                        TAILROW(xs)
                    ),
                    b
                )
            )
        )
    )
)

updatedBracketDepth
=LAMBDA(depth,
    LAMBDA(c,
        IF(0 <= depth,
            IF("[" = c,
                1 + depth,
                IF("]" = c,
                    depth - 1,
                    depth
                )
            ),
            depth
        )
    )
)

bracketCount
=LAMBDA(a,
    LAMBDA(c,
        IF(ISNUMBER(FIND(c, "[]", 1)),
            1 + a,
            a
        )
    )
)

HEADROW
=LAMBDA(xs,
    LET(REM, "The first item of each row in xs",

        INDEX(
            xs,
            SEQUENCE(ROWS(xs)),
            SEQUENCE(1, 1)
        )
    )
)

TAILROW
=LAMBDA(xs,
    LET(REM,"The tail of each row in the grid",
        n, COLUMNS(xs) - 1,

        IF(0 < n,
            INDEX(
                xs,
                SEQUENCE(ROWS(xs), 1, 1, 1),
                SEQUENCE(1, n, 2, 1)
            ),
            NA()
        )
    )
)

CHARSROW
=LAMBDA(s,
    MID(s,
        SEQUENCE(1, LEN(s), 1, 1),
        1
    )
)


> let nums = [1 .. 10];;

val nums : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]

> let summation = List.fold (+) 0 nums;;

val summation : int = 55

> let product = List.fold (*) 1 nums;;

val product : int = 3628800

> let concatenation = List.foldBack (fun x y -> x + y) (List.map (fun i -> i.ToString()) nums) "";;

val concatenation : string = "12345678910"


: lowercase? ( c -- f )
  [char] a [ char z 1+ ] literal within ;

: char-upcase ( c -- C )
  dup lowercase? if bl xor then ;


      SUBROUTINE FOLD(t,F,i,ist,lst)
       INTEGER t
       BYNAME F
        DO i = ist,lst
          t = F
        END DO
      END SUBROUTINE FOLD      !Result in temp.

      temp = a(1); CALL FOLD(temp,temp*a(i),i,2,N)


' FB 1.05.0 Win64

Type IntFunc As Function(As Integer, As Integer) As Integer

Function reduce(a() As Integer, f As IntFunc) As Integer
   '' if array is empty or function pointer is null, return 0 say
   If UBound(a) = -1 OrElse f = 0 Then Return 0
   Dim result As Integer = a(LBound(a))
   For i As Integer = LBound(a) + 1 To UBound(a)
     result = f(result, a(i))
   Next
   Return result
End Function

Function add(x As Integer, y As Integer) As Integer
  Return x + y
End Function

Function subtract(x As Integer, y As Integer) As Integer
  Return x - y
End Function

Function multiply(x As Integer, y As Integer) As Integer
  Return x * y
End Function

Function max(x As Integer, y As Integer) As Integer
  Return IIf(x > y, x, y)
End Function

Function min(x As Integer, y As Integer) As Integer
  Return IIf(x < y, x, y)
End Function

Dim a(4) As Integer = {1, 2, 3, 4, 5}
Print "Sum is        :"; reduce(a(), @add)
Print "Difference is :"; reduce(a(), @subtract)
Print "Product is    :"; reduce(a(), @multiply)
Print "Maximum is    :"; reduce(a(), @max)
Print "Minimum is    :"; reduce(a(), @min)
Print "No op is      :"; reduce(a(), 0)
Print
Print "Press any key to quit"
Sleep


package main

import (
	"fmt"
)

func main() {
	n := []int{1, 2, 3, 4, 5}

	fmt.Println(reduce(add, n))
	fmt.Println(reduce(sub, n))
	fmt.Println(reduce(mul, n))
}

func add(a int, b int) int { return a + b }
func sub(a int, b int) int { return a - b }
func mul(a int, b int) int { return a * b }

func reduce(rf func(int, int) int, m []int) int {
	r := m[0]
	for _, v := range m[1:] {
		r = rf(r, v)
	}
	return r
}


def vector1 = [1,2,3,4,5,6,7]
def vector2 = [7,6,5,4,3,2,1]
def map1 = [a:1, b:2, c:3, d:4]

println vector1.inject { acc, val -> acc + val }       // sum
println vector1.inject { acc, val -> acc + val*val }   // sum of squares
println vector1.inject { acc, val -> acc * val }       // product
println vector1.inject { acc, val -> acc<val?val:acc } // max
println ([vector1,vector2].transpose().inject(0) { acc, val -> acc + val[0]*val[1] }) //dot product (with seed 0)

println (map1.inject { Map.Entry accEntry, Map.Entry entry ->     // some sort of weird map-based reduction
    [(accEntry.key + entry.key):accEntry.value + entry.value ].entrySet().toList().pop()
})


main :: IO ()
main =
  putStrLn . unlines $
  [ show . foldr (+)    0  -- sum
  , show . foldr (*)    1  -- product
  , foldr ((++) . show) "" -- concatenation
  ] <*>
  [[1 .. 10]]


procedure main(A)
    write(A[1],": ",curry(A[1],A[2:0]))
end

procedure curry(f,A)
    r := A[1]
    every r := f(r, !A[2:0])
    return r
end


import java.util.stream.Stream;

public class ReduceTask {

    public static void main(String[] args) {
        System.out.println(Stream.of(1, 2, 3, 4, 5).mapToInt(i -> i).sum());
        System.out.println(Stream.of(1, 2, 3, 4, 5).reduce(1, (a, b) -> a * b));
    }
}


var nums = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10];

function add(a, b) {
    return a + b;
}

var summation = nums.reduce(add);

function mul(a, b) {
    return a * b;
}

var product = nums.reduce(mul, 1);

var concatenation = nums.reduce(add, "");

console.log(summation, product, concatenation);


def factorial: reduce range(2;.+1) as $i (1; . * $i);


println([reduce(op, 1:5) for op in [+, -, *]])
println([foldl(op, 1:5) for op in [+, -, *]])
println([foldr(op, 1:5) for op in [+, -, *]])


fun main(args: Array<String>) {
    val a = intArrayOf(1, 2, 3, 4, 5)
    println("Array       : ${a.joinToString(", ")}")
    println("Sum         : ${a.reduce { x, y -> x + y }}")
    println("Difference  : ${a.reduce { x, y -> x - y }}")
    println("Product     : ${a.reduce { x, y -> x * y }}")
    println("Minimum     : ${a.reduce { x, y -> if (x < y) x else y }}")
    println("Maximum     : ${a.reduce { x, y -> if (x > y) x else y }}")
}


:- object(folding_examples).

    :- public(show/0).
    show :-
        integer::sequence(1, 10, List),
        write('List: '), write(List), nl,
        meta::fold_left([Acc,N,Sum0]>>(Sum0 is Acc+N), 0, List, Sum),
        write('Sum of all elements: '), write(Sum), nl,
        meta::fold_left([Acc,N,Product0]>>(Product0 is Acc*N), 1, List, Product),
        write('Product of all elements: '), write(Product), nl,
        meta::fold_left([Acc,N,Concat0]>>(number_codes(N,NC), atom_codes(NA,NC), atom_concat(Acc,NA,Concat0)), '', List, Concat),
        write('Concatenation of all elements: '), write(Concat), nl.

:- end_object.


HAI 1.3

HOW IZ I reducin YR array AN YR size AN YR fn
    I HAS A val ITZ array'Z SRS 0
    IM IN YR LOOP UPPIN YR i TIL BOTH SAEM i AN DIFF OF size AN 1
        val R I IZ fn YR val AN YR array'Z SRS SUM OF i AN 1 MKAY
    IM OUTTA YR LOOP
    FOUND YR val
IF U SAY SO

O HAI IM array
    I HAS A SRS 0 ITZ 1
    I HAS A SRS 1 ITZ 2
    I HAS A SRS 2 ITZ 3
    I HAS A SRS 3 ITZ 4
    I HAS A SRS 4 ITZ 5
KTHX

HOW IZ I add YR a AN YR b, FOUND YR     SUM OF a AN b, IF U SAY SO
HOW IZ I sub YR a AN YR b, FOUND YR    DIFF OF a AN b, IF U SAY SO
HOW IZ I mul YR a AN YR b, FOUND YR PRODUKT OF a AN b, IF U SAY SO

VISIBLE I IZ reducin YR array AN YR 5 AN YR add MKAY
VISIBLE I IZ reducin YR array AN YR 5 AN YR sub MKAY
VISIBLE I IZ reducin YR array AN YR 5 AN YR mul MKAY

KTHXBYE


table.unpack = table.unpack or unpack -- 5.1 compatibility
local nums = {1,2,3,4,5,6,7,8,9}

function add(a,b)
   return a+b
end

function mult(a,b)
   return a*b
end

function cat(a,b)
   return tostring(a)..tostring(b)
end

local function reduce(fun,a,b,...)
   if ... then
      return reduce(fun,fun(a,b),...)
   else
      return fun(a,b)
   end
end

local arithmetic_sum = function (...) return reduce(add,...) end
local factorial5 = reduce(mult,5,4,3,2,1)

print("Σ(1..9)   : ",arithmetic_sum(table.unpack(nums)))
print("5!        : ",factorial5)
print("cat {1..9}: ",reduce(cat,table.unpack(nums)))


Module CheckIt {
      Function Reduce (a, f) {
            if len(a)=0 then Error "Nothing to reduce"
            if len(a)=1 then  =Array(a) : Exit
            k=each(a, 2, -1)
            m=Array(a)
            While k {
                  m=f(m, array(k))
            }
            =m
      }
      a=(1, 2, 3, 4, 5)
      Print "Array", a
      Print "Sum", Reduce(a, lambda (x,y)->x+y)
      Print "Difference", Reduce(a, lambda (x,y)->x-y)
      Print "Product", Reduce(a, lambda (x,y)->x*y)
      Print "Minimum", Reduce(a, lambda (x,y)->if(x<y->x, y))
      Print "Maximum", Reduce(a, lambda (x,y)->if(x>y->x, y))
}
CheckIt


> nums := seq( 1 .. 10 );
                          nums := 1, 2, 3, 4, 5, 6, 7, 8, 9, 10

> foldl( `+`, 0, nums ); # compute sum using foldl
                          55

> foldr( `*`, 1, nums ); # compute product using foldr
                          3628800


(1 2 3 4) 0 '+ reduce puts! ; sum
(1 2 3 4) 1 '* reduce puts! ; product


MODULE Catamorphism;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;

(* Alas, there are no generic types. This function works for
   CARDINAL only - you would have to copy it and change the types
   to reduce functions of other types. *)
TYPE Reduction = PROCEDURE (CARDINAL, CARDINAL): CARDINAL;
PROCEDURE reduce(func:  Reduction;
                 arr:   ARRAY OF CARDINAL;
                 first: CARDINAL): CARDINAL;
    VAR i: CARDINAL;
BEGIN
    FOR i := 0 TO HIGH(arr) DO
        first := func(first, arr[i]);
    END;
    RETURN first;
END reduce;

(* Demonstration *)
PROCEDURE add(a,b: CARDINAL): CARDINAL;
BEGIN RETURN a+b; END add;
PROCEDURE mul(a,b: CARDINAL): CARDINAL;
BEGIN RETURN a*b; END mul;

PROCEDURE Demonstration;
    VAR a: ARRAY [1..5] OF CARDINAL;
        i: CARDINAL;
BEGIN
    FOR i := 1 TO 5 DO a[i] := i; END;

    WriteString("Sum of [1..5]: ");
    WriteCard(reduce(add, a, 0), 3);
    WriteLn;
    WriteString("Product of [1..5]: ");
    WriteCard(reduce(mul, a, 1), 3);
    WriteLn;
END Demonstration;

BEGIN Demonstration;
END Catamorphism.


def seq = [1, 4, 6, 3, 7];
def sum = seq.Fold(0, _ + _); // Fold takes an initial value and a function, here the + operator


import sequtils

block:
  let
    numbers = @[5, 9, 11]
    addition = foldl(numbers, a + b)
    substraction = foldl(numbers, a - b)
    multiplication = foldl(numbers, a * b)
    words = @["nim", "is", "cool"]
    concatenation = foldl(words, a & b)

block:
  let
    numbers = @[5, 9, 11]
    addition = foldr(numbers, a + b)
    substraction = foldr(numbers, a - b)
    multiplication = foldr(numbers, a * b)
    words = @["nim", "is", "cool"]
    concatenation = foldr(words, a & b)


MODULE Catamorphism;
IMPORT
  Object,
  NPCT:Tools,
  NPCT:Args,
  IntStr,
  Out;

TYPE
  BinaryFunc= PROCEDURE (x,y: LONGINT): LONGINT;

VAR
  data: POINTER TO ARRAY OF LONGINT;
  i: LONGINT;

  PROCEDURE Sum(x,y: LONGINT): LONGINT;
  BEGIN
    RETURN x + y
  END Sum;

  PROCEDURE Sub(x,y: LONGINT): LONGINT;
  BEGIN
    RETURN x - y;
  END Sub;

  PROCEDURE Mul(x,y: LONGINT): LONGINT;
  BEGIN
    RETURN x * y;
  END Mul;

  PROCEDURE Reduce(x: ARRAY OF LONGINT; f: BinaryFunc): LONGINT;
  VAR
    i,res: LONGINT;
  BEGIN
    res := x[0];i := 1;
    WHILE (i < LEN(x)) DO;
      res := f(res,x[i]);
      INC(i)
    END;
    RETURN res
  END Reduce;

  PROCEDURE InitData(VAR x: ARRAY OF LONGINT);
  VAR
    i, j: LONGINT;
    res: IntStr.ConvResults;
    aux: Object.CharsLatin1;
  BEGIN
    i := 0;j := 1;
    WHILE (j <= LEN(x)) DO
      aux := Tools.AsString(Args.Get(j));
      IntStr.StrToInt(aux^,x[i],res);
      IF res # IntStr.strAllRight THEN
        Out.String("Incorrect format for data at index ");Out.LongInt(j,0);Out.Ln;
        HALT(1);
      END;
      INC(j);INC(i)
    END
  END InitData;

BEGIN
  IF Args.Number() = 1 THEN
    Out.String("Invalid number of arguments. ");Out.Ln;
    HALT(0)
  ELSE
    NEW(data,Args.Number() - 1);
    InitData(data^);
    Out.LongInt(Reduce(data^,Sum),0);Out.Ln;
    Out.LongInt(Reduce(data^,Sub),0);Out.Ln;
    Out.LongInt(Reduce(data^,Mul),0);Out.Ln
  END
END Catamorphism.


use Collection;

class Reducer {
  function : Main(args : String[]) ~ Nil {
    values := IntVector->New([1, 2, 3, 4, 5]);
    values->Reduce(Add(Int, Int) ~ Int)->PrintLine();
    values->Reduce(Mul(Int, Int) ~ Int)->PrintLine();
  }

  function : Add(a : Int, b : Int) ~ Int {
    return a + b;
  }

  function : Mul(a : Int, b : Int) ~ Int {
    return a * b;
  }
}


# let nums = [1;2;3;4;5;6;7;8;9;10];;
val nums : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]
# let sum = List.fold_left (+) 0 nums;;
val sum : int = 55
# let product = List.fold_left ( * ) 1 nums;;
val product : int = 3628800


program reduceApp;

type
//  tmyArray = array of LongInt;
  tmyArray = array[-5..5] of LongInt;
  tmyFunc = function (a,b:LongInt):LongInt;

function add(x,y:LongInt):LongInt;
begin
  add := x+y;
end;

function sub(k,l:LongInt):LongInt;
begin
  sub := k-l;
end;

function mul(r,t:LongInt):LongInt;
begin
  mul := r*t;
end;

function reduce(myFunc:tmyFunc;a:tmyArray):LongInt;
var
  i,res : LongInt;
begin
  res := a[low(a)];
  For i := low(a)+1 to high(a) do
    res := myFunc(res,a[i]);
  reduce := res;
end;

procedure InitMyArray(var a:tmyArray);
var
  i: LongInt;
begin
  For i := low(a) to high(a) do
  begin
    //no a[i] = 0
    a[i] := i + ord(i=0);
    write(a[i],',');
  end;
  writeln(#8#32);
end;

var
  ma : tmyArray;
BEGIN
  InitMyArray(ma);
  writeln(reduce(@add,ma));
  writeln(reduce(@sub,ma));
  writeln(reduce(@mul,ma));
END.


use List::Util 'reduce';

# note the use of the odd $a and $b globals
print +(reduce {$a + $b} 1 .. 10), "\n";

# first argument is really an anon function; you could also do this:
sub func { $b & 1 ? "$a $b" : "$b $a" }
print +(reduce \&func, 1 .. 10), "\n"


with javascript_semantics
function add(integer a, b)  return a + b  end function
function sub(integer a, b)  return a - b  end function
function mul(integer a, b)  return a * b  end function

function reduce(integer rid, sequence s)
    object res = s[1]
    for i=2 to length(s) do
        res = rid(res,s[i])
    end for
    return res
end function

?reduce(add,tagset(5))
?reduce(sub,tagset(5))
?reduce(mul,tagset(5))


include ..\Utilitys.pmt

def add + enddef
def sub - enddef
def mul * enddef

def reduce >ps
    1 get
    swap len 2 swap 2 tolist for
        get rot swap tps exec swap
    endfor
    ps> drop
    swap
enddef

( 1 2 3 4 5 )
getid add reduce ?
getid sub reduce ?
getid mul reduce ?


(de reduce ("Fun" "Lst")
   (let "A" (car "Lst")
      (for "N" (cdr "Lst")
         (setq "A" ("Fun" "A" "N")) )
      "A" ) )

(println
   (reduce + (1 2 3 4 5))
   (reduce * (1 2 3 4 5)) )

(bye)


1..5 | ForEach-Object -Begin {$result = 0} -Process {$result += $_} -End {$result}


:- use_module(library(lambda)).

catamorphism :-
	numlist(1,10,L),
	foldl(\XS^YS^ZS^(ZS is XS+YS), L, 0, Sum),
	format('Sum of ~w is ~w~n', [L, Sum]),
	foldl(\XP^YP^ZP^(ZP is XP*YP), L, 1, Prod),
	format('Prod of ~w is ~w~n', [L, Prod]),
	string_to_list(LV, ""),
	foldl(\XC^YC^ZC^(string_to_atom(XS, XC),string_concat(YC,XS,ZC)),
	      L, LV, Concat),
	format('Concat of ~w is ~w~n', [L, Concat]).


Procedure.i reduce(List l(),op$="+")
  If FirstElement(l())
    x=l()
    While NextElement(l())
      Select op$
        Case "+" : x+l()
        Case "-" : x-l()
        Case "*" : x*l()
      EndSelect
    Wend
  EndIf
  ProcedureReturn x
EndProcedure

NewList fold()
For i=1 To 5 : AddElement(fold()) : fold()=i : Next

Debug reduce(fold())
Debug reduce(fold(),"-")
Debug reduce(fold(),"*")


>>> # Python 2.X
>>> from operator import add
>>> listoflists = [['the', 'cat'], ['sat', 'on'], ['the', 'mat']]
>>> help(reduce)
Help on built-in function reduce in module __builtin__:

reduce(...)
    reduce(function, sequence[, initial]) -> value

    Apply a function of two arguments cumulatively to the items of a sequence,
    from left to right, so as to reduce the sequence to a single value.
    For example, reduce(lambda x, y: x+y, [1, 2, 3, 4, 5]) calculates
    ((((1+2)+3)+4)+5).  If initial is present, it is placed before the items
    of the sequence in the calculation, and serves as a default when the
    sequence is empty.

>>> reduce(add, listoflists, [])
['the', 'cat', 'sat', 'on', 'the', 'mat']
>>>


#lang racket
(define (fold f xs init)
  (if (empty? xs)
      init
      (f (first xs)
         (fold f (rest xs) init))))

(fold + '(1 2 3) 0)   ; the result is 6


my @list = 1..10;
say [+] @list;
say [*] @list;
say [~] @list;
say min @list;
say max @list;
say [lcm] @list;


/*REXX program demonstrates a  method  for  catamorphism  for some simple functions.    */
@list= 1 2 3 4 5 6 7 8 9 10
                                say 'list:'     fold(@list,  "list")
                                say ' sum:'     fold(@list,  "+"   )
                                say 'prod:'     fold(@list,  "*"   )
                                say ' cat:'     fold(@list,  "||"  )
                                say ' min:'     fold(@list,  "min" )
                                say ' max:'     fold(@list,  "max" )
                                say ' avg:'     fold(@list,  "avg" )
                                say ' GCD:'     fold(@list,  "GCD" )
                                say ' LCM:'     fold(@list,  "LCM" )
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fold: procedure;  parse arg z;  arg ,f;         z = space(z);      BIFs= 'MIN MAX LCM GCD'
      za= translate(z, f, ' ');                 zf= f"("translate(z, ',' , " ")')'
      if f== '+' | f=="*"       then interpret  "return"  za
      if f== '||'               then return  space(z, 0)
      if f== 'AVG'              then interpret  "return"  fold(z, '+')    "/"    words(z)
      if wordpos(f, BIFs)\==0   then interpret  "return"  zf
      if f=='LIST' | f=="SHOW"  then return z
      return 'illegal function:'     arg(2)
/*──────────────────────────────────────────────────────────────────────────────────────*/
GCD:  procedure;  $=;                          do j=1  for arg();    $= $ arg(j)
                                               end   /*j*/
      parse var $ x z .;    if x=0  then x= z                  /* [↑] build an arg list.*/
      x= abs(x)
                         do k=2  to words($);  y= abs( word($, k));   if y=0  then iterate
                           do until _=0;       _= x // y;      x= y;     y= _
                           end   /*until*/
                         end   /*k*/
      return x
/*──────────────────────────────────────────────────────────────────────────────────────*/
LCM:  procedure;  $=;    do j=1  for arg();     $= $ arg(j)
                         end   /*j*/
      x= abs(word($, 1))                                       /* [↑] build an arg list.*/
                         do k=2  to words($);   != abs(word($, k));  if !=0  then return 0
                         x= x*!  /  GCD(x, !)                  /*GCD does the heavy work*/
                         end   /*k*/
      return x


n = list(10)
for i = 1 to 10
    n[i] = i
next

see "  +: " + cat(10,"+") + nl+
    "  -: " + cat(10,"-") + nl +
    "  *: " + cat(10,"*") + nl +
    "  /: " + cat(10,"/") + nl+
    "  ^: " + cat(10,"^") + nl +
    "min: " + cat(10,"min") + nl+
    "max: " + cat(10,"max") + nl+
    "avg: " + cat(10,"avg") + nl +
    "cat: " + cat(10,"cat") + nl

func cat count,op
     cat = n[1]
     cat2 = ""
     for i = 2 to count
         switch op
                on "+" cat +=  n[i]
                on "-"  cat -=  n[i]
                on "*" cat *=  n[i]
                on "/" cat /=  n[i]
                on "^" cat ^=  n[i]
                on "max" cat = max(cat,n[i])
                on "min" cat = min(cat,n[i])
                on "avg" cat +=  n[i]
                on "cat" cat2 += string(n[i])
          off
     next
if op = "avg"  cat = cat / count ok
if op = "cat"  decimals(0) cat = string(n[1])+cat2 ok
return cat


# sum:
p (1..10).inject(:+)
# smallest number divisible by all numbers from 1 to 20:
p (1..20).inject(:lcm) #lcm: lowest common multiple


for i = 1 to 10 :n(i) = i:next i

print "  +: ";" ";cat(10,"+")
print "  -: ";" ";cat(10,"-")
print "  *: ";" ";cat(10,"*")
print "  /: ";" ";cat(10,"/")
print "  ^: ";" ";cat(10,"^")
print "min: ";" ";cat(10,"min")
print "max: ";" ";cat(10,"max")
print "avg: ";" ";cat(10,"avg")
print "cat: ";" ";cat(10,"cat")

function cat(count,op$)
cat = n(1)
for i = 2 to count
 if op$ = "+" 	then cat = cat + n(i)
 if op$ = "-" 	then cat = cat - n(i)
 if op$ = "*" 	then cat = cat * n(i)
 if op$ = "/" 	then cat = cat / n(i)
 if op$ = "^" 	then cat = cat ^ n(i)
 if op$ = "max"	then cat = max(cat,n(i))
 if op$ = "min"	then cat = min(cat,n(i))
 if op$ = "avg"	then cat = cat + n(i)
 if op$ = "cat"	then cat$ = cat$ + str$(n(i))
next i
if op$ = "avg" then cat = cat / count
if op$ = "cat" then cat = val(str$(n(1))+cat$)
end function


fn main() {
    println!("Sum: {}", (1..10).fold(0, |acc, n| acc + n));
    println!("Product: {}", (1..10).fold(1, |acc, n| acc * n));
    let chars = ['a', 'b', 'c', 'd', 'e'];
    println!("Concatenation: {}",
             chars.iter().map(|&c| (c as u8 + 1) as char).collect::<String>());
}


object Main extends App {
  val a = Seq(1, 2, 3, 4, 5)
  println(s"Array       : ${a.mkString(", ")}")
  println(s"Sum         : ${a.sum}")
  println(s"Difference  : ${a.reduce { (x, y) => x - y }}")
  println(s"Product     : ${a.product}")
  println(s"Minimum     : ${a.min}")
  println(s"Maximum     : ${a.max}")
}


(define (reduce fn init lst)
  (do ((val init (fn (car rem) val)) ; accumulated value passed as second argument
       (rem lst (cdr rem)))
    ((null? rem) val)))

(display (reduce + 0 '(1 2 3 4 5))) (newline) ; => 15
(display (reduce expt 2 '(3 4))) (newline)    ; => 262144


- val nums = [1,2,3,4,5,6,7,8,9,10];
val nums = [1,2,3,4,5,6,7,8,9,10] : int list
- val sum = foldl op+ 0 nums;
val sum = 55 : int
- val product = foldl op* 1 nums;
val product = 3628800 : int


let nums = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]

print(nums.reduce(0, +))
print(nums.reduce(1, *))
print(nums.reduce("", { $0 + String($1) }))


proc fold {lambda zero list} {
    set accumulator $zero
    foreach item $list {
	set accumulator [apply $lambda $accumulator $item]
    }
    return $accumulator
}


Push 5, 4, 3, 2, 1: s = Used() - 1
For x = 0 To s: @(x) = Pop(): Next

Print "Sum is        : "; FUNC(_reduce(0, s, _add))
Print "Difference is : "; FUNC(_reduce(0, s, _subtract))
Print "Product is    : "; FUNC(_reduce(0, s, _multiply))
Print "Maximum is    : "; FUNC(_reduce(0, s, _max))
Print "Minimum is    : "; FUNC(_reduce(0, s, _min))
Print "No op is      : "; FUNC(_reduce(0, s, _noop))
End

_reduce
  Param (3)
  Local (2)

  If (Line([email protected]) = 0) + (([email protected] - [email protected]) < 1) Then Return (0)
  [email protected] = @([email protected])
  For [email protected] = [email protected] + 1 To [email protected]
    [email protected] = FUNC([email protected] ([email protected], @([email protected])))
  Next
Return ([email protected])

_add      Param (2) : Return ([email protected] + [email protected])
_subtract Param (2) : Return ([email protected] - [email protected])
_multiply Param (2) : Return ([email protected] * [email protected])
_max      Param (2) : Return (Max([email protected], [email protected]))
_min      Param (2) : Return (Min([email protected], [email protected]))


Public Sub reduce()
    s = [{1,2,3,4,5}]
    Debug.Print WorksheetFunction.Sum(s)
    Debug.Print WorksheetFunction.Product(s)
End Sub


vfn main() {
	n := [1, 2, 3, 4, 5]

	println(reduce(add, n))
	println(reduce(sub, n))
	println(reduce(mul, n))
}

fn add(a int, b int) int { return a + b }
fn sub(a int, b int) int { return a - b }
fn mul(a int, b int) int { return a * b }

fn reduce(rf fn(int, int) int, m []int) int {
	mut r := m[0]
	for  v in m[1..] {
		r = rf(r, v)
	}
	return r
}


let a => import 'arrays';
let s => import 'stream';
let str => import 'strings';

# Sum of [1, 10]:
let nums => [1; 2; 3; 4; 5; 6; 7; 8; 9; 10];
a.stream nums -> s.reduce 0 + -- io.writeln io.stdout;

# As an alternative to an array, a range stream can be used. Here's the product of [1, 11):
s.range 1 11 -> s.reduce 1 * -- io.writeln io.stdout;

# And here's a concatenation:
s.range 1 11 -> s.reduce '' (str.format '{}{}') -- io.writeln io.stdout;


var a = [1, 2, 3, 4, 5]
var sum   = a.reduce { |acc, i| acc + i }
var prod  = a.reduce { |acc, i| acc * i }
var sumSq = a.reduce { |acc, i| acc + i*i }
System.print(a)
System.print("Sum is %(sum)")
System.print("Product is %(prod)")
System.print("Sum of squares is %(sumSq)")


10 DIM a(5)
20 FOR i=1 TO 5
30 READ a(i)
40 NEXT i
50 DATA 1,2,3,4,5
60 LET o$="+": GO SUB 1000: PRINT tmp
70 LET o$="-": GO SUB 1000: PRINT tmp
80 LET o$="*": GO SUB 1000: PRINT tmp
90 STOP
1000 REM Reduce
1010 LET tmp=a(1)
1020 FOR i=2 TO 5
1030 LET tmp=VAL ("tmp"+o$+"a(i)")
1040 NEXT i
1050 RETURN


with Ada.Containers.Vectors;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Exceptions;   use Ada.Exceptions;
with Ada.Text_IO;      use Ada.Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Sockets;          use Sockets;

procedure Chat_Server is

   package Client_Vectors is new Ada.Containers.Vectors
     (Element_Type => Socket_FD, Index_Type => Positive);
   All_Clients : Client_Vectors.Vector;

   procedure Write (S : String) is
      procedure Output (Position : Client_Vectors.Cursor) is
         Sock : Socket_FD := Client_Vectors.Element (Position);
      begin
         Put_Line (Sock, S);
      end Output;
   begin
      All_Clients.Iterate (Output'Access);
   end Write;

   task type Client_Task is
      entry Start (FD : Socket_FD);
   end Client_Task;

   task body Client_Task is
      Sock    : Socket_FD;
      Sock_ID : Positive;
      Name    : Unbounded_String;
   begin
      select
         accept Start (FD : Socket_FD) do
            Sock := FD;
         end Start;
      or
         terminate;
      end select;

      while Name = Null_Unbounded_String loop
         Put (Sock, "Enter Name:");
         Name := To_Unbounded_String (Get_Line (Sock));
      end loop;
      Write (To_String (Name) & " joined.");
      All_Clients.Append (Sock);
      Sock_ID := All_Clients.Find_Index (Sock);
      loop
         declare
            Input : String := Get_Line (Sock);
         begin
            Write (To_String (Name) & ": " & Input);
         end;
      end loop;
   exception
      when Connection_Closed =>
         Put_Line ("Connection closed");
         Shutdown (Sock, Both);
         All_Clients.Delete (Sock_ID);
         Write (To_String (Name) & " left.");
   end Client_Task;

   Accepting_Socket : Socket_FD;
   Incoming_Socket  : Socket_FD;

   type Client_Access is access Client_Task;
   Dummy : Client_Access;
begin
   if Argument_Count /= 1 then
      Raise_Exception (Constraint_Error'Identity,
                       "Usage: " & Command_Name & " port");
   end if;
   Socket (Accepting_Socket, PF_INET, SOCK_STREAM);
   Setsockopt (Accepting_Socket, SOL_SOCKET, SO_REUSEADDR, 1);
   Bind (Accepting_Socket, Positive'Value (Argument (1)));
   Listen (Accepting_Socket);
   loop
      Put_Line ("Waiting for new connection");
      Accept_Socket (Accepting_Socket, Incoming_Socket);
      Put_Line ("New connection acknowledged");

      Dummy := new Client_Task;
      Dummy.Start (Incoming_Socket);
   end loop;
end Chat_Server;


DECLARE user$ ASSOC STRING
DECLARE connect ASSOC long
OPEN "localhost:51000" FOR SERVER AS mynet
WHILE TRUE
    IF WAIT(mynet, 30) THEN
        fd = ACCEPT(mynet)
        connect(GETPEER$(fd)) = fd
        SEND "Enter your name: " TO fd
    ELSE
        FOR con$ IN OBTAIN$(connect)
            IF WAIT(connect(con$), 10) THEN
                RECEIVE in$ FROM connect(con$)
                IF user$(GETPEER$(connect(con$))) = "" THEN
                    user$(GETPEER$(connect(con$))) = CHOP$(in$)
                    chat$ = chat$ & user$(GETPEER$(connect(con$))) & " joined the chat." & NL$
                    SEND "Welcome, " & CHOP$(in$) & "!" & NL$ TO connect(con$)
                ELIF LEFT$(in$, 4) = "quit" THEN
                    SEND "You're disconnected!" & NL$ TO connect(con$)
                    chat$ = chat$ & user$(GETPEER$(connect(con$))) & " left the chat." & NL$
                    FREE user$(GETPEER$(connect(con$)))
                    FREE connect(con$)
                    CLOSE SERVER connect(con$)
                ELIF LEFT$(in$, 4) = "say " THEN
                    chat$ = chat$ & user$(GETPEER$(connect(con$))) & " said: " & MID$(in$, 5)
                ENDIF
            ENDIF
        NEXT
        IF LEN(chat$) > 0 THEN
            FOR con$ IN OBTAIN$(connect)
                IF user$(GETPEER$(connect(con$))) <> "" THEN SEND chat$ TO connect(con$)
            NEXT
            chat$ = ""
        ENDIF
    ENDIF
WEND


#include <stdio.h>
#include <stdlib.h>
#include <sys/socket.h>
#include <sys/select.h>
#include <netinet/in.h>
#include <netinet/ip.h>

int tsocket;
struct sockaddr_in tsockinfo;
fd_set status, current;
void ClientText(int handle, char *buf, int buf_len);

struct client
{
    char buffer[4096];
    int pos;
    char name[32];
} *connections[FD_SETSIZE];

void AddConnection(int handle)
{
    connections[handle] = malloc(sizeof(struct client));
    connections[handle]->buffer[0] = '\0';
    connections[handle]->pos = 0;
    connections[handle]->name[0] = '\0';
}

void CloseConnection(int handle)
{
    char buf[512];
    int j;

    FD_CLR(handle, &status);

    if (connections[handle]->name[0])
    {
        sprintf(buf, "* Disconnected: %s\r\n", connections[handle]->name);

        for (j = 0; j < FD_SETSIZE; j++)
        {
            if (handle != j && j != tsocket && FD_ISSET(j, &status))
            {
                if (write(j, buf, strlen(buf)) < 0)
                {
                    CloseConnection(j);
                }
            }
        }
    } else
    {
        printf ("-- Connection %d disconnected\n", handle);
    }
    if (connections[handle])
    {
        free(connections[handle]);
    }
    close(handle);
}

void strip(char *buf)
{
    char *x;

    x = strchr(buf, '\n');
    if (x) { *x='\0'; }
    x = strchr(buf, '\r');
    if (x) { *x='\0'; }
}

int RelayText(int handle)
{
    char *begin, *end;
    int ret = 0;
    begin = connections[handle]->buffer;
    if (connections[handle]->pos == 4000)
    {
        if (begin[3999] != '\n')
            begin[4000] = '\0';
        else {
            begin[4000] = '\n';
            begin[4001] = '\0';
        }
    } else {
        begin[connections[handle]->pos] = '\0';
    }

    end = strchr(begin, '\n');
    while (end != NULL)
    {
        char output[8000];
        output[0] = '\0';
        if (!connections[handle]->name[0])
        {
            strncpy(connections[handle]->name, begin, 31);
            connections[handle]->name[31] = '\0';

            strip(connections[handle]->name);
            sprintf(output, "* Connected: %s\r\n", connections[handle]->name);
            ret = 1;
        } else
        {
            sprintf(output, "%s: %.*s\r\n", connections[handle]->name,
                    end-begin, begin);
            ret = 1;
        }

        if (output[0])
        {
            int j;
            for (j = 0; j < FD_SETSIZE; j++)
            {
                if (handle != j && j != tsocket && FD_ISSET(j, &status))
                {
                    if (write(j, output, strlen(output)) < 0)
                    {
                        CloseConnection(j);
                    }
                }
            }
        }
        begin = end+1;
        end = strchr(begin, '\n');
    }

    strcpy(connections[handle]->buffer, begin);
    connections[handle]->pos -= begin - connections[handle]->buffer;
    return ret;
}

void ClientText(int handle, char *buf, int buf_len)
{
    int i, j;
    if (!connections[handle])
        return;
    j = connections[handle]->pos;

    for (i = 0; i < buf_len; ++i, ++j)
    {
        connections[handle]->buffer[j] = buf[i];

        if (j == 4000)
        {
            while (RelayText(handle));
            j = connections[handle]->pos;
        }
    }
    connections[handle]->pos = j;

    while (RelayText(handle));
}

int ChatLoop()
{
    int i, j;
    FD_ZERO(&status);

    FD_SET(tsocket, &status);
    FD_SET(0, &status);

    while(1)
    {
        current = status;
        if (select(FD_SETSIZE, &current, NULL, NULL, NULL)==-1)
        {
            perror("Select");
            return 0;
        }
        for (i = 0; i < FD_SETSIZE; ++i)
        {
            if (FD_ISSET(i, &current))
            {
                if (i == tsocket)
                {
                    struct sockaddr_in cliinfo;
                    socklen_t addrlen = sizeof(cliinfo);
                    int handle;
                    handle = accept(tsocket, &cliinfo, &addrlen);
                    if (handle == -1)
                    {
                        perror ("Couldn't accept connection");
                    } else if (handle > FD_SETSIZE)
                    {
                        printf ("Unable to accept new connection.\n");
                        close(handle);
                    }
                    else
                    {
                        if (write(handle, "Enter name: ", 12) >= 0)
                        {
                            printf("-- New connection %d from %s:%hu\n",
                                handle,
                                inet_ntoa (cliinfo.sin_addr),
                                ntohs(cliinfo.sin_port));
                            FD_SET(handle, &status);

                            AddConnection(handle);
                        }
                    }
                } /* Read data, relay to others. */
                else
                {
                    char buf[512];
                    int b;

                    b = read(i, buf, 500);
                    if (b <= 0)
                    {
                        CloseConnection(i);
                    }
                    else
                    {
                        ClientText(i, buf, b);
                    }
                }
            }
        }
    } /* While 1 */
}

int main (int argc, char*argv[])
{
    tsocket = socket(PF_INET, SOCK_STREAM, 0);

    tsockinfo.sin_family = AF_INET;
    tsockinfo.sin_port = htons(7070);
    if (argc > 1)
    {
        tsockinfo.sin_port = htons(atoi(argv[1]));
    }
    tsockinfo.sin_addr.s_addr = htonl(INADDR_ANY);
    printf ("Socket %d on port %hu\n", tsocket, ntohs(tsockinfo.sin_port));

    if (bind(tsocket, &tsockinfo, sizeof(tsockinfo)) == -1)
    {
        perror("Couldn't bind socket");
        return -1;
    }

    if (listen(tsocket, 10) == -1)
    {
        perror("Couldn't listen to port");
    }

    ChatLoop();

    return 0;
}


using System;
using System.Collections.Generic;
using System.Net.Sockets;
using System.Text;
using System.Threading;

namespace ChatServer {
    class State {
        private TcpClient client;
        private StringBuilder sb = new StringBuilder();

        public string Name { get; }

        public State(string name, TcpClient client) {
            Name = name;
            this.client = client;
        }

        public void Add(byte b) {
            sb.Append((char)b);
        }

        public void Send(string text) {
            var bytes = Encoding.ASCII.GetBytes(string.Format("{0}\r\n", text));
            client.GetStream().Write(bytes, 0, bytes.Length);
        }
    }

    class Program {
        static TcpListener listen;
        static Thread serverthread;
        static Dictionary<int, State> connections = new Dictionary<int, State>();

        static void Main(string[] args) {
            listen = new TcpListener(System.Net.IPAddress.Parse("127.0.0.1"), 4004);
            serverthread = new Thread(new ThreadStart(DoListen));
            serverthread.Start();
        }

        private static void DoListen() {
            // Listen
            listen.Start();
            Console.WriteLine("Server: Started server");

            while (true) {
                Console.WriteLine("Server: Waiting...");
                TcpClient client = listen.AcceptTcpClient();
                Console.WriteLine("Server: Waited");

                // New thread with client
                Thread clientThread = new Thread(new ParameterizedThreadStart(DoClient));
                clientThread.Start(client);
            }
        }

        private static void DoClient(object client) {
            // Read data
            TcpClient tClient = (TcpClient)client;

            Console.WriteLine("Client (Thread: {0}): Connected!", Thread.CurrentThread.ManagedThreadId);
            byte[] bytes = Encoding.ASCII.GetBytes("Enter name: ");
            tClient.GetStream().Write(bytes, 0, bytes.Length);

            string name = string.Empty;
            bool done = false;
            do {
                if (!tClient.Connected) {
                    Console.WriteLine("Client (Thread: {0}): Terminated!", Thread.CurrentThread.ManagedThreadId);
                    tClient.Close();
                    Thread.CurrentThread.Abort();       // Kill thread.
                }

                name = Receive(tClient);
                done = true;

                if (done) {
                    foreach (var cl in connections) {
                        var state = cl.Value;
                        if (state.Name == name) {
                            bytes = Encoding.ASCII.GetBytes("Name already registered. Please enter your name: ");
                            tClient.GetStream().Write(bytes, 0, bytes.Length);
                            done = false;
                        }
                    }
                }
            } while (!done);

            connections.Add(Thread.CurrentThread.ManagedThreadId, new State(name, tClient));
            Console.WriteLine("\tTotal connections: {0}", connections.Count);
            Broadcast(string.Format("+++ {0} arrived +++", name));

            do {
                string text = Receive(tClient);
                if (text == "/quit") {
                    Broadcast(string.Format("Connection from {0} closed.", name));
                    connections.Remove(Thread.CurrentThread.ManagedThreadId);
                    Console.WriteLine("\tTotal connections: {0}", connections.Count);
                    break;
                }

                if (!tClient.Connected) {
                    break;
                }
                Broadcast(string.Format("{0}> {1}", name, text));
            } while (true);

            Console.WriteLine("Client (Thread: {0}): Terminated!", Thread.CurrentThread.ManagedThreadId);
            tClient.Close();
            Thread.CurrentThread.Abort();
        }

        private static string Receive(TcpClient client) {
            StringBuilder sb = new StringBuilder();
            do {
                if (client.Available > 0) {
                    while (client.Available > 0) {
                        char ch = (char)client.GetStream().ReadByte();
                        if (ch == '\r') {
                            //ignore
                            continue;
                        }
                        if (ch == '\n') {
                            return sb.ToString();
                        }
                        sb.Append(ch);
                    }
                }

                // Pause
                Thread.Sleep(100);
            } while (true);
        }

        private static void Broadcast(string text) {
            Console.WriteLine(text);
            foreach (var oClient in connections) {
                if (oClient.Key != Thread.CurrentThread.ManagedThreadId) {
                    State state = oClient.Value;
                    state.Send(text);
                }
            }
        }
    }
}


net = require("net")
sys = require("sys")
EventEmitter = require("events").EventEmitter

isNicknameLegal = (nickname) ->
  return false unless nickname.replace(/[A-Za-z0-9]*/, "") is ""
  for used_nick of @chatters
    return false if used_nick is nickname
  true

class ChatServer
  constructor: ->
    @chatters = {}
    @server = net.createServer @handleConnection
    @server.listen 1212, "localhost"

  handleConnection: (connection) =>
    console.log "Incoming connection from " + connection.remoteAddress
    connection.setEncoding "utf8"
    chatter = new Chatter(connection, this)
    chatter.on "chat", @handleChat
    chatter.on "join", @handleJoin
    chatter.on "leave", @handleLeave

  handleChat: (chatter, message) =>
    @sendToEveryChatterExcept chatter, chatter.nickname + ": " + message

  handleJoin: (chatter) =>
    console.log chatter.nickname + " has joined the chat."
    @sendToEveryChatter chatter.nickname + " has joined the chat."
    @addChatter chatter

  handleLeave: (chatter) =>
    console.log chatter.nickname + " has left the chat."
    @removeChatter chatter
    @sendToEveryChatter chatter.nickname + " has left the chat."

  addChatter: (chatter) =>
    @chatters[chatter.nickname] = chatter

  removeChatter: (chatter) =>
    delete @chatters[chatter.nickname]

  sendToEveryChatter: (data) =>
    for nickname of @chatters
      @chatters[nickname].send data

  sendToEveryChatterExcept: (chatter, data) =>
    for nickname of @chatters
      @chatters[nickname].send data  unless nickname is chatter.nickname

class Chatter extends EventEmitter
  constructor: (socket, server) ->
    EventEmitter.call this
    @socket = socket
    @server = server
    @nickname = ""
    @lineBuffer = new SocketLineBuffer(socket)
    @lineBuffer.on "line", @handleNickname
    @socket.on "close", @handleDisconnect
    @send "Welcome! What is your nickname?"

  handleNickname: (nickname) =>
    if isNicknameLegal(nickname)
      @nickname = nickname
      @lineBuffer.removeAllListeners "line"
      @lineBuffer.on "line", @handleChat
      @send "Welcome to the chat, " + nickname + "!"
      @emit "join", this
    else
      @send "Sorry, but that nickname is not legal or is already in use!"
      @send "What is your nickname?"

  handleChat: (line) =>
    @emit "chat", this, line

  handleDisconnect: =>
    @emit "leave", this

  send: (data) =>
    @socket.write data + "\r\n"

class SocketLineBuffer extends EventEmitter
  constructor: (socket) ->
    EventEmitter.call this
    @socket = socket
    @buffer = ""
    @socket.on "data", @handleData

  handleData: (data) =>
    console.log "Handling data", data
    i = 0

    while i < data.length
      char = data.charAt(i)
      @buffer += char
      if char is "\n"
        @buffer = @buffer.replace("\r\n", "")
        @buffer = @buffer.replace("\n", "")
        @emit "line", @buffer
        console.log "incoming line: #{@buffer}"
        @buffer = ""
      i++

server = new ChatServer()


import std.getopt;
import std.socket;
import std.stdio;
import std.string;

struct client {
    int pos;
    char[] name;
    char[] buffer;
    Socket socket;
}

void broadcast(client[] connections, size_t self, const char[] message) {
    writeln(message);
    for (size_t i = 0; i < connections.length; i++) {
        if (i == self) continue;

        connections[i].socket.send(message);
        connections[i].socket.send("\r\n");
    }
}

bool registerClient(client[] connections, size_t self) {
    for (size_t i = 0; i < connections.length; i++) {
        if (i == self) continue;

        if (icmp(connections[i].name, connections[self].name) == 0) {
            return false;
        }
    }

    return true;
}

void main(string[] args) {
    ushort port = 4004;

    auto helpInformation = getopt
    (
        args,
        "port|p", "The port to listen to chat clients on [default is 4004]", &port
    );

    if (helpInformation.helpWanted) {
        defaultGetoptPrinter("A simple chat server based on a task in rosettacode.", helpInformation.options);
        return;
    }

    auto listener = new TcpSocket();
    assert(listener.isAlive);
    listener.blocking = false;
    listener.bind(new InternetAddress(port));
    listener.listen(10);
    writeln("Listening on port: ", port);

    enum MAX_CONNECTIONS = 60;
    auto socketSet = new SocketSet(MAX_CONNECTIONS + 1);
    client[] connections;

    while(true) {
        socketSet.add(listener);

        foreach (con; connections) {
            socketSet.add(con.socket);
        }

        Socket.select(socketSet, null, null);

        for (size_t i = 0; i < connections.length; i++) {
            if (socketSet.isSet(connections[i].socket)) {
                char[1024] buf;
                auto datLength = connections[i].socket.receive(buf[]);

                if (datLength == Socket.ERROR) {
                    writeln("Connection error.");
                } else if (datLength != 0) {
                    if (buf[0] == '\n' || buf[0] == '\r') {
                        if (connections[i].buffer == "/quit") {
                            connections[i].socket.close();
                            if (connections[i].name.length > 0) {
                                writeln("Connection from ", connections[i].name, " closed.");
                            } else {
                                writeln("Connection from ", connections[i].socket.remoteAddress(), " closed.");
                            }

                            connections[i] = connections[$-1];
                            connections.length--;
                            i--;

                            writeln("\tTotal connections: ", connections.length);
                            continue;
                        } else if (connections[i].name.length == 0) {
                            connections[i].buffer = strip(connections[i].buffer);
                            if (connections[i].buffer.length > 0) {
                                connections[i].name = connections[i].buffer;
                                if (registerClient(connections, i)) {
                                    connections.broadcast(i, "+++ " ~ connections[i].name ~ " arrived +++");
                                } else {
                                    connections[i].socket.send("Name already registered. Please enter your name: ");
                                    connections[i].name.length = 0;
                                }
                            } else {
                                connections[i].socket.send("A name is required. Please enter your name: ");
                            }
                        } else {
                            connections.broadcast(i, connections[i].name ~ "> " ~ connections[i].buffer);
                        }
                        connections[i].buffer.length = 0;
                    } else {
                        connections[i].buffer ~= buf[0..datLength];
                    }
                } else {
                    try {
                        if (connections[i].name.length > 0) {
                            writeln("Connection from ", connections[i].name, " closed.");
                        } else {
                            writeln("Connection from ", connections[i].socket.remoteAddress(), " closed.");
                        }
                    } catch (SocketException) {
                        writeln("Connection closed.");
                    }
                }
            }
        }

        if (socketSet.isSet(listener)) {
            Socket sn = null;
            scope(failure) {
                writeln("Error accepting");

                if (sn) {
                    sn.close();
                }
            }
            sn = listener.accept();
            assert(sn.isAlive);
            assert(listener.isAlive);

            if (connections.length < MAX_CONNECTIONS) {
                client newclient;

                writeln("Connection from ", sn.remoteAddress(), " established.");
                sn.send("Enter name: ");

                newclient.socket = sn;
                connections ~= newclient;

                writeln("\tTotal connections: ", connections.length);
            } else {
                writeln("Rejected connection from ", sn.remoteAddress(), "; too many connections.");
                sn.close();
                assert(!sn.isAlive);
                assert(listener.isAlive);
            }
        }

        socketSet.reset();
    }
}


(ql:quickload '(:usocket :simple-actors :bordeaux-threads))

(defpackage :chat-server
  (:use :common-lisp :usocket :simple-actors :bordeaux-threads)
  (:export :accept-connections))

(in-package :chat-server)

(defvar *whitespace* '(#\Space #\Tab #\Page #\Vt #\Newline #\Return))

(defun send-message (users from-user message)
  (loop for (nil . actor) in users
     do (send actor :message from-user message)))

(defun socket-format (socket format-control &rest format-arguments)
  (apply #'format (socket-stream socket) format-control format-arguments)
  (finish-output (socket-stream socket)))

(defvar *log* *standard-output*)

(defmacro log-errors (&body body)
  `(handler-case
       (progn ,@body)
     (t (err)
       (format *log* "Error: ~a" err))))

(defparameter *user-manager*
  (let ((users nil))
    (actor (action &rest args)
       (format *log* "Handling message ~s~%" (cons action args))
       (ecase action
	 (:newuser
	  (destructuring-bind (username session-actor)
	      args
	    (cond ((assoc username users :test #'equalp)
		   (send session-actor :rejected
			 (format nil "Username ~a is already taken. Send /NICK new-nick with a valid name to enter the chat~%" username)))
		  ((equalp username "Server")
		   (send session-actor :rejected
			 (format nil "Server is not a valid username. Send /NICK new-nick with a valid name to enter the chat~%")))
		  (t (send-message users "Server" (format nil "~a has joined the chat." username))
		     (send session-actor :accepted
			   (format nil "Welcome to the Rosetta Code chat server in Common Lisp. ~a users connected.~%"
				   (length users)))
		     (pushnew (cons username session-actor)
			      users
			      :key #'car
			      :test #'equalp)))))
	 (:who
	  (destructuring-bind (username) args
	    (let ((actor (cdr (assoc username users :test #'equalp))))
	      (send actor :message "Server"
		    "Users connected right now:")
	      (loop for (user . nil) in users
		   do (send actor :message "Server" user)))))
	 (:message
	  (apply #'send-message users args))
	 (:dropuser
	  (destructuring-bind (username) args
	    (let ((user-actor (cdr (assoc username users :test #'equalp))))
	      (send user-actor :close)
	      (send user-actor 'stop))
	    (setf users (remove username users
				:key #'car
				:test #'equalp))
	    (send-message users "Server" (format nil "~a has left." username))))))))

(defmacro drop-connection-on-error (&body body)
  `(handler-case (progn ,@body)
     (t (err)
       (format *log* "Error: ~a; Closing connection" err)
       (send self :close)
       (send self 'stop)
       (send *user-manager* :dropuser username))))

(defun parse-command (message)
  (let* ((space-at (position #\Space message))
	 (after-space (and space-at
			   (position-if (lambda (ch)
				     (not (char= ch #\Space)))
					message :start (1+ space-at)))))
    (values (subseq message 0 space-at)
	    (and after-space
		 (string-trim *whitespace*
			      (subseq message after-space))))))

(defun help (socket)
  (socket-format socket "/QUIT to quit, /WHO to list users.~%"))

(defun make-user (username socket)
  (let* ((state :unregistered)
	 (actor
	  (actor (message &rest args)
	    (drop-connection-on-error
	      (ecase message
		(:register
		 (send *user-manager* :newuser username self))
		(:accepted
		 (destructuring-bind (message) args
		   (write-string message (socket-stream socket))
		   (finish-output (socket-stream socket))
		   (setf state :registered)))
		(:rejected
		 (destructuring-bind (message) args
		   (write-string message (socket-stream socket))
		   (finish-output (socket-stream socket))
		   (setf state :unregistered)))
		(:user-typed
		 (destructuring-bind (message) args
		   (when (> (length message) 0)
		     (if (char= (aref message 0) #\/)
			 (multiple-value-bind (cmd arg)
			     (parse-command message)
			   (cond ((equalp cmd "/nick")
				  (ecase state
				    (:unregistered
				     (setf username arg)
				     (send *user-manager* :newuser username self))
				    (:registered
				     (socket-format socket
						    "Can't change your name after successfully registering~%"))))
				 ((equalp cmd "/help")
				  (help socket))
				 ((equalp cmd "/who")
				  (send *user-manager* :who username))
				 ((equalp cmd "/quit")
				  (socket-format socket
					  "Goodbye.~%")
				  (send *user-manager* :dropuser username))
				 (t
				  (socket-format socket
					  "Unknown command~%"))))
			 (send *user-manager* :message username message)))))
		(:message
		 (destructuring-bind (from-user message) args
		   (socket-format socket "<~a> ~a~%" from-user message)))
		(:close
		 (log-errors
		   (close (socket-stream socket)))))))))
    (bt:make-thread (lambda ()
		      (handler-case
			  (loop for line = (read-line (socket-stream socket) nil :eof)
			     do (if (eq line :eof)
				    (send *user-manager* :dropuser username)
				    (send actor :user-typed (remove #\Return line))))
			(t () (send *user-manager* :dropuser username))))

		    :name "Reader thread")
    actor))

(defun initialize-user (socket)
  (bt:make-thread
   (lambda ()
     (format *log* "Handling new connection ~s" socket)
     (log-errors
       (loop do
	    (socket-format socket "Your name: ")
	    (let ((name (string-trim *whitespace* (read-line (socket-stream socket)))))
	      (format *log* "Registering user ~a" name)
	      (cond ((equalp name "Server")
		     (socket-format socket
				    "Server is not a valid username.~%"))
		    (t (send *user-manager*
			     :newuser name (make-user name socket))
		       (return)))))))
   :name "INITIALIZE-USER"))

(defun accept-connections ()
  (let ((accepting-socket (socket-listen "0.0.0.0" 7070)))
    (loop for new-connection = (socket-accept accepting-socket)
	 do (initialize-user new-connection))))

(make-thread #'accept-connections)


-module(chat).

-export([start/0, start/1]).

-record(client, {name=none, socket=none}).

start() -> start(8080).
start(Port) ->
    register(server, spawn(fun() -> server() end)),
    {ok, LSocket} = gen_tcp:listen(Port, [binary, {packet, 0}, {active, false}, {reuseaddr, true}]),
    accept(LSocket).

% main loop for message dispatcher
server() -> server([]).
server(Clients) ->
    receive
        {join, Client=#client{name = Name, socket = Socket}} ->
            self() ! {say, Socket, "has joined." ++ [10, 13]},
            server(Clients ++ [Client]);
        {leave, Socket} ->
            {value, #client{name = Name}, List} = lists:keytake(Socket, 3, Clients),
            self() ! {say, none, Message = "has left."},
            server(List);
        {say, Socket, Data} ->
            {value, #client{name = From}, List} = lists:keytake(Socket, 3, Clients),
            Message = From ++ " : " ++ Data,
            lists:map(fun(#client{socket = S}) ->
                    gen_tcp:send(S, Message)
                end, List)
    end,
    server(Clients).

% accepts connections then spawns the client handler
accept(LSocket) ->
    {ok, Socket} = gen_tcp:accept(LSocket),
    spawn(fun() -> connecting(Socket) end),
    accept(LSocket).

% when client is first connect send prompt for user name
connecting(Socket) ->
    gen_tcp:send(Socket, "What is your name? "),
    case listen(Socket) of
        {ok, N} ->
            Name = binary_to_list(N),
            server ! {join, #client{name =  lists:sublist(Name, 1, length(Name) - 2), socket = Socket} },
            client(Socket);
        _ -> ok
    end.

% main client loop that listens for data
client(Socket) ->
    case listen(Socket) of
        {ok, Data} ->
            server ! {say, Socket, binary_to_list(Data)},
            client(Socket);
        _ -> server ! {leave, Socket}
    end.

% utility function that listens for data on a socket
listen(Socket) ->
    case gen_tcp:recv(Socket, 0) of
        Response -> Response
    end.


package main

import (
	"bufio"
	"flag"
	"fmt"
	"log"
	"net"
	"strings"
	"time"
)

func main() {
	log.SetPrefix("chat: ")
	addr := flag.String("addr", "localhost:4000", "listen address")
	flag.Parse()
	log.Fatal(ListenAndServe(*addr))
}

// A Server represents a chat server that accepts incoming connections.
type Server struct {
	add  chan *conn  // To add a connection
	rem  chan string // To remove a connection by name
	msg  chan string // To send a message to all connections
	stop chan bool   // To stop early
}

// ListenAndServe listens on the TCP network address addr for
// new chat client connections.
func ListenAndServe(addr string) error {
	ln, err := net.Listen("tcp", addr)
	if err != nil {
		return err
	}
	log.Println("Listening for connections on", addr)
	defer ln.Close()
	s := &Server{
		add:  make(chan *conn),
		rem:  make(chan string),
		msg:  make(chan string),
		stop: make(chan bool),
	}
	go s.handleConns()
	for {
		// TODO use AcceptTCP() so that we can get a TCPConn on which
		// we can call SetKeepAlive() and SetKeepAlivePeriod()
		rwc, err := ln.Accept()
		if err != nil {
			// TODO Could handle err.(net.Error).Temporary()
			// here by adding a backoff delay.
			close(s.stop)
			return err
		}
		log.Println("New connection from", rwc.RemoteAddr())
		go newConn(s, rwc).welcome()
	}
}

// handleConns is run as a go routine to handle adding and removal of
// chat client connections as well as broadcasting messages to them.
func (s *Server) handleConns() {
	// We define the `conns` map here rather than within Server,
	// and we use local function literals rather than methods to be
	// extra sure that the only place that touches this map is this
	// method. In this way we forgo any explicit locking needed as
	// we're the only go routine that can see or modify this.
	conns := make(map[string]*conn)

	var dropConn func(string)
	writeAll := func(str string) {
		log.Printf("Broadcast: %q", str)
		// TODO handle blocked connections
		for name, c := range conns {
			c.SetWriteDeadline(time.Now().Add(500 * time.Millisecond))
			_, err := c.Write([]byte(str))
			if err != nil {
				log.Printf("Error writing to %q: %v", name, err)
				c.Close()
				delete(conns, name)
				// Defer all the disconnect messages until after
				// we've closed all currently problematic conns.
				defer dropConn(name)
			}
		}
	}

	dropConn = func(name string) {
		if c, ok := conns[name]; ok {
			log.Printf("Closing connection with %q from %v",
				name, c.RemoteAddr())
			c.Close()
			delete(conns, name)
		} else {
			log.Printf("Dropped connection with %q", name)
		}
		str := fmt.Sprintf("--- %q disconnected ---\n", name)
		writeAll(str)
	}

	defer func() {
		writeAll("Server stopping!\n")
		for _, c := range conns {
			c.Close()
		}
	}()

	for {
		select {
		case c := <-s.add:
			if _, exists := conns[c.name]; exists {
				fmt.Fprintf(c, "Name %q is not available\n", c.name)
				go c.welcome()
				continue
			}
			str := fmt.Sprintf("+++ %q connected +++\n", c.name)
			writeAll(str)
			conns[c.name] = c
			go c.readloop()
		case str := <-s.msg:
			writeAll(str)
		case name := <-s.rem:
			dropConn(name)
		case <-s.stop:
			return
		}
	}
}

// A conn represents the server side of a single chat connection.
// Note we embed the bufio.Reader and net.Conn (and specifically in
// that order) so that a conn gets the appropriate methods from each
// to be a full io.ReadWriteCloser.
type conn struct {
	*bufio.Reader         // buffered input
	net.Conn              // raw connection
	server        *Server // the Server on which the connection arrived
	name          string
}

func newConn(s *Server, rwc net.Conn) *conn {
	return &conn{
		Reader: bufio.NewReader(rwc),
		Conn:   rwc,
		server: s,
	}
}

// welcome requests a name from the client before attempting to add the
// named connect to the set handled by the server.
func (c *conn) welcome() {
	var err error
	for c.name = ""; c.name == ""; {
		fmt.Fprint(c, "Enter your name: ")
		c.name, err = c.ReadString('\n')
		if err != nil {
			log.Printf("Reading name from %v: %v", c.RemoteAddr(), err)
			c.Close()
			return
		}
		c.name = strings.TrimSpace(c.name)
	}
	// The server will take this *conn and do a final check
	// on the name, possibly starting c.welcome() again.
	c.server.add <- c
}

// readloop is started as a go routine by the server once the initial
// welcome phase has completed successfully. It reads single lines from
// the client and passes them to the server for broadcast to all chat
// clients (including us).
// Once done, we ask the server to remove (and close) our connection.
func (c *conn) readloop() {
	for {
		msg, err := c.ReadString('\n')
		if err != nil {
			break
		}
		//msg = strings.TrimSpace(msg)
		c.server.msg <- c.name + "> " + msg
	}
	c.server.rem <- c.name
}


class ChatServer implements Runnable {
    private int port = 0
    private List<Client> clientList = new ArrayList<>()

    ChatServer(int port) {
        this.port = port
    }

    @SuppressWarnings("GroovyInfiniteLoopStatement")
    @Override
    void run() {
        try {
            ServerSocket serverSocket = new ServerSocket(port)
            while (true) {
                Socket socket = serverSocket.accept()
                new Thread(new Client(socket)).start()
            }
        } catch (Exception e) {
            e.printStackTrace()
        }
    }

    private synchronized boolean registerClient(Client client) {
        for (Client other : clientList) {
            if (other.clientName.equalsIgnoreCase(client.clientName)) {
                return false
            }
        }
        clientList.add(client)
        return true
    }

    private void deRegisterClient(Client client) {
        boolean wasRegistered
        synchronized (this) {
            wasRegistered = clientList.remove(client)
        }
        if (wasRegistered) {
            broadcast(client, "--- " + client.clientName + " left ---")
        }
    }

    private synchronized String getOnlineListCSV() {
        StringBuilder sb = new StringBuilder()
        sb.append(clientList.size()).append(" user(s) online: ")
        def it = clientList.iterator()
        if (it.hasNext()) {
            sb.append(it.next().clientName)
        }
        while (it.hasNext()) {
            sb.append(", ")
            sb.append(it.next().clientName)
        }
        return sb.toString()
    }

    private void broadcast(Client fromClient, String msg) {
        // Copy client list (don't want to hold lock while doing IO)
        List<Client> clients
        synchronized (this) {
            clients = new ArrayList<>(this.clientList)
        }
        for (Client client : clients) {
            if (client == fromClient) {
                continue
            }
            try {
                client.write(msg + "\r\n")
            } catch (Exception ignored) {
                // empty
            }
        }
    }

    class Client implements Runnable {
        private Socket socket = null
        private Writer output = null
        private String clientName = null

        Client(Socket socket) {
            this.socket = socket
        }

        @Override
        void run() {
            try {
                socket.setSendBufferSize(16384)
                socket.setTcpNoDelay(true)
                BufferedReader input = new BufferedReader(new InputStreamReader(socket.getInputStream()))
                output = new OutputStreamWriter(socket.getOutputStream())
                write("Please enter your name: ")
                String line
                while (null != (line = input.readLine())) {
                    if (null == clientName) {
                        line = line.trim()
                        if (line.isEmpty()) {
                            write("A name is required. Please enter your name: ")
                            continue
                        }
                        clientName = line
                        if (!registerClient(this)) {
                            clientName = null
                            write("Name already registered. Please enter your name: ")
                            continue
                        }
                        write(getOnlineListCSV() + "\r\n")
                        broadcast(this, "+++ " + clientName + " arrived +++")
                        continue
                    }
                    if (line.equalsIgnoreCase("/quit")) {
                        return
                    }
                    broadcast(this, clientName + "> " + line)
                }
            } catch (Exception ignored) {
                // empty
            } finally {
                deRegisterClient(this)
                output = null
                try {
                    socket.close()
                } catch (Exception ignored) {
                    // empty
                }
                socket = null
            }
        }

        void write(String msg) {
            output.write(msg)
            output.flush()
        }

        @Override
        boolean equals(client) {
            return (null != client) && (client instanceof Client) && (null != clientName) && clientName == client.clientName
        }

        @Override
        int hashCode() {
            int result
            result = (socket != null ? socket.hashCode() : 0)
            result = 31 * result + (output != null ? output.hashCode() : 0)
            result = 31 * result + (clientName != null ? clientName.hashCode() : 0)
            return result
        }
    }

    static void main(String[] args) {
        int port = 4004
        if (args.length > 0) {
            port = Integer.parseInt(args[0])
        }
        new ChatServer(port).run()
    }
}


{-# LANGUAGE OverloadedStrings #-}
import Network
import System.IO
import Control.Concurrent
import qualified Data.Text as T
import Data.Text (Text)
import qualified Data.Text.IO as T
import qualified Data.Map as M
import Data.Map (Map)
import Control.Monad.Reader
import Control.Monad.Error
import Control.Exception
import Data.Monoid
import Control.Applicative

type ServerApp = ReaderT ThreadData IO
data Speaker = Server | Client Text
data ThreadData = ThreadData { threadHandle :: Handle
                             , userTableMV :: MVar (Map Text Handle)}

echoLocal = liftIO . T.putStrLn
echoRemote = echoMessage . (">> "<>)
echoMessage msg = viewHandle >>= \h -> liftIO $ T.hPutStrLn h msg
getRemoteLine = viewHandle >>= liftIO . T.hGetLine
putMVarT = (liftIO.) . putMVar
takeMVarT = liftIO . takeMVar
readMVarT = liftIO . readMVar
modifyUserTable fn = viewUsers >>= \mv ->
                     liftIO $ modifyMVar_ mv (return . fn)
viewHandle = threadHandle <$> ask
viewUsers = userTableMV <$> ask

userChat :: ServerApp ()
userChat = do
    name <- addUser
    echoLocal name
    h <- viewHandle
    (flip catchError) (\_ -> removeUser name) $
      do echoLocal $ "Accepted " <> name
         forever $ getRemoteLine >>= broadcast (Client name)

removeUser :: Text -> ServerApp ()
removeUser name = do
    echoLocal $ "Exception with " <> name <> ", removing from userTable"
    broadcast Server $ name <> " has left the server"
    modifyUserTable (M.delete name)

addUser :: ServerApp Text
addUser = do
    h <- viewHandle
    usersMV <- viewUsers
    echoRemote "Enter username"
    name <- T.filter (/='\r') <$> getRemoteLine
    userTable <- takeMVarT usersMV
    if name `M.member` userTable
      then do echoRemote "Username already exists!"
              putMVarT usersMV userTable
              addUser
      else do putMVarT usersMV (M.insert name h userTable)
              broadcast Server $ name <> " has joined the server"
              echoRemote "Welcome to the server!\n>> Other users:"
              readMVarT usersMV >>=
                  mapM_ (echoRemote . ("*" <>) . fst)
                . filter ((/=name). fst) . M.toList
              return name

broadcast :: Speaker -> Text -> ServerApp ()
broadcast user msg =
    viewUsers >>= readMVarT >>= mapM_ (f . snd) . fn . M.toList
  where f h = liftIO $ T.hPutStrLn h $ nm <> msg
        (fn, nm) = case user of
                    Server -> (id, ">> ")
                    Client t -> (filter ((/=t) . fst), t <> "> ")

clientLoop socket users = do
    (h, _, _) <- accept socket
    hSetBuffering h LineBuffering
    forkIO $ runReaderT userChat (ThreadData h users)
    clientLoop socket users

main = do
    server <- listenOn $ PortNumber 5002
    T.putStrLn "Server started"
    newMVar (M.empty) >>= clientLoop server


global mlck, nCons, cons

procedure main()
    mlck := mutex()
    nCons := 0
    cons := mutex(set())
    while f := open(":12321","na") do {
        handle_client(f)
        critical mlck: if nCons <= 0 then close(f)
        }
end

procedure handle_client(f)
    critical mlck: nCons +:= 1
    thread {
        select(f,1000) & {
            writes(f, "Name? ")
            nick := (read(f) ? tab(upto('\n\r')))
            every write(!cons, nick," has joined.")
            insert(cons, f)
            while s := read(f) do every write(!cons, nick,": ",s)
            }
        delete(cons, f)
        every write(!cons, nick," has left.")
        critical mlck: nCons -:= 1
        }
end


import java.io.*;
import java.net.*;
import java.util.*;

public class ChatServer implements Runnable
{
  private int port = 0;
  private List<Client> clients = new ArrayList<Client>();

  public ChatServer(int port)
  {  this.port = port;  }

  public void run()
  {
    try
    {
      ServerSocket ss = new ServerSocket(port);
      while (true)
      {
        Socket s = ss.accept();
        new Thread(new Client(s)).start();
      }
    }
    catch (Exception e)
    {  e.printStackTrace();  }
  }

  private synchronized boolean registerClient(Client client)
  {
    for (Client otherClient : clients)
      if (otherClient.clientName.equalsIgnoreCase(client.clientName))
        return false;
    clients.add(client);
    return true;
  }

  private void deregisterClient(Client client)
  {
    boolean wasRegistered = false;
    synchronized (this)
    {  wasRegistered = clients.remove(client);  }
    if (wasRegistered)
      broadcast(client, "--- " + client.clientName + " left ---");
  }

  private synchronized String getOnlineListCSV()
  {
    StringBuilder sb = new StringBuilder();
    sb.append(clients.size()).append(" user(s) online: ");
    for (int i = 0; i < clients.size(); i++)
      sb.append((i > 0) ? ", " : "").append(clients.get(i).clientName);
    return sb.toString();
  }

  private void broadcast(Client fromClient, String msg)
  {
    // Copy client list (don't want to hold lock while doing IO)
    List<Client> clients = null;
    synchronized (this)
    {  clients = new ArrayList<Client>(this.clients);  }
    for (Client client : clients)
    {
      if (client.equals(fromClient))
        continue;
      try
      {  client.write(msg + "\r\n");  }
      catch (Exception e)
      {  }
    }
  }

  public class Client implements Runnable
  {
    private Socket socket = null;
    private Writer output = null;
    private String clientName = null;

    public Client(Socket socket)
    {
      this.socket = socket;
    }

    public void run()
    {
      try
      {
        socket.setSendBufferSize(16384);
        socket.setTcpNoDelay(true);
        BufferedReader input = new BufferedReader(new InputStreamReader(socket.getInputStream()));
        output = new OutputStreamWriter(socket.getOutputStream());
        write("Please enter your name: ");
        String line = null;
        while ((line = input.readLine()) != null)
        {
          if (clientName == null)
          {
            line = line.trim();
            if (line.isEmpty())
            {
              write("A name is required. Please enter your name: ");
              continue;
            }
            clientName = line;
            if (!registerClient(this))
            {
              clientName = null;
              write("Name already registered. Please enter your name: ");
              continue;
            }
            write(getOnlineListCSV() + "\r\n");
            broadcast(this, "+++ " + clientName + " arrived +++");
            continue;
          }
          if (line.equalsIgnoreCase("/quit"))
            return;
          broadcast(this, clientName + "> " + line);
        }
      }
      catch (Exception e)
      {  }
      finally
      {
        deregisterClient(this);
        output = null;
        try
        {  socket.close();  }
        catch (Exception e)
        {  }
        socket = null;
      }
    }

    public void write(String msg) throws IOException
    {
      output.write(msg);
      output.flush();
    }

    public boolean equals(Client client)
    {
      return (client != null) && (client instanceof Client) && (clientName != null) && (client.clientName != null) && clientName.equals(client.clientName);
    }
  }

  public static void main(String[] args)
  {
    int port = 4004;
    if (args.length > 0)
      port = Integer.parseInt(args[0]);
    new ChatServer(port).run();
  }
}


const net = require("net");
const EventEmitter = require("events").EventEmitter;

/*******************************************************************************
 * ChatServer
 *
 * Manages connections, users, and chat messages.
 ******************************************************************************/

class ChatServer {
    constructor() {
        this.chatters = {};
        this.server = net.createServer(this.handleConnection.bind(this));
        this.server.listen(1212, "localhost");
    }
    isNicknameLegal(nickname) {
        // A nickname may contain letters or numbers only,
        // and may only be used once.
        if (nickname.replace(/[A-Za-z0-9]*/, '') !== "") {
            return false;
        }
        for (const used_nick in this.chatters) {
            if (used_nick === nickname) {
                return false;
            }
        }
        return true;
    }
    handleConnection(connection) {
        console.log(`Incoming connection from ${connection.remoteAddress}`);
        connection.setEncoding("utf8");

        let chatter = new Chatter(connection, this);
        chatter.on("chat", this.handleChat.bind(this));
        chatter.on("join", this.handleJoin.bind(this));
        chatter.on("leave", this.handleLeave.bind(this));
    }
    handleChat(chatter, message) {
        this.sendToEveryChatterExcept(chatter, chatter.nickname + ": " + message);
    }
    handleJoin(chatter) {
        console.log(`${chatter.nickname} has joined the chat.`);
        this.sendToEveryChatter(`${chatter.nickname} has joined the chat.`);
        this.addChatter(chatter);
    }
    handleLeave(chatter) {
        console.log(`${chatter.nickname} has left the chat.`);
        this.removeChatter(chatter);
        this.sendToEveryChatter(`${chatter.nickname} has left the chat.`);
    }
    addChatter(chatter) {
        this.chatters[chatter.nickname] = chatter;
    }
    removeChatter(chatter) {
        delete this.chatters[chatter.nickname];
    }
    sendToEveryChatter(data) {
        for (const nickname in this.chatters) {
            this.chatters[nickname].send(data);
        }
    }
    sendToEveryChatterExcept(chatter, data) {
        for (const nickname in this.chatters) {
            if (nickname !== chatter.nickname) {
                this.chatters[nickname].send(data);
            }
        }
    }
}

/*******************************************************************************
 * Chatter
 *
 * Represents a single user/connection in the chat server.
 ******************************************************************************/

class Chatter extends EventEmitter {
    constructor(socket, server) {
        super();

        this.socket = socket;
        this.server = server;
        this.nickname = "";
        this.lineBuffer = new SocketLineBuffer(socket);

        this.lineBuffer.on("line", this.handleNickname.bind(this));
        this.socket.on("close", this.handleDisconnect.bind(this));

        this.send("Welcome! What is your nickname?");
    }
    handleNickname(nickname) {
        if (server.isNicknameLegal(nickname)) {
            this.nickname = nickname;
            this.lineBuffer.removeAllListeners("line");
            this.lineBuffer.on("line", this.handleChat.bind(this));
            this.send(`Welcome to the chat, ${nickname}!`);
            this.emit("join", this);
        } else {
            this.send("Sorry, but that nickname is not legal or is already in use!");
            this.send("What is your nickname?");
        }
    }
    handleChat(line) {
        this.emit("chat", this, line);
    }
    handleDisconnect() {
        this.emit("leave", this);
    }
    send(data) {
        this.socket.write(data + "\r\n");
    }
};

/*******************************************************************************
 * SocketLineBuffer
 *
 * Listens for and buffers incoming data on a socket and emits a 'line' event
 * whenever a complete line is detected.
 ******************************************************************************/

class SocketLineBuffer extends EventEmitter {
    constructor(socket) {
        super();

        this.socket = socket;
        this.buffer = "";

        this.socket.on("data", this.handleData.bind(this));
    }
    handleData(data) {
        for (let i = 0; i < data.length; i++) {
            const char = data.charAt(i);
            this.buffer += char;
            if (char == "\n") {
                this.buffer = this.buffer.replace("\r\n", "");
                this.buffer = this.buffer.replace("\n", "");
                this.emit("line", this.buffer);
                this.buffer = "";
            }
        }
    }
};

// Start the server!
server = new ChatServer();


using HttpServer
using WebSockets

const connections = Dict{Int,WebSocket}()
const usernames   = Dict{Int,String}()

function decodeMessage( msg )
    String(copy(msg))
end

wsh = WebSocketHandler() do req, client
    global connections
    @show connections[client.id] = client
    println("req is $req")
    notifyonline = "Connection from user number $(client.id) is now online."
    for (k,v) in connections
        if k != client.id
            try
                write(v, notifyonline)
            catch
                continue
            end
        end
    end
    while true
        try
            msg = read(client)
        catch
            telloffline = "User $(usernames[client.id]) disconnected."
            println(telloffline, "(The client id was $(client.id).)")
            delete!(connections, client.id)
            if haskey(usernames, client.id)
                delete!(usernames, client.id)
            end
            for (k,v) in connections
                try
                    write(v, telloffline)
                catch
                    continue
                end
            end
            return
        end
        msg = decodeMessage(msg)
        if startswith(msg, "setusername:")
            println("SETTING USERNAME: $msg")
            usernames[client.id] = msg[13:end]
            notifyusername = "User number $(client.id) chose $(usernames[client.id]) as name handle."
            for (k,v) in connections
                try
                    write(v, notifyusername)
                catch
                    println("Caught exception writing to user $k")
                    continue
                end
            end
        end
        if startswith(msg, "say:")
            println("EMITTING MESSAGE: $msg")
            for (k,v) in connections
                if k != client.id
                    try
                        write(v, (usernames[client.id] * ": " * msg[5:end]))
                    catch
                        println("Caught exception writing to user $k")
                        continue
                    end
                end
            end
        end
    end
end

onepage = readstring(Pkg.dir("WebSockets","examples","chat-client.html"))
httph = HttpHandler() do req::Request, res::Response
  Response(onepage)
end

server = Server(httph, wsh)
println("Chat server listening on 8000...")
run(server,8000)


import java.io.BufferedReader
import java.io.IOException
import java.io.InputStreamReader
import java.io.OutputStreamWriter
import java.io.Writer
import java.net.ServerSocket
import java.net.Socket
import java.util.ArrayList
import java.util.Collections

class ChatServer private constructor(private val port: Int) : Runnable {
    private val clients = ArrayList<Client>()

    private val onlineListCSV: String
        @Synchronized get() {
            val sb = StringBuilder()
            sb.append(clients.size).append(" user(s) online: ")
            for (i in clients.indices) {
                sb.append(if (i > 0) ", " else "").append(clients[i].clientName)
            }
            return sb.toString()
        }

    override fun run() {
        try {
            val ss = ServerSocket(port)
            while (true) {
                val s = ss.accept()
                Thread(Client(s)).start()
            }
        } catch (e: Exception) {
            e.printStackTrace()
        }
    }

    @Synchronized
    private fun registerClient(client: Client): Boolean {
        for (otherClient in clients) {
            if (otherClient.clientName!!.equals(client.clientName!!, ignoreCase = true)) {
                return false
            }
        }
        clients.add(client)
        return true
    }

    private fun deRegisterClient(client: Client) {
        var wasRegistered = false
        synchronized(this) {
            wasRegistered = clients.remove(client)
        }
        if (wasRegistered) {
            broadcast(client, "--- " + client.clientName + " left ---")
        }
    }

    private fun broadcast(fromClient: Client, msg: String) {
        // Copy client list (don't want to hold lock while doing IO)
        var clients: List<Client> = Collections.emptyList()
        synchronized(this) {
            clients = ArrayList(this.clients)
        }
        for (client in clients) {
            if (client.equals(fromClient)) {
                continue
            }
            try {
                client.write(msg + "\r\n")
            } catch (e: Exception) {
                e.printStackTrace()
            }

        }
    }

    inner class Client internal constructor(private var socket: Socket?) : Runnable {
        private var output: Writer? = null
        var clientName: String? = null

        override fun run() {
            try {
                socket!!.sendBufferSize = 16384
                socket!!.tcpNoDelay = true
                val input = BufferedReader(InputStreamReader(socket!!.getInputStream()))
                output = OutputStreamWriter(socket!!.getOutputStream())
                write("Please enter your name: ")
                var line: String
                while (true) {
                    line = input.readLine()
                    if (null == line) {
                        break
                    }
                    if (clientName == null) {
                        line = line.trim { it <= ' ' }
                        if (line.isEmpty()) {
                            write("A name is required. Please enter your name: ")
                            continue
                        }
                        clientName = line
                        if (!registerClient(this)) {
                            clientName = null
                            write("Name already registered. Please enter your name: ")
                            continue
                        }
                        write(onlineListCSV + "\r\n")
                        broadcast(this, "+++ $clientName arrived +++")
                        continue
                    }
                    if (line.equals("/quit", ignoreCase = true)) {
                        return
                    }
                    broadcast(this, "$clientName> $line")
                }
            } catch (e: Exception) {
                e.printStackTrace()
            } finally {
                deRegisterClient(this)
                output = null
                try {
                    socket!!.close()
                } catch (e: Exception) {
                    e.printStackTrace()
                }

                socket = null
            }
        }

        @Throws(IOException::class)
        internal fun write(msg: String) {
            output!!.write(msg)
            output!!.flush()
        }

        internal fun equals(client: Client?): Boolean {
            return (client != null
                && clientName != null
                && client.clientName != null
                && clientName == client.clientName)
        }
    }

    companion object {
        @JvmStatic
        fun main(args: Array<String>) {
            var port = 4004
            if (args.isNotEmpty()) {
                port = Integer.parseInt(args[0])
            }
            ChatServer(port).run()
        }
    }
}


	cpu	8086
	bits	16
vmode:	equ	0Fh		; Get current video mode
time:	equ	2Ch		; Get current system time
CGALO:	equ	4		; Low-res (4-color) CGA mode
MDA:	equ	7		; MDA text mode
section	.text
	org	100h
	mov	ah,vmode	; Get current video mode
	int	10h
	cmp	al,MDA		; If MDA mode, no CGA supported, so stop
	jne	gr_ok
	ret
gr_ok:	push	ax		; Store old video mode on stack
	mov	ax,CGALO	; Switch to low-resolution CGA mode
	int	10h
	mov	ah,time		; Get system time
	int	21h
	mov	di,cx		; Store as RNG seed
	mov	bp,dx
genX:	call	random		; Generate random X coordinate
	cmp	al,200
	jae	genX
	mov	dh,al		; DH = X
genY:	call	random		; Generate random Y coordinate
	cmp	al,173
	jae	genY
	mov	dl,al		; DL = Y
mloop:	mov	ah,1		; Is a key pressed?
	int	16h
	jz	point		; If not, calculate another point
	pop	ax		; But if so, restore the old video mode
	cbw
	int	10h
	ret			; And quit
point:	call	random		; Generate random direction
	and	al,3
	cmp	al,3
	je	point
	mov	ah,al		; Keep direction (for color later)
	dec	al		; Select direction
	jz	d2
	dec	al
	jz	d3
	shr	dh,1		; X /= 2
	shr	dl,1		; Y /= 2
	jmp	plot
d2:	mov	cl,ah		; Keep color in CL
	mov	si,100		; X = 100+(100-X)/2
	xor	ax,ax		; (doing intermediate math in 16 bits)
	mov	al,dh
	neg	ax
	add	ax,si
	shr	ax,1
	add	ax,si
	mov	dh,al
	mov	si,173		; Y = 173-(173-Y)/2
	xor	ax,ax		; (doing intermediate math in 16 bits)
	mov	al,dl
	neg	ax
	add	ax,si
	shr	ax,1
	neg	ax
	add	ax,si
	mov	dl,al
	mov	ah,cl		; Restore color
	jmp	plot
d3:	mov	cl,ah		; Keep color
	mov	si,200		; X = 200-(200-X)/2
	xor	ax,ax		; (doing intermediate math in 16 bits)
	mov	al,dh
	neg	ax
	add	ax,si
	shr	ax,1
	neg	ax
	add	ax,si
	mov	dh,al
	mov	ah,cl		; Restore color
	shr	dl,1		; Y /= 2
plot:	mov	cl,dl		; There's a plot function in the BIOS, but it's
	clc			; behind an INT and needs all the registers,
	rcr	cl,1		; so we'll do it by hand.
	sbb	bh,bh		; The even rows are at B800:NNNN, odd at BA00,
	xor	bl,bl		; CL (Y coord) is divided by two, and if odd
	and	bh,2		; we add 2(00) to B8(00) to get the right
	add	bh,0B8h		; segment.
	mov	ds,bx		; We can safely stick it in DS since we're not
	xor	bx,bx		; using any RAM otherwise. 80 bytes per line,
	mov	bl,cl		; so BX=Y * 80,
	xor	ch,ch
	shl	bx,1
	shl	bx,1
	add	bx,cx
	mov	cl,4
	shl	bx,cl
	mov	cl,dh		; and 4 pixels per byte, so BX += Y/4
	shr	cl,1
	shr	cl,1
	add	bx,cx
	inc	ah		; Add 1 to direction to get 1 of 3 colors
	mov	ch,dh		; See which pixel within the byte we're
	and	ch,3		; looking at
	mov	cl,3		; Leftmost pixel is in highest bits
	sub	cl,ch
	shl	cl,1		; Pixels are 2 bits wide
	shl	ah,cl 		; Shift AH into place
	or	[bx],ah		; Set the pixel in video memory
	jmp	mloop		; Next pixel
random:	xchg	bx,bp		; Load RNG state into byte-addressable
	xchg	cx,di 		; registers.
	inc	bl		; X++
	xor	bh,ch		; A ^= C
	xor	bh,bl		; A ^= X
	add	cl,bh		; B += A
	mov	al,cl		; C' = B
	shr	al,1		; C' >>= 1
	add	al,ch		; C' += C
	xor	al,bh		; C' ^= A
	mov	ch,al		; C = C'
	xchg	bx,bp		; Restore the registers
	xchg	cx,di
	ret