########################### Helper subs ###########################

sub adjusted (@p, $type) { "\n$type\n" ~ format adjust( check(@p), $type ) }

sub format ( @p, $cols = 5 ) {
    my $i = -$cols;
    my $fmt = "%1.10f";
    join "\n", @p.rotor($cols, :partial).map:
      { sprintf "[%2d]  { join ' ', $fmt xx $_ }", $i+=$cols, $_ };
}

sub check ( @p ) { die 'p-values must be in range 0.0 to 1.0' if @p.min < 0 or 1 < @p.max; @p }

multi ratchet ( 'up', @p ) { my $m; @p[$_] min= $m, $m = @p[$_] for ^@p; @p }

multi ratchet ( 'dn', @p ) { my $m; @p[$_] max= $m, $m = @p[$_] for ^@p .reverse; @p }

sub schwartzian ( @p, &transform, :$ratchet ) {
    my @pa = @p.map( {[$_, $++]} ).sort( -*.[0] ).map: { [transform(.[0]), .[1]] };
    @pa[*;0] = ratchet($ratchet, @pa»[0]);
    @pa.sort( *.[1] )»[0]
}

############# The various p-value correction routines #############

multi adjust( @p, 'Benjamini-Hochberg' ) {
    @p.&schwartzian: * * @p / (@p - $++) min 1, :ratchet('up')
}

multi adjust( @p, 'Benjamini-Yekutieli' ) {
    my \r = ^@p .map( { 1 / ++$ } ).sum;
    @p.&schwartzian: * * r * @p / (@p - $++) min 1, :ratchet('up')
}

multi adjust( @p, 'Hochberg' ) {
    my \m = @p.max;
    @p.&schwartzian: * * ++$ min m, :ratchet('up')
}

multi adjust( @p, 'Holm' ) {
    @p.&schwartzian: * * ++$ min 1, :ratchet('dn')
}

multi adjust( @p, 'Šidák' ) {
    @p.&schwartzian: 1 - (1 - *) ** ++$, :ratchet('dn')
}

multi adjust( @p, 'Bonferroni' ) {
    @p.map: * * @p min 1
}

# Hommel correction can't be easily reduced to a one pass transform
multi adjust( @p, 'Hommel' ) {
    my @s  = @p.map( {[$_, $++]} ).sort: *.[0] ; # sorted
    my \z  = +@p; # array si(z)e
    my @pa = @s»[0].map( * * z / ++$ ).min xx z; # p adjusted
    my @q;        # scratch array
    for (1 ..^ z).reverse -> $i {
        my @L  = 0 .. z - $i; # lower indices
        my @U  = z - $i ^..^ z; # upper indices
        my $q  = @s[@U]»[0].map( { $_ * $i / (2 + $++) } ).min;
        @q[@L] = @s[@L]»[0].map: { min $_ * $i, $q, @s[*-1][0] };
        @pa    = ^z .map: { max @pa[$_], @q[$_] }
    }
    @pa[@s[*;1].map( {[$_, $++]} ).sort( *.[0] )»[1]]
}

multi adjust ( @p, $unknown ) {
    note "\nSorry, do not know how to do $unknown correction.\n" ~
    "Perhaps you want one of these?:\n" ~
    <Benjamini-Hochberg Benjamini-Yekutieli Bonferroni Hochberg
    Holm Hommel Šidák>.join("\n");
    exit
}

########################### The task ###########################

my @p-values =
    4.533744e-01, 7.296024e-01, 9.936026e-02, 9.079658e-02, 1.801962e-01,
    8.752257e-01, 2.922222e-01, 9.115421e-01, 4.355806e-01, 5.324867e-01,
    4.926798e-01, 5.802978e-01, 3.485442e-01, 7.883130e-01, 2.729308e-01,
    8.502518e-01, 4.268138e-01, 6.442008e-01, 3.030266e-01, 5.001555e-02,
    3.194810e-01, 7.892933e-01, 9.991834e-01, 1.745691e-01, 9.037516e-01,
    1.198578e-01, 3.966083e-01, 1.403837e-02, 7.328671e-01, 6.793476e-02,
    4.040730e-03, 3.033349e-04, 1.125147e-02, 2.375072e-02, 5.818542e-04,
    3.075482e-04, 8.251272e-03, 1.356534e-03, 1.360696e-02, 3.764588e-04,
    1.801145e-05, 2.504456e-07, 3.310253e-02, 9.427839e-03, 8.791153e-04,
    2.177831e-04, 9.693054e-04, 6.610250e-05, 2.900813e-02, 5.735490e-03
;

for < Benjamini-Hochberg Benjamini-Yekutieli Bonferroni Hochberg Holm Hommel Šidák >
{
    say adjusted @p-values, $_
}


def pmin(array)
  x = 1
  pmin_array = []
  array.each_index do |i|
    pmin_array[i] = [array[i], x].min
    abort if pmin_array[i] > 1
  end
  pmin_array
end

def cummin(array)
  cumulative_min = array[0]
  arr_cummin = []
  array.each do |p|
    cumulative_min = [p, cumulative_min].min
    arr_cummin.push(cumulative_min)
  end
  arr_cummin
end

def cummax(array)
  cumulative_max = array[0]
  arr_cummax = []
  array.each do |p|
    cumulative_max = [p, cumulative_max].max
    arr_cummax.push(cumulative_max)
  end
  arr_cummax
end

# decreasing variable is optional
def order(array, decreasing = false)
  if decreasing == false
    array.sort.map { |n| array.index(n) }
  else
    array.sort.map { |n| array.index(n) }.reverse
  end
end

def p_adjust(arr_pvalues, method = 'Holm')
  lp = arr_pvalues.size
  n = lp
  if method.casecmp('hochberg').zero?
    arr_o = order(arr_pvalues, true)
    arr_cummin_input = []
    (0..n).each do |index|
      arr_cummin_input[index] = (index + 1) * arr_pvalues[arr_o[index].to_i]
    end
    arr_cummin = cummin(arr_cummin_input)
    arr_pmin = pmin(arr_cummin)
    arr_ro = order(arr_o)
    return arr_pmin.values_at(*arr_ro)
  elsif method.casecmp('bh').zero? || method.casecmp('benjamini-hochberg').zero?
    arr_o = order(arr_pvalues, true)
    arr_cummin_input = []
    (0..(n - 1)).each do |i|
      arr_cummin_input[i] = (n / (n - i).to_f) * arr_pvalues[arr_o[i]]
    end
    arr_ro = order(arr_o)
    arr_cummin = cummin(arr_cummin_input)
    arr_pmin = pmin(arr_cummin)
    return arr_pmin.values_at(*arr_ro)
  elsif method.casecmp('by').zero? || method.casecmp('benjamini-yekutieli').zero?
    q = 0.0
    arr_o = order(arr_pvalues, true)
    arr_ro = order(arr_o)
    (1..n).each do |index|
      q += 1.0 / index
    end
    arr_cummin_input = []
    (0..(n - 1)).each do |i|
      arr_cummin_input[i] = q * (n / (n - i).to_f) * arr_pvalues[arr_o[i]]
    end
    arr_cummin = cummin(arr_cummin_input)
    arr_pmin = pmin(arr_cummin)
    return arr_pmin.values_at(*arr_ro)
  elsif method.casecmp('bonferroni').zero?
    arr_qvalues = []
    (0..(n - 1)).each do |i|
      q = arr_pvalues[i] * n
      if (q >= 0) && (q < 1)
        arr_qvalues[i] = q
      elsif q >= 1
        arr_qvalues[i] = 1.0
      else
        puts "Falied to get Bonferroni adjusted p for #{arr_pvalues[i]}"
      end
    end
    return arr_qvalues
  elsif method.casecmp('holm').zero?
    o = order(arr_pvalues)
    cummax_input = []
    (0..(n - 1)).each do |index|
      cummax_input[index] = (n - index) * arr_pvalues[o[index]]
    end
    ro = order(o)
    arr_cummax = cummax(cummax_input)
    arr_pmin = pmin(arr_cummax)
    return arr_pmin.values_at(*ro)
  elsif method.casecmp('hommel').zero?
    o = order(arr_pvalues)
    arr_p = arr_pvalues.values_at(*o)
    ro = order(o)
    q = []
    pa = []
    min = n * arr_p[0]
    (0..(n - 1)).each do |index|
      temp = n * arr_p[index] / (index + 1)
      min = [min, temp].min
    end
    (0..(n - 1)).each do |index|
      pa[index] = min
      q[index]  = min
    end
    j = n - 1
    while j >= 2
      ij = Array 0..(n - j)
      i2_length = j - 1
      i2 = []
      (0..(i2_length - 1)).each do |i|
        i2[i] = n - j + 2 + i - 1 # R's indices are 1-based, C's are 0-based
      end
      q1 = j * arr_p[i2[0]] / 2.0
      (1..(i2_length - 1)).each do |i|
        temp_q1 = j * arr_p[i2[i]] / (2 + i)
        q1 = [temp_q1, q1].min
      end
      (0..(n - j)).each do |i|
        tmp = j * arr_p[ij[i]]
        q[ij[i]] = [tmp, q1].min
      end
      (0..(i2_length - 1)).each do |i|
        q[i2[i]] = q[n - j]
      end
      (0..(n - 1)).each do |i|
        pa[i] = q[i] if pa[i] < q[i]
      end
      j -= 1
    end
    return pa.values_at(*ro)
  else
    puts "#{method} isn't accepted."
    abort
  end
end

pvalues =
   [4.533744e-01, 7.296024e-01, 9.936026e-02, 9.079658e-02,
    1.801962e-01, 8.752257e-01, 2.922222e-01, 9.115421e-01,
    4.355806e-01, 5.324867e-01, 4.926798e-01, 5.802978e-01,
    3.485442e-01, 7.883130e-01, 2.729308e-01, 8.502518e-01,
    4.268138e-01, 6.442008e-01, 3.030266e-01, 5.001555e-02,
    3.194810e-01, 7.892933e-01, 9.991834e-01, 1.745691e-01,
    9.037516e-01, 1.198578e-01, 3.966083e-01, 1.403837e-02,
    7.328671e-01, 6.793476e-02, 4.040730e-03, 3.033349e-04,
    1.125147e-02, 2.375072e-02, 5.818542e-04, 3.075482e-04,
    8.251272e-03, 1.356534e-03, 1.360696e-02, 3.764588e-04,
    1.801145e-05, 2.504456e-07, 3.310253e-02, 9.427839e-03,
    8.791153e-04, 2.177831e-04, 9.693054e-04, 6.610250e-05,
    2.900813e-02, 5.735490e-03]

correct_answers = {
  'Benjamini-Hochberg' => [6.126681e-01, 8.521710e-01, 1.987205e-01,
                           1.891595e-01, 3.217789e-01, 9.301450e-01,
                           4.870370e-01, 9.301450e-01, 6.049731e-01,
                           6.826753e-01, 6.482629e-01, 7.253722e-01,
                           5.280973e-01, 8.769926e-01, 4.705703e-01,
                           9.241867e-01, 6.049731e-01, 7.856107e-01,
                           4.887526e-01, 1.136717e-01, 4.991891e-01,
                           8.769926e-01, 9.991834e-01, 3.217789e-01,
                           9.301450e-01, 2.304958e-01, 5.832475e-01,
                           3.899547e-02, 8.521710e-01, 1.476843e-01,
                           1.683638e-02, 2.562902e-03, 3.516084e-02,
                           6.250189e-02, 3.636589e-03, 2.562902e-03,
                           2.946883e-02, 6.166064e-03, 3.899547e-02,
                           2.688991e-03, 4.502862e-04, 1.252228e-05,
                           7.881555e-02, 3.142613e-02, 4.846527e-03,
                           2.562902e-03, 4.846527e-03, 1.101708e-03,
                           7.252032e-02, 2.205958e-02],
  'Benjamini-Yekutieli' => [1.000000e+00, 1.000000e+00, 8.940844e-01,
                            8.510676e-01, 1.000000e+00, 1.000000e+00,
                            1.000000e+00, 1.000000e+00, 1.000000e+00,
                            1.000000e+00, 1.000000e+00, 1.000000e+00,
                            1.000000e+00, 1.000000e+00, 1.000000e+00,
                            1.000000e+00, 1.000000e+00, 1.000000e+00,
                            1.000000e+00, 5.114323e-01, 1.000000e+00,
                            1.000000e+00, 1.000000e+00, 1.000000e+00,
                            1.000000e+00, 1.000000e+00, 1.000000e+00,
                            1.754486e-01, 1.000000e+00, 6.644618e-01,
                            7.575031e-02, 1.153102e-02, 1.581959e-01,
                            2.812089e-01, 1.636176e-02, 1.153102e-02,
                            1.325863e-01, 2.774239e-02, 1.754486e-01,
                            1.209832e-02, 2.025930e-03, 5.634031e-05,
                            3.546073e-01, 1.413926e-01, 2.180552e-02,
                            1.153102e-02, 2.180552e-02, 4.956812e-03,
                            3.262838e-01, 9.925057e-02],
  'Bonferroni' => [1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00,
                   1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00,
                   1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00,
                   1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00,
                   1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00,
                   1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00,
                   1.000000e+00, 1.000000e+00, 1.000000e+00, 7.019185e-01,
                   1.000000e+00, 1.000000e+00, 2.020365e-01, 1.516674e-02,
                   5.625735e-01, 1.000000e+00, 2.909271e-02, 1.537741e-02,
                   4.125636e-01, 6.782670e-02, 6.803480e-01, 1.882294e-02,
                   9.005725e-04, 1.252228e-05, 1.000000e+00, 4.713920e-01,
                   4.395577e-02, 1.088915e-02, 4.846527e-02, 3.305125e-03,
                   1.000000e+00, 2.867745e-01],

  'Hochberg' => [9.991834e-01, 9.991834e-01, 9.991834e-01, 9.991834e-01,
                 9.991834e-01, 9.991834e-01, 9.991834e-01, 9.991834e-01,
                 9.991834e-01, 9.991834e-01, 9.991834e-01, 9.991834e-01,
                 9.991834e-01, 9.991834e-01, 9.991834e-01, 9.991834e-01,
                 9.991834e-01, 9.991834e-01, 9.991834e-01, 9.991834e-01,
                 9.991834e-01, 9.991834e-01, 9.991834e-01, 9.991834e-01,
                 9.991834e-01, 9.991834e-01, 9.991834e-01, 4.632662e-01,
                 9.991834e-01, 9.991834e-01, 1.575885e-01, 1.383967e-02,
                 3.938014e-01, 7.600230e-01, 2.501973e-02, 1.383967e-02,
                 3.052971e-01, 5.426136e-02, 4.626366e-01, 1.656419e-02,
                 8.825610e-04, 1.252228e-05, 9.930759e-01, 3.394022e-01,
                 3.692284e-02, 1.023581e-02, 3.974152e-02, 3.172920e-03,
                 8.992520e-01, 2.179486e-01],
  'Holm' => [1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00,
             1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00,
             1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00,
             1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00,
             1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00,
             1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00,
             1.000000e+00, 1.000000e+00, 1.000000e+00, 4.632662e-01,
             1.000000e+00, 1.000000e+00, 1.575885e-01, 1.395341e-02,
             3.938014e-01, 7.600230e-01, 2.501973e-02, 1.395341e-02,
             3.052971e-01, 5.426136e-02, 4.626366e-01, 1.656419e-02,
             8.825610e-04, 1.252228e-05, 9.930759e-01, 3.394022e-01,
             3.692284e-02, 1.023581e-02, 3.974152e-02, 3.172920e-03,
             8.992520e-01, 2.179486e-01],

  'Hommel' => [9.991834e-01, 9.991834e-01, 9.991834e-01, 9.987624e-01,
               9.991834e-01, 9.991834e-01, 9.991834e-01, 9.991834e-01,
               9.991834e-01, 9.991834e-01, 9.991834e-01, 9.991834e-01,
               9.991834e-01, 9.991834e-01, 9.991834e-01, 9.991834e-01,
               9.991834e-01, 9.991834e-01, 9.991834e-01, 9.595180e-01,
               9.991834e-01, 9.991834e-01, 9.991834e-01, 9.991834e-01,
               9.991834e-01, 9.991834e-01, 9.991834e-01, 4.351895e-01,
               9.991834e-01, 9.766522e-01, 1.414256e-01, 1.304340e-02,
               3.530937e-01, 6.887709e-01, 2.385602e-02, 1.322457e-02,
               2.722920e-01, 5.426136e-02, 4.218158e-01, 1.581127e-02,
               8.825610e-04, 1.252228e-05, 8.743649e-01, 3.016908e-01,
               3.516461e-02, 9.582456e-03, 3.877222e-02, 3.172920e-03,
               8.122276e-01, 1.950067e-01]
}

# correct_answers.each do |method, answers|
methods = ['Benjamini-Yekutieli', 'Benjamini-Hochberg', 'Hochberg',
           'Bonferroni', 'Holm', 'Hommel']
methods.each do |method|
  puts method
  error = 0.0
  arr_q = p_adjust(pvalues, method)
  arr_q.each_index do |p|
    error += (correct_answers[method][p] - arr_q[p])
  end
  puts "total error for #{method} = #{error}"
end


import "/dynamic" for Enum
import "/fmt" for Fmt
import "/seq" for Lst
import "/math" for Nums
import "/sort" for Sort

var Direction = Enum.create("Direction", ["UP", "DOWN"])

// test also for 'Unknown' correction type
var types = [
    "Benjamini-Hochberg", "Benjamini-Yekutieli", "Bonferroni", "Hochberg",
    "Holm", "Hommel", "Šidák", "Unknown"
]

var pFormat = Fn.new { |p, cols|
    var i = -cols
    var fmt = "$1.10f"
    return Lst.chunks(p, cols).map { |chunk|
        i = i + cols
        return Fmt.swrite("[$2d  $s", i, chunk.map { |v| Fmt.swrite(fmt, v) }.join(" "))
    }.join("\n")
}

var check = Fn.new { |p|
    if (p.count == 0 || Nums.min(p) < 0 || Nums.max(p) > 1) {
        Fiber.abort("p-values must be in range 0 to 1")
    }
    return p
}

var ratchet = Fn.new { |p, dir|
    var pp = p.toList
    var m = pp[0]
    if (dir == Direction.UP) {
        for (i in 1...pp.count) {
            if (pp[i] > m) pp[i] = m
            m = pp[i]
        }
    } else {
        for (i in 1...pp.count) {
            if (pp[i] < m) pp[i] = m
            m = pp[i]
        }
    }
    return pp.map { |v| (v < 1) ? v : 1 }.toList
}

var schwartzian = Fn.new { |p, mult, dir|
    var size = p.count
    var pwi = List.filled(size, null)
    for (i in 0...size) pwi[i] = [i, p[i]]
    var cmp = (dir == Direction.UP) ? Fn.new { |a, b| (b[1] - a[1]).sign } :
                                      Fn.new { |a, b| (a[1] - b[1]).sign }
    var order = Sort.merge(pwi, cmp).map { |e| e[0] }.toList
    var pa = List.filled(size, 0)
    for (i in 0...size) pa[i] = mult[i] * p[order[i]]
    pa = ratchet.call(pa, dir)
    var owi = List.filled(order.count, null)
    for (i in 0...order.count) owi[i] = [i, order[i]]
    cmp = Fn.new { |a, b| (a[1] - b[1]).sign }
    var order2 = Sort.merge(owi, cmp).map { |e| e[0] }.toList
    var res = List.filled(size, 0)
    for (i in 0...size) res[i] = pa[order2[i]]
    return res
}

var adjust = Fn.new { |p, type|
    var size = p.count
    if (size == 0) Fiber.abort("List cannot be empty.")
    if (type == "Benjamini-Hochberg") {
        var mult = List.filled(size, 0)
        for (i in 0...size) mult[i] = size / (size - i)
        return schwartzian.call(p, mult, Direction.UP)

    } else if (type == "Benjamini-Yekutieli") {
        var q = (1..size).reduce { |acc, i| acc + 1/i }
        var mult = List.filled(size, 0)
        for (i in 0...size) mult[i] = q * size / (size - i)
        return schwartzian.call(p, mult, Direction.UP)

    } else if (type == "Bonferroni") {
        return p.map { |v| (v * size).min(1) }.toList

    } else if (type == "Hochberg") {
        var mult = List.filled(size, 0)
        for (i in 0...size) mult[i] = i + 1
        return schwartzian.call(p, mult, Direction.UP)

    } else if (type == "Holm") {
        var mult = List.filled(size, 0)
        for (i in 0...size) mult[i] = size - i
        return schwartzian.call(p, mult, Direction.DOWN)

    } else if (type == "Hommel") {
        var pwi = List.filled(size, null)
        for (i in 0...size) pwi[i] = [i, p[i]]
        var cmp = Fn.new { |a, b| (a[1] - b[1]).sign }
        var order = Sort.merge(pwi, cmp).map { |e| e[0] }.toList
        var s = List.filled(size, 0)
        for (i in 0...size) s[i] = p[order[i]]
        var m = List.filled(size, 0)
        for (i in 0...size) m[i] = s[i] * size / (i + 1)
        var min = Nums.min(m)
        var q = List.filled(size, min)
        var pa = List.filled(size, min)
        for (j in size-1..2) {
            var lower = List.filled(size - j + 1, 0)                // lower indices
            for (i in 0...lower.count) lower[i] = i
            var upper = List.filled(j - 1, 0)                       // upper indices
            for (i in 0...upper.count) upper[i] = size - j + 1 + i
            var qmin = j * s[upper[0]] / 2
            for (i in 1...upper.count) {
                var temp = s[upper[i]] * j / (2 + i)
                if (temp < qmin) qmin = temp
            }
            for (i in 0...lower.count) {
                q[lower[i]] = qmin.min(s[lower[i]] * j)
            }
            for (i in 0...upper.count) q[upper[i]] = q[size - j]
            for (i in 0...size) if (pa[i] < q[i]) pa[i] = q[i]
        }
        var owi = List.filled(order.count, null)
        for (i in 0...order.count) owi[i] = [i, order[i]]
        var order2 = Sort.merge(owi, cmp).map { |e| e[0] }.toList
        var res = List.filled(size, 0)
        for (i in 0...size) res[i] = pa[order2[i]]
        return res

    } else if (type == "Šidák") {
        return p.map { |v| 1 - (1 - v).pow(size) }.toList

    } else {
        System.print("\nSorry, do not know how to do '%(type)' correction.\n" +
                     "Perhaps you want one of these?:\n" +
                     types[0...-1].map { |t| "  %(t)" }.join("\n")
        )
        Fiber.suspend()
    }
}

var adjusted = Fn.new { |p, type| "\n%(type)\n%(pFormat.call(adjust.call(check.call(p), type), 5))" }

var pValues = [
    4.533744e-01, 7.296024e-01, 9.936026e-02, 9.079658e-02, 1.801962e-01,
    8.752257e-01, 2.922222e-01, 9.115421e-01, 4.355806e-01, 5.324867e-01,
    4.926798e-01, 5.802978e-01, 3.485442e-01, 7.883130e-01, 2.729308e-01,
    8.502518e-01, 4.268138e-01, 6.442008e-01, 3.030266e-01, 5.001555e-02,
    3.194810e-01, 7.892933e-01, 9.991834e-01, 1.745691e-01, 9.037516e-01,
    1.198578e-01, 3.966083e-01, 1.403837e-02, 7.328671e-01, 6.793476e-02,
    4.040730e-03, 3.033349e-04, 1.125147e-02, 2.375072e-02, 5.818542e-04,
    3.075482e-04, 8.251272e-03, 1.356534e-03, 1.360696e-02, 3.764588e-04,
    1.801145e-05, 2.504456e-07, 3.310253e-02, 9.427839e-03, 8.791153e-04,
    2.177831e-04, 9.693054e-04, 6.610250e-05, 2.900813e-02, 5.735490e-03
]
types.each { |type| System.print(adjusted.call(pValues, type)) }


fcn bh(pvalues){	// Benjamini-Hochberg
   psz,pszf := pvalues.len(), psz.toFloat();
   n_i      := psz.pump(List,'wrap(n){ pszf/(psz - n) }); # N/(N-0),N/(N-1),..
   o,ro     := order(pvalues,True),order(o,False); # sort pvalues, sort indices
   in	    := psz.pump(List,'wrap(n){ n_i[n]*pvalues[o[n]] });
   pmin     := cummin(in).apply((1.0).min); # (min(1,c[0]),min(1,c[1]),...)
   ro.apply(pmin.get);		# (pmin[ro[0]],pmin[ro[1]],...)
}

fcn by(pvalues){	// Benjamini & Yekutieli
   psz,pszf := pvalues.len(), psz.toFloat();
   o,ro     := order(pvalues,True),order(o,False); # sort pvalues, sort indices
   n_i      := psz.pump(List,'wrap(n){ pszf/(psz - n) }); # N/(N-0),N/(N-1),..
   q	    := [1..psz].reduce(fcn(q,n){ q+=1.0/n },0.0);
   in	    := psz.pump(List,'wrap(n){ q * n_i[n] * pvalues[o[n]] });
   cummin(in).apply((1.0).min) : ro.apply(_.get);
}

fcn hochberg(pvalues){
   psz,pszf := pvalues.len(), psz.toFloat();
   o,ro     := order(pvalues,True),order(o,False); # sort pvalues, sort indices
   n_i      := psz.pump(List,'wrap(n){ pszf/(psz - n) }); # N/(N-0),N/(N-1),..
   in	    := psz.pump(List,'wrap(n){ pvalues[o[n]]*(n + 1) });
   cummin(in).apply((1.0).min) : ro.apply(_.get);
}

fcn cummin(pvalues){  // R's cumulative minima --> list of mins
   out,m := List.createLong(pvalues.len()), pvalues[0];
   foreach pv in (pvalues){ out.append(m=m.min(pv)) }
   out
}
fcn order(list,downUp){  // True==increasing, --> List(int) sorted indices
   f:=(downUp) and fcn(a,b){ a[1]>b[1] } or fcn(a,b){ a[1]<b[1] };
   [0..].zip(list).pump(List()).sort(f).pump(List,T("get",0))
}

fcn bonferroni(pvalues){  // -->List
   sz,r := pvalues.len(),List();
   foreach pv in (pvalues){
      b:=pv*sz;
      if(b>=1.0) r.append(1.0);
      else if(0.0<=b<1.0) r.append(b);
      else throw(Exception.ValueError(
	 "%g is outside of the interval I planned.".fmt(b)));
   }
   r
}

fcn hommel(pvalues){
   psz,indices := pvalues.len(), [1..psz].walk();	// 1,2,3,4...
   o,ro        := order(pvalues,False),order(o,False); # sort pvalues, sort indices
   p           := o.apply('wrap(n){ pvalues[n] }).copy(); // pvalues[*o]
   npi         := [1..].zip(p).apply('wrap([(n,p)]){ p*psz/n });
   min	       := (0.0).min(npi);	 // min value in npi
   pa,q	       := List.createLong(psz,min), pa.copy(); #(min,min,,,)
   foreach j in ([psz - 1..2,-1]){
      ij:=[0..psz - j].walk();
      i2:=(j - 1).pump(List,'+(psz - j + 1));
      q1:=(0.0).min((j-1).pump(List,'wrap(n){ p[i2[n]]*j/(2 + n) }));
      foreach i in (psz - j + 1){ q[ij[i]] = q1.min(p[ij[i]]*j) }
      foreach i in (j - 1){ q[i2[i]] = q[psz - j] }
      foreach i in (psz){ pa[i] = pa[i].max(q[i]) }
   }
   psz.pump(List,'wrap(n){ pa[ro[n]] }); // Hommel q-values
}


ahk := comobjactive("ahkdemo.ahk")
ahk.hello("hello world")
py := ComObjActive("python.server")
py.write("hello")
return


package main

import (
    "time"
    ole "github.com/go-ole/go-ole"
    "github.com/go-ole/go-ole/oleutil"
)

func main() {
    ole.CoInitialize(0)
    unknown, _ := oleutil.CreateObject("Word.Application")
    word, _ := unknown.QueryInterface(ole.IID_IDispatch)
    oleutil.PutProperty(word, "Visible", true)
    documents := oleutil.MustGetProperty(word, "Documents").ToIDispatch()
    document := oleutil.MustCallMethod(documents, "Add").ToIDispatch()
    content := oleutil.MustGetProperty(document, "Content").ToIDispatch()
    paragraphs := oleutil.MustGetProperty(content, "Paragraphs").ToIDispatch()
    paragraph := oleutil.MustCallMethod(paragraphs, "Add").ToIDispatch()
    rnge := oleutil.MustGetProperty(paragraph, "Range").ToIDispatch()
    oleutil.PutProperty(rnge, "Text", "This is a Rosetta Code test document.")

    time.Sleep(10 * time.Second)

    oleutil.PutProperty(document, "Saved", true)
    oleutil.CallMethod(document, "Close", false)
    oleutil.CallMethod(word, "Quit")
    word.Release()

    ole.CoUninitialize()
}


Module CheckAutomation {
      ExitNow=false
      Declare WithEvents Alfa "WORD.APPLICATION"
      \\ minimize console
      Title "Minimized- Waiting", 0
      Wait 300
      Print "ok"
      With Alfa, "Visible", True
      Function ALFA_QUIT {
                  Print "Why you close Word?"
                  ExitNow=True
      }
      M=0
      Every 20 {
            If ExitNow then exit
            M++
            If M>500 then exit
      }
      Try {
            Method Alfa, "QUIT"
      }
      Declare Alfa Nothing
      if ExitNow then {
            Print format$("Finish  {0:2} sec", M/1000)
      } Else {
            Print "Close Word manually"
      }
      \\ show again console
      Title "ok"
}
CheckAutomation


#!/usr/bin/env python
# -*- coding: utf-8 -*-
import win32com.client
from win32com.server.util import wrap, unwrap
from win32com.server.dispatcher import DefaultDebugDispatcher
from ctypes import *
import commands
import pythoncom
import winerror
from win32com.server.exception import Exception

clsid = "{55C2F76F-5136-4614-A397-12214CC011E5}"
iid = pythoncom.MakeIID(clsid)
appid = "python.server"

class VeryPermissive:
    def __init__(self):
        self.data = []
        self.handle = 0
        self.dobjects = {}
    def __del__(self):
        pythoncom.RevokeActiveObject(self.handle)
    def _dynamic_(self, name, lcid, wFlags, args):
        if wFlags & pythoncom.DISPATCH_METHOD:
            return getattr(self,name)(*args)
        if wFlags & pythoncom.DISPATCH_PROPERTYGET:
            try:
                # to avoid problems with byref param handling, tuple results are converted to lists.
                ret = self.__dict__[name]
                if type(ret)==type(()):
                    ret = list(ret)
                return ret
            except KeyError: # Probably a method request.
                raise Exception(scode=winerror.DISP_E_MEMBERNOTFOUND)
        if wFlags & (pythoncom.DISPATCH_PROPERTYPUT | pythoncom.DISPATCH_PROPERTYPUTREF):
            setattr(self, name, args[0])
            return
        raise Exception(scode=winerror.E_INVALIDARG, desc="invalid wFlags")
    def write(self, x):
        print x
        return 0
import win32com.server.util, win32com.server.policy
child = VeryPermissive()
ob = win32com.server.util.wrap(child, usePolicy=win32com.server.policy.DynamicPolicy)
try:
    handle = pythoncom.RegisterActiveObject(ob, iid, 0)
except pythoncom.com_error, details:
    print "Warning - could not register the object in the ROT:", details
    handle = None
child.handle = handle

ahk = win32com.client.Dispatch("ahkdemo.ahk")
ahk.aRegisterIDs(clsid, appid)
# autohotkey.exe ahkside.ahk
# python /c/Python26/Scripts/ipython.py -wthread -i pythonside.py
# must use -wthread otherwise calling com client hangs


/* OLE_automation.wren */

class Ole {
    foreign static coInitialize(p)
    foreign static coUninitialize()
}

class OleUtil {
    static createObject(programID) {
        return IUnknown.new(programID)
    }

    foreign static putProperty(disp, name, param)
    foreign static mustGetProperty(disp, name)
    foreign static mustCallMethod(disp, name)
    foreign static mustCallMethod2(disp, name, param)
}

foreign class GUID {
    construct new(guid) {}
}

var IID_DISPATCH = GUID.new("{00020400-0000-0000-C000-000000000046}")

foreign class IUnknown {
    construct new(programID) {}

    foreign queryInterface(iid, name)
    foreign static release(name)
}

class Time {
    foreign static sleep(secs)
}

Ole.coInitialize(0)
var unknown = OleUtil.createObject("Word.application")
var word = unknown.queryInterface(IID_DISPATCH, "word")
OleUtil.putProperty(word, "Visible", true)
var documents  = OleUtil.mustGetProperty(word, "Documents")
var document   = OleUtil.mustCallMethod(documents, "Add")
var content    = OleUtil.mustGetProperty(document, "Content")
var paragraphs = OleUtil.mustGetProperty(content, "Paragraphs")
var paragraph  = OleUtil.mustCallMethod(paragraphs, "Add")
var range      = OleUtil.mustGetProperty(paragraph, "Range")

OleUtil.putProperty(range, "Text", "This is a Rosetta Code test document.")

Time.sleep(10)

OleUtil.putProperty(document, "Saved", true)
OleUtil.mustCallMethod2(document, "Close", false)
OleUtil.mustCallMethod(word, "Quit")
IUnknown.release(word)

Ole.coUninitialize()


with Lumen.Window;
with Lumen.Events;
with Lumen.Events.Animate;
with GL;
with GLU;

procedure OpenGL is

   The_Window : Lumen.Window.Handle;

   Program_Exit : Exception;

   -- simply exit this program
   procedure Quit_Handler (Event : in Lumen.Events.Event_Data) is
   begin
      raise Program_Exit;
   end;

   -- Resize the scene
   procedure Resize_Scene (Width, Height : in Natural) is
      use GL;
      use GLU;
   begin
      -- reset current viewport
      glViewport (0, 0, GLsizei (Width), GLsizei (Height));

      -- select projection matrix and reset it
      glMatrixMode (GL_PROJECTION);
      glLoadIdentity;

      -- calculate aspect ratio
      gluPerspective (45.0, GLdouble (Width) / GLdouble (Height), 0.1, 100.0);

      -- select modelview matrix and reset it
      glMatrixMode (GL_MODELVIEW);
      glLoadIdentity;
   end Resize_Scene;

   procedure Init_GL is
      use GL;
      use GLU;
   begin
      -- smooth shading
      glShadeModel (GL_SMOOTH);

      -- black background
      glClearColor (0.0, 0.0, 0.0, 0.0);

      -- depth buffer setup
      glClearDepth (1.0);
      -- enable depth testing
      glEnable (GL_DEPTH_TEST);
      -- type of depth test
      glDepthFunc (GL_LEQUAL);

      glHint (GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
   end Init_GL;

   -- Resize and Initialize the GL window
   procedure Resize_Handler (Event : in Lumen.Events.Event_Data) is
      Height : Natural := Event.Resize_Data.Height;
      Width  : Natural := Event.Resize_Data.Width;
   begin
      -- prevent div by zero
      if Height = 0 then
         Height := 1;
      end if;

      Resize_Scene (Width, Height);
   end;

   procedure Draw is
      use GL;
   begin
      -- clear screen and depth buffer
      glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
      -- reset current modelview matrix
      glLoadIdentity;

      -- draw triangle
      glBegin (GL_TRIANGLES);
      glColor3f (1.0, 0.0, 0.0);
      glVertex3f ( 0.0,  1.0, 0.0);
      glColor3f (0.0, 1.0, 0.0);
      glVertex3f (-1.0, -1.0, 0.0);
      glColor3f (0.0, 0.0, 1.0);
      glVertex3f ( 1.0, -1.0, 0.0);
      glEnd;
   end Draw;

   procedure Frame_Handler (Frame_Delta : in Duration) is
   begin
      Draw;
      Lumen.Window.Swap (The_Window);
   end Frame_Handler;

begin

   Lumen.Window.Create (Win    => The_Window,
                        Name   => "OpenGL Demo",
                        Width  => 640,
                        Height => 480,
                        Events => (Lumen.Window.Want_Key_Press => True,
                                   Lumen.Window.Want_Exposure  => True,
                                   others                      => False));

   Resize_Scene (640, 480);
   Init_GL;

   Lumen.Events.Animate.Select_Events
     (Win   => The_Window,
      FPS   => Lumen.Events.Animate.Flat_Out,
      Frame => Frame_Handler'Unrestricted_Access,
      Calls => (Lumen.Events.Resized       => Resize_Handler'Unrestricted_Access,
                Lumen.Events.Close_Window  => Quit_Handler'Unrestricted_Access,
                others                     => Lumen.Events.No_Callback));

exception
   when Program_Exit =>
      null; -- normal termination
end OpenGL;


hOpenGL32 := DllCall("LoadLibrary", "Str", "opengl32")
Gui, +LastFound +Resize
hDC := DllCall("GetDC", "uInt", WinExist())

VarSetCapacity(pfd, 40, 0)
NumPut(40, pfd, 0, "uShort")
NumPut(1, pfd, 2, "uShort")
NumPut(37, pfd, 4, "uInt")
NumPut(24, pfd, 9, "uChar")
NumPut(16, pfd, 23, "uChar")
DllCall("SetPixelFormat", "uInt", hDC, "uInt", DllCall("ChoosePixelFormat", "uInt", hDC, "uInt", &pfd), "uInt", &pfd)

hRC := DllCall("opengl32\wglCreateContext", "uInt", hDC)
DllCall("opengl32\wglMakeCurrent", "uInt", hDC, "uInt", hRC)
Gui, Show, w640 h480, Triangle
OnExit, ExitSub
SetTimer, Paint, 50
return

Paint:
DllCall("opengl32\glClearColor", "Float", 0.3, "Float", 0.3, "Float", 0.3, "Float", 0)
DllCall("opengl32\glClear", "uInt", 0x4100) ;GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT

DllCall("opengl32\glShadeModel", "uInt", 0x1D01) ;GL_SMOOTH

DllCall("opengl32\glLoadIdentity")
DllCall("opengl32\glTranslatef", "Float", -15, "Float", -15, "Float", 0)

DllCall("opengl32\glBegin", "uInt", 0x0004) ;GL_TRIANGLES
DllCall("opengl32\glColor3f", "Float", 1, "Float", 0, "Float", 0)
DllCall("opengl32\glVertex2f", "Float", 0, "Float", 0)
DllCall("opengl32\glColor3f", "Float", 0, "Float", 1, "Float", 0)
DllCall("opengl32\glVertex2f", "Float", 30, "Float", 0)
DllCall("opengl32\glColor3f", "Float", 0, "Float", 0, "Float", 1)
DllCall("opengl32\glVertex2f", "Float", 0, "Float", 30)
DllCall("opengl32\glEnd")

DllCall("SwapBuffers", "uInt", hDC)
return

GuiSize:
DllCall("opengl32\glViewport", "Int", 0, "Int", 0, "Int", A_GuiWidth, "Int", A_GuiHeight)
DllCall("opengl32\glMatrixMode", "uInt", 0x1701) ;GL_PROJECTION
DllCall("opengl32\glLoadIdentity")
DllCall("opengl32\glOrtho", "Double", -30, "Double", 30, "Double", -30, "Double", 30, "Double", -30, "Double", 30)
DllCall("opengl32\glMatrixMode", "uInt", 0x1700) ;GL_MODELVIEW
return

GuiClose:
ExitApp

ExitSub:
DllCall("opengl32\wglMakeCurrent", "uInt", 0, "uInt", 0)
DllCall("opengl32\wglDeleteContext", "uInt", hRC)
DllCall("ReleaseDC", "uInt", hDC)
DllCall("FreeLibrary", "uInt", hOpenGL32)
ExitApp


PRAGMA INCLUDE <GL/gl.h> <GL/freeglut.h>
PRAGMA LDFLAGS GL glut

OPTION PARSE FALSE

SUB Triangle

    glViewport(0, 0, 640, 480)
    glOrtho(-30.0, 30.0, -30.0, 30.0, -30.0, 30.0)

    glClearColor(0.0, 0.0, 0.0, 1.0)
    glClear(GL_COLOR_BUFFER_BIT)

    glTranslatef(-15.0, -15.0, 0.0)

    glBegin(GL_TRIANGLES)
    glColor3f(1.0, 0.0, 0.0)
    glVertex2f(0.0, 0.0)
    glColor3f(0.0, 1.0, 0.0)
    glVertex2f(30.0, 0.0)
    glColor3f(0.0, 0.0, 1.0)
    glVertex2f(0.0, 30.0)
    glEnd()

    glutSwapBuffers()

END SUB

glutInit(&argc, argv)
glutInitWindowSize(640, 480)
glutCreateWindow("Triangle")

glutDisplayFunc(Triangle)
glutMainLoop()


      *FLOAT64

      SYS "LoadLibrary", "OPENGL32.DLL" TO opengl%
      SYS "GetProcAddress", opengl%, "wglCreateContext" TO `wglCreateContext`
      SYS "GetProcAddress", opengl%, "wglDeleteContext" TO `wglDeleteContext`
      SYS "GetProcAddress", opengl%, "wglMakeCurrent"   TO `wglMakeCurrent`
      SYS "GetProcAddress", opengl%, "glMatrixMode"     TO `glMatrixMode`
      SYS "GetProcAddress", opengl%, "glClear"          TO `glClear`
      SYS "GetProcAddress", opengl%, "glBegin"          TO `glBegin`
      SYS "GetProcAddress", opengl%, "glColor3dv"       TO `glColor3dv`
      SYS "GetProcAddress", opengl%, "glVertex2dv"      TO `glVertex2dv`
      SYS "GetProcAddress", opengl%, "glEnd"            TO `glEnd`

      MODE 8

      PFD_MAIN_PLANE = 0
      PFD_TYPE_RGBA = 0
      PFD_DOUBLEBUFFER = 1
      PFD_DRAW_TO_WINDOW = 4
      PFD_SUPPORT_OPENGL = &20

      GL_MODELVIEW  = &1700
      GL_TRIANGLES = 4
      GL_DEPTH_BUFFER_BIT = &00000100
      GL_COLOR_BUFFER_BIT = &00004000

      ON CLOSE PROCcleanup : QUIT
      ON ERROR PROCcleanup : SYS "MessageBox", @hwnd%, REPORT$, 0, 48 : QUIT

      DIM GLcolor{r#, g#, b#}, GLvertex{x#, y#}
      DIM pfd{nSize{l&,h&}, nVersion{l&,h&}, dwFlags%, iPixelType&, cColorBits&, \
      \       cRedBits&, cRedShift&, cGreenBits&, cGreenShift&, cBlueBits&, cBlueShift&, \
      \       cAlphaBits&, cAlphaShift&, cAccumBits&, cAccumRedBits&, cAccumGreenBits&, \
      \       cAccumBlueBits&, cAccumAlphaBits&, cDepthBits&, cStencilBits&, cAuxBuffers&, \
      \       iLayerType&, bReserved&, dwLayerMask%, dwVisibleMask%, dwDamageMask%}

      pfd.nSize.l& = DIM(pfd{})
      pfd.nVersion.l& = 1
      pfd.dwFlags% = PFD_DRAW_TO_WINDOW OR PFD_SUPPORT_OPENGL OR PFD_DOUBLEBUFFER
      pfd.dwLayerMask% = PFD_MAIN_PLANE
      pfd.iPixelType& = PFD_TYPE_RGBA
      pfd.cColorBits& = 24
      pfd.cDepthBits& = 16

      SYS "GetDC", @hwnd% TO ghDC%

      SYS "ChoosePixelFormat", ghDC%, pfd{} TO pixelformat%
      IF pixelformat% = 0 ERROR 100, "ChoosePixelFormat failed"

      SYS "SetPixelFormat", ghDC%, pixelformat%, pfd{} TO res%
      IF res% = 0 ERROR 100, "SetPixelFormat failed"

      SYS `wglCreateContext`, ghDC% TO ghRC%
      SYS `wglMakeCurrent`, ghDC%, ghRC%
      SYS `glMatrixMode`, GL_MODELVIEW

      REPEAT
        WAIT 2
        SYS `glClear`, GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT
        SYS `glBegin`, GL_TRIANGLES
        GLcolor.r# = 1.0 : GLcolor.g# = 0.0 : GLcolor.b# = 0.0
        SYS `glColor3dv`, GLcolor{}
        GLvertex.x# = 0.0 : GLvertex.y# = 0.8
        SYS `glVertex2dv`, GLvertex{}
        GLcolor.r# = 0.0 : GLcolor.g# = 1.0 : GLcolor.b# = 0.0
        SYS `glColor3dv`, GLcolor{}
        GLvertex.x# = 0.8 : GLvertex.y# = -0.8
        SYS `glVertex2dv`, GLvertex{}
        GLcolor.r# = 0.0 : GLcolor.g# = 0.0 : GLcolor.b# = 1.0
        SYS `glColor3dv`, GLcolor{}
        GLvertex.x# = -0.8 : GLvertex.y# = -0.8
        SYS `glVertex2dv`, GLvertex{}
        SYS `glEnd`
        SYS "SwapBuffers", ghDC%
      UNTIL FALSE
      END

      DEF PROCcleanup
      ON ERROR OFF
      ghRC% += 0 : IF ghRC% SYS `wglDeleteContext`, ghRC%  : ghRC% = 0
      ghDC% += 0 : IF ghDC% SYS "ReleaseDC", @hwnd%, ghDC% : ghDC% = 0
      ENDPROC


#include <stdlib.h>
#include <GL/gl.h>
#include <GL/glut.h>

void paint(void)
{
  glClearColor(0.3,0.3,0.3,0.0);
  glClear(GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT);

  glShadeModel(GL_SMOOTH);

  glLoadIdentity();
  glTranslatef(-15.0, -15.0, 0.0);

  glBegin(GL_TRIANGLES);
  glColor3f(1.0, 0.0, 0.0);
  glVertex2f(0.0, 0.0);
  glColor3f(0.0, 1.0, 0.0);
  glVertex2f(30.0, 0.0);
  glColor3f(0.0, 0.0, 1.0);
  glVertex2f(0.0, 30.0);
  glEnd();

  glFlush();
}

void reshape(int width, int height)
{
  glViewport(0, 0, width, height);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  glOrtho(-30.0, 30.0, -30.0, 30.0, -30.0, 30.0);
  glMatrixMode(GL_MODELVIEW);
}

int main(int argc, char *argv[])
{
  glutInit(&argc, argv);
  glutInitWindowSize(640, 480);
  glutCreateWindow("Triangle");

  glutDisplayFunc(paint);
  glutReshapeFunc(reshape);

  glutMainLoop();

  return EXIT_SUCCESS;
}


using OpenTK;
using OpenTK.Graphics;
namespace OpenGLTest
{
    class Program
    {
        static void Main(string[] args)
        {
            //Create the OpenGL window
            GameWindow window = new GameWindow(640, 480, GraphicsMode.Default, "OpenGL Example");

            GL.MatrixMode(MatrixMode.Projection);
            GL.LoadIdentity();
            GL.Ortho(-30.0, 30.0, -30.0, 30.0, -30.0, 30.0);
            GL.MatrixMode(MatrixMode.Modelview);

            //Add event handler to render to the window when called
            window.RenderFrame += new RenderFrameEvent(a_RenderFrame);
            //Starts the window's updating/rendering events
            window.Run();
        }
        static void a_RenderFrame(GameWindow sender, RenderFrameEventArgs e)
        {
            GL.ClearColor(0.3f, 0.3f, 0.3f, 0f);
            GL.Clear(ClearBufferMask.ColorBufferBit | ClearBufferMask.DepthBufferBit);

            GL.ShadeModel(ShadingModel.Smooth);

            GL.LoadIdentity();
            GL.Translate(-15.0f, -15.0f, 0.0f);

            GL.Begin(BeginMode.Triangles);
            GL.Color3(1.0f, 0.0f, 0.0f);
            GL.Vertex2(0.0f, 0.0f);
            GL.Color3(0.0f, 1.0f, 0.0f);
            GL.Vertex2(30f, 0.0f);
            GL.Color3(0.0f, 0.0f, 1.0f);
            GL.Vertex2(0.0f, 30.0f);
            GL.End();
            //Swaps the buffers on the window so that what we draw becomes visible
            sender.SwapBuffers();
        }
    }
}


(use 'penumbra.opengl)
(require '[penumbra.app :as app])

(defn init [state]
  (app/title! "Triangle")
  (clear-color 0.3 0.3 0.3 0)
  (shade-model :smooth)
  state)

(defn reshape [[x y w h] state]
  (ortho-view -30 30 -30 30 -30 30)
  (load-identity)
  (translate -15 -15)
  state)

(defn display [[dt time] state]
  (draw-triangles
    (color 1 0 0) (vertex 0 0)
    (color 0 1 0) (vertex 30 0)
    (color 0 0 1) (vertex 0 30)))

(app/start {:display display, :reshape reshape, :init init} {})


(defun draw-triangle (x y &key (z 0) (type 'right))
  (case type
    (right
     (gl:with-primitive :triangles
       (gl:color 0 0 1)
       (gl:vertex x y z)
       (gl:color 0 1 0)
       (gl:vertex x (- y 1) z)
       (gl:color 1 0 0)
       (gl:vertex (+ x 1) (1- y) z)))
    (equilateral
     (gl:with-primitive :triangles
       (gl:color 0 0 1)
       (gl:vertex (+ x 0.5) y z)
       (gl:color 1 0 0)
       (gl:vertex (- x 0.5) (- y 1) z)
       (gl:color 0 1 0)
       (gl:vertex (+ x 1.5) (- y 1) z)))))

(defun draw-update ()
  (gl:clear :color-buffer :depth-buffer :color-buffer-bit)
  (gl:matrix-mode :modelview)
  (gl:load-identity)

  (gl:color 1.0 1.0 1.0)
  (gl:translate 0 0 -2)

  (draw-triangle -0.5 0.5 :type 'equilateral))

(defun main-loop ()
  (sdl:with-events ()
    (:quit-event () t)
    (:key-down-event (:key key)
                     (cond ((sdl:key= key :sdl-key-escape)
                            (sdl:push-quit-event))))
    (:idle ()
           (draw-update)
           (sdl:update-display))))

(defun setup-gl (w h)
  (gl:clear-color 0.5 0.5 0.5 1)
  (gl:clear-depth 1)

  (gl:viewport 0 0 w h)

  (gl:depth-func :lequal)
  (gl:hint :perspective-correction-hint :nicest)
  (gl:shade-model :smooth)
  (gl:enable :depth-test :cull-face)

  (gl:matrix-mode :projection)
  (gl:load-identity)
  (glu:perspective 45 (/ w (max h 1)) 0.1 20)

  (gl:matrix-mode :modelview)
  (gl:load-identity))

(defun triangle (&optional (w 640) (h 480))
  (sdl:with-init ()
    (sdl:set-gl-attribute :SDL-GL-DEPTH-SIZE 16)
    (sdl:window w h
                :bpp 32
                :flags sdl:sdl-opengl
                :title-caption "Rosettacode.org OpenGL Demo")
    (setup-gl w h)
    (setf (sdl:frame-rate) 2)
    (main-loop)))


module opengl_sample; // file name + directory
import dglut.core, dglut.window, dglut.opengl;

void main() {
  with (new Canvas) {
    setName("Triangle");
    map;

    onResize = (Canvas self) { // A delegate literal that takes a parameter.
      with (self) glViewport(0, 0, width, height);
      MatrixMode.Projection.Identity; // For functions without parameters, the () can be omitted.
      glOrtho(-30, 30, -30, 30, -30, 30);
      MatrixMode.Modelview;
    };

    onDisplay=(Canvas self) {
      scope(exit) self.swap; // Scope guards ease exception-safe programming
      glClearColor(0.3f, 0.3f, 0.3f, 0f);
      glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);
      glLoadIdentity;
      // A convenience wrapper around glTranslatef. Supports numbers, arrays and vectors.
      Translate(-15, -15, 0);
      // This is a delegate literal as well. Triangles is a wrapper around glBegin and glEnd.
      Triangles = {
        Color(1f, 0f, 0f); Vertex(0, 0);
        Color(0f, 1f, 0f); Vertex(30, 0);
        Color(0f, 0f, 1f); Vertex(0, 30);
      };
    };
  }
  loop;
}


program OpenGLTriangle;

{$APPTYPE CONSOLE}

uses
  System.Classes,
  Sample.App,
  Winapi.OpenGL,
  System.UITypes;

type
  TTriangleApp = class(TApplication)
  public
    procedure Initialize; override;
    procedure Update(const ADeltaTimeSec, ATotalTimeSec: Double); override;
    procedure Shutdown; override;
    procedure KeyDown(const AKey: Integer; const AShift: TShiftState); override;
  end;

{ TTriangleApp }

procedure TTriangleApp.Initialize;
begin
  inherited;
  glViewport(0, 0, width, height);

  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  glOrtho(-30.0, 30.0, -30.0, 30.0, -30.0, 30.0);
  glMatrixMode(GL_MODELVIEW);
end;

procedure TTriangleApp.KeyDown(const AKey: Integer; const AShift: TShiftState);
begin
  inherited;
  if (AKey = vkEscape) then
    Terminate;
end;

procedure TTriangleApp.Shutdown;
begin
  inherited;
  // Writeln('App is Shutdown');
end;

procedure TTriangleApp.Update(const ADeltaTimeSec, ATotalTimeSec: Double);
begin
  inherited;

  glClearColor(0.3, 0.3, 0.3, 0.0);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glShadeModel(GL_SMOOTH);

  glLoadIdentity();
  glTranslatef(-15.0, -15.0, 0.0);

  glBegin(GL_TRIANGLES);
  glColor3f(1.0, 0.0, 0.0);
  glVertex2f(0.0, 0.0);
  glColor3f(0.0, 1.0, 0.0);
  glVertex2f(30.0, 0.0);
  glColor3f(0.0, 0.0, 1.0);
  glVertex2f(0.0, 30.0);
  glEnd();

  glFlush();
end;

begin
  RunApp(TTriangleApp, 640, 480, 'OpenGL Triangle');
end.


package Tables is

   type Table is private;

   type Ordering is (Lexicographic, Psionic, ...); -- add others

   procedure Sort (It               : in out Table;
                   Order_By         : in Ordering := Lexicographic;
                   Column           : in Positive := 1;
                   Reverse_Ordering : in Boolean  := False);

private
   ... -- implementation specific
end Tables;


#include <GL/gl.h>
import "ecere"

class GLTriangle : Window
{
   text = "Triangle";
   displayDriver = "OpenGL";
   background = activeBorder;
   nativeDecorations = true;
   borderStyle = sizable;
   hasMaximize = true, hasMinimize = true, hasClose = true;
   size = { 640, 480 };

   void OnRedraw(Surface surface)
   {
      glMatrixMode(GL_PROJECTION);
      glLoadIdentity();
      glOrtho(-30, 30, -30, 30, -30, 30);
      glMatrixMode(GL_MODELVIEW);
      glLoadIdentity();
      glTranslatef(-15, -15, 0);
      glShadeModel(GL_SMOOTH);

      glBegin(GL_TRIANGLES);
      glColor3f(1, 0, 0);
      glVertex2f(0, 0);
      glColor3f(0, 1, 0);
      glVertex2f(30, 0);
      glColor3f(0, 0, 1);
      glVertex2f(0, 30);
      glEnd();
   }
}

GLTriangle window {};


include get.e
include dll.e
include machine.e
include msgbox.e
include constants.ew
include GLfunc.ew
include GLconst.ew

without warning

atom hRC, hDC, hWnd, hInstance, ClassName
sequence keys keys = repeat(0,256)  -- array to hold key presses

integer active, fullscreen, retval
active = TRUE
fullscreen = TRUE
hRC = NULL
hDC = NULL
hWnd = NULL
hInstance = NULL

atom rtri, rquad
rtri = 0.0
rquad = 0.0

integer dmScreenSettings, WindowRect

procedure ReSizeGLScene(integer width, integer height)
    if height = 0 then
        height = 1
    end if
    c_proc(glViewport,{0,0,width,height})
    c_proc(glMatrixMode,{GL_PROJECTION})
    c_proc(glLoadIdentity,{})
    c_proc(gluPerspective,{45.0,width/height,0.1,100.0})
    c_proc(glMatrixMode,{GL_MODELVIEW})
    c_proc(glLoadIdentity,{})
end procedure

procedure InitGL()
    c_proc(glShadeModel,{GL_SMOOTH})
    c_proc(glClearColor,{0.0,0.0,0.0,0.0})
    c_proc(glClearDepth,{1.0})
    c_proc(glEnable,{GL_DEPTH_TEST})
    c_proc(glDepthFunc,{GL_LEQUAL})
    c_proc(glHint,{GL_PERSPECTIVE_CORRECTION_HINT,GL_NICEST})
end procedure

function DrawGLScene()
    c_proc(glClear, {or_bits(GL_COLOR_BUFFER_BIT,GL_DEPTH_BUFFER_BIT)})
    c_proc(glLoadIdentity, {})
    c_proc(glTranslatef, {-1.5,0.0,-6.0})
    c_proc(glRotatef, {rtri,0.0,1.0,0.0})
    c_proc(glBegin, {GL_TRIANGLES})
    c_proc(glColor3f, {1.0,0.0,0.0})
    c_proc(glVertex3f, {0.0,1.0,0.0})
    c_proc(glColor3f, {0.0,1.0,0.0})
    c_proc(glVertex3f, {-1.0,-1.0,0.0})
    c_proc(glColor3f, {0.0,0.0,1.0})
    c_proc(glVertex3f, {1.0,-1.0,0.0})
    c_proc(glEnd, {})
    c_proc(glLoadIdentity, {})
    c_proc(glTranslatef, {1.5,0.0,-6.0})
    c_proc(glRotatef, {rquad,1.0,0.0,0.0})
    c_proc(glColor3f, {0.5,0.5,1.0})
    c_proc(glBegin, {GL_QUADS})
    c_proc(glVertex3f, {1.0,1.0,0.0})
    c_proc(glVertex3f, {-1.0,1.0,0.0})
    c_proc(glVertex3f, {-1.0,-1.0,0.0})
    c_proc(glVertex3f, {1.0,-1.0,0.0})
    c_proc(glEnd, {})
    rtri += 0.2
    rquad -= 0.15
    return TRUE
end function

procedure KillGLWindow()
    if fullscreen then
        if c_func(ChangeDisplaySettingsA,{NULL,0}) then end if
        if c_func(ShowCursor,{TRUE}) then end if
    end if
    if hRC then
        if c_func(wglMakeCurrent,{NULL,NULL}) then end if
        if c_func(wglDeleteContext,{hRC}) then end if
        hRC = NULL
    end if
    if hRC and not c_func(ReleaseDC,{hWnd,hDC}) then
        hDC = NULL
    end if
    if hWnd and not c_func(DestroyWindow,{hWnd}) then
        hWnd = NULL
    end if
    if dmScreenSettings then
        free(dmScreenSettings)
    end if
    free(WindowRect)
end procedure

function WndProc(atom hWnd, integer uMsg, atom wParam, atom lParam)
    if uMsg = WM_ACTIVATE then
        if not floor(wParam/#10000) then
            active = TRUE
        else
            active = FALSE
        end if
    elsif  uMsg = WM_SYSCOMMAND then
        if wParam = SC_SCREENSAVE then end if
        if wParam = SC_MONITORPOWER then end if
    elsif uMsg = WM_CLOSE then
        c_proc(PostQuitMessage,{0})
    elsif uMsg = WM_KEYDOWN then
        keys[wParam] = TRUE
    elsif uMsg = WM_KEYUP then
        keys[wParam] = FALSE
    elsif uMsg = WM_SIZE then
        ReSizeGLScene(and_bits(lParam,#FFFF),floor(lParam/#10000))
    end if
    return c_func(DefWindowProcA,{hWnd, uMsg, wParam, lParam})
end function

integer wc wc = allocate(40)
function ClassRegistration()
integer WndProcAddress, id
    id = routine_id("WndProc")
    if id = -1 then
    puts(1, "routine_id failed!\n")
    abort(1)
    end if
    WndProcAddress = call_back(id)
    hInstance = c_func(GetModuleHandleA,{NULL})
    ClassName = allocate_string("OpenGL")
    poke4(wc,or_all({CS_HREDRAW, CS_VREDRAW, CS_OWNDC}))
    poke4(wc+4,WndProcAddress)
    poke4(wc+8,0)
    poke4(wc+12,0)
    poke4(wc+16,hInstance)
    poke4(wc+20,c_func(LoadIconA,{NULL,IDI_WINLOGO}))
    poke4(wc+24,c_func(LoadCursorA,{NULL, IDC_ARROW}))
    poke4(wc+28,NULL)
    poke4(wc+32,NULL)
    poke4(wc+36,ClassName)
    if not c_func(RegisterClassA,{wc}) then
        retval = message_box("Failed to register class","Error", or_bits(MB_OK,MB_ICONINFORMATION))
        return FALSE
    else
        return TRUE
    end if
end function

integer regd regd = FALSE
procedure CreateGLWindow(atom title, integer width, integer height, integer bits, integer fullscreenflag)
    atom PixelFormat, pfd, dwExStyle, dwStyle
    sequence s
    if regd = FALSE then
        if ClassRegistration() then
            regd = TRUE
        end if
    end if
    fullscreen = fullscreenflag
    if fullscreen then
        dmScreenSettings = allocate(156)
        mem_set(dmScreenSettings,0,156)
        s = int_to_bytes(156)
        poke(dmScreenSettings + 36,{s[1],s[2]})
        poke4(dmScreenSettings + 40,or_all({DM_BITSPERPEL,DM_PELSWIDTH,DM_PELSHEIGHT}))
        poke4(dmScreenSettings + 104, bits)
        poke4(dmScreenSettings + 108, width)
        poke4(dmScreenSettings + 112, height)
        if c_func(ChangeDisplaySettingsA,{dmScreenSettings,CDS_FULLSCREEN}) != DISP_CHANGE_SUCCESSFUL then
            if message_box("The requested fullscreen mode is not supported by\nyour video card. " &
                           "Use windowed mode instead?","Error", or_bits(MB_YESNO,MB_ICONEXCLAMATION)) = IDYES then
            else
                retval = message_box("Program will now close","Error",or_bits(MB_OK,MB_ICONSTOP))
            end if
        end if
    else
        dmScreenSettings = NULL
    end if
    if fullscreen then
        dwExStyle = WS_EX_APPWINDOW
        dwStyle = WS_POPUP
        if c_func(ShowCursor,{FALSE}) then end if
    else
        dwExStyle = or_bits(WS_EX_APPWINDOW,WS_EX_WINDOWEDGE)
        dwStyle = WS_OVERLAPPEDWINDOW
    end if
    WindowRect = allocate(16)
    poke4(WindowRect,0)
    poke4(WindowRect + 4,width)
    poke4(WindowRect + 8, 0)
    poke4(WindowRect + 12, height)
    if c_func(AdjustWindowRectEx,{WindowRect, dwStyle, FALSE, dwExStyle}) then end if
    hWnd = c_func(CreateWindowExA,{dwExStyle,  --extended window style
                                   ClassName,  --class
                                   title,      --window caption
                                   or_all({WS_CLIPSIBLINGS,WS_CLIPCHILDREN,dwStyle}),  --window style
                                   0,
                                   0,
                                   peek4u(WindowRect + 4) - peek4u(WindowRect),
                                   peek4u(WindowRect + 12) - peek4u(WindowRect + 8),
                                   NULL,
                                   NULL,
                                   hInstance,
                                   NULL})
    if hWnd = NULL then
        KillGLWindow()
        retval = message_box("Window creation error","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
    end if
    pfd = allocate(40)  --PIXELFORMATDESCRIPTOR
    mem_set(pfd,0,40)
    poke(pfd, 40)  --size of pfd structure
    poke(pfd + 2, 1) --version
    poke4(pfd + 4, or_all({PFD_DRAW_TO_WINDOW,PFD_SUPPORT_OPENGL,PFD_DOUBLEBUFFER})) --properties flags
    poke(pfd + 8, PFD_TYPE_RGBA)  --request an rgba format
    poke(pfd + 9, 24)  --select color depth
    poke(pfd + 23, 24)  --32bit Z-buffer

    hDC = c_func(GetDC,{hWnd})  --create GL device context to match window device context
    if not hDC then
        KillGLWindow()
        retval = message_box("Can't create a GL device context","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
    end if
    PixelFormat = c_func(ChoosePixelFormat,{hDC,pfd})  --find a pixel format matching PIXELFORMATDESCRIPTOR
    if not PixelFormat then
        KillGLWindow()
        retval = message_box("Can't find a suitable pixel format","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
    end if
    if not (c_func(SetPixelFormat,{hDC,PixelFormat,pfd})) then  --set the pixel format
        KillGLWindow()
        retval = message_box("Can't set the pixel format","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
    end if
    if not c_func(DescribePixelFormat, {hDC,PixelFormat,40,pfd}) then
        retval = message_box("Can't describe the pixel format","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
    end if
    hRC = c_func(wglCreateContext,{hDC})  --create GL rendering context
    if not hRC then
        KillGLWindow()
        retval = message_box("Can't create a GL rendering context","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
    end if
    if not (c_func(wglMakeCurrent,{hDC,hRC})) then  --make the GL rendering context active
        KillGLWindow()
        retval = message_box("Can't activate the GL rendering context","Error",or_bits(MB_OK,MB_ICONEXCLAMATION))
    end if
    retval = c_func(ShowWindow,{hWnd,SW_SHOW}) --show the window
    retval = c_func(SetForegroundWindow,{hWnd}) --set it to always be in foreground
    retval = c_func(SetFocus,{hWnd}) --give it focus
    ReSizeGLScene(width, height)  --draw the GL scene to match the window size
    InitGL()  --initialize OpenGL
end procedure

integer MSG MSG = allocate(28)
integer title title = allocate_string("OpenGL")
procedure WinMain()
integer done, msg_message
    done = FALSE
    if message_box("Would you like to run in fullscreen mode?","Start Fullscreen?",or_bits(MB_YESNO,MB_ICONQUESTION)) = IDNO then
        fullscreen = FALSE
    else
        fullscreen = TRUE
    end if
    CreateGLWindow(title,640,480,24,fullscreen)
    while not done do
        if c_func(PeekMessageA,{MSG,NULL,0,0,PM_REMOVE}) then
            msg_message = peek4u(MSG+4)
            if msg_message = WM_QUIT then
                done = TRUE
            else
                retval = c_func(TranslateMessage,{MSG})
                retval = c_func(DispatchMessageA,{MSG})
            end if
        else
            if ((active and not DrawGLScene()) or keys[VK_ESCAPE]) then
                done = TRUE
            else
                retval = c_func(SwapBuffers,{hDC})
                if keys[VK_F1] then
                    keys[VK_F1] = FALSE
                    KillGLWindow()
                    if fullscreen = 0 then
                        fullscreen = 1
                    else
                        fullscreen = 0
                    end if
                    CreateGLWindow(title,640,480,24,fullscreen)
                end if
            end if
        end if
    end while
    KillGLWindow()
end procedure

WinMain()


# as the options have distinct types (INT, BOOL and PROC( STRING, STRING )INT) the       #
# easiest way to support these optional parameters in Algol 68 would be to have an array #
# with elements of these types                                                           #
# See the Named Arguments sample for cases where the option types are not distinct       #

# default comparison function #
PROC default compare = ( STRING a, b )INT: IF a < b THEN -1 ELIF a = b THEN 0 ELSE 1 FI;

# sorting procedure #
PROC configurable sort = ( [,]STRING data, []UNION( INT, BOOL, PROC( STRING, STRING )INT ) options )VOID:
BEGIN
    # set initial values for the options #
    INT    sort column                   := 2 LWB data;
    BOOL   reverse sort                  := FALSE;
    PROC( STRING, STRING )INT comparator := default compare;
    # overide from the supplied options #
    FOR opt pos FROM LWB options TO UPB options DO
        CASE options[ opt pos ]
          IN ( PROC( STRING, STRING )INT p ): comparator   := p
           , ( INT c ):                       sort column  := c
           , ( BOOL r ):                      reverse sort := r
        ESAC
    OD
    # do the sort .... #
END # configurable sort # ;

# example calls #
[ 1 : 2, 1 : 3 ]STRING data := ( ( "a", "bb", "cde" ), ( "x", "abcdef", "Q" ) );

# sort data, default comparison, first column, reverse order #
configurable sort( data, ( TRUE ) );
# sort data, second column, ignore first chaacter when sorting, normal order #
configurable sort( data, ( 2, ( STRING a, STRING b )INT: default compare( a[ LWB a + 1 : ], b[ LWB b + 1 : ] ) ) );
# default sort #
configurable sort( data, () )


on sortTable(x)
	set {sortOrdering, sortColumn, sortReverse} to {sort_lexicographic, 1, false}
	try
		set sortOrdering to x's ordering
	end try
	try
		set sortColumn to x's column
	end try
	try
		set sortReverse to x's reverse
	end try
	return sortOrdering's sort(x's sequence, sortColumn, sortReverse)
end sortTable

script sort_lexicographic
	on sort(table, column, reverse)
		-- Implement lexicographic Sorting process here.
		return table
	end sort
end script


USING: kernel math math.rectangles opengl.gl sequences ui
ui.gadgets ui.render ;
IN: rosettacode.opengl

TUPLE: triangle-gadget < gadget ;

: reshape ( width height -- )
    [ 0 0 ] 2dip glViewport
    GL_PROJECTION glMatrixMode
    glLoadIdentity
    -30.0 30.0 -30.0 30.0 -30.0 30.0 glOrtho
    GL_MODELVIEW glMatrixMode ;

: paint ( -- )
    0.3 0.3 0.3 0.0 glClearColor
    GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
    GL_SMOOTH glShadeModel
    glLoadIdentity
    -15.0 -15.0 0.0 glTranslatef
    GL_TRIANGLES glBegin
    1.0 0.0 0.0 glColor3f 0.0 0.0 glVertex2f
    0.0 1.0 0.0 glColor3f 30.0 0.0 glVertex2f
    0.0 0.0 1.0 glColor3f 0.0 30.0 glVertex2f
    glEnd
    glFlush ;

M: triangle-gadget pref-dim* drop { 640 480 } ;
M: triangle-gadget draw-gadget*
    rect-bounds nip first2 reshape paint ;

: triangle-window ( -- )
   [ triangle-gadget new "Triangle" open-window ] with-ui ;
MAIN: triangle-window


import glconst import float
glconst also float also opengl also


#include "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glu.bi"

screen 18, 16, , 2

glViewport 0, 0, 640, 480                      'Set the viewport
glMatrixMode GL_PROJECTION                     ' Select projection
glLoadIdentity                                 ' Set this to default
gluPerspective 45.0, 640./480., 0.1, 100.0   ' Set perspective view options
glMatrixMode GL_MODELVIEW                      ' Set to modelview mode
glLoadIdentity                                 ' ...and set it to default
glClearColor 0.5, 0.5, 0.5, 0.0               ' Set clearscreen color to middle grey
glShadeModel GL_SMOOTH                         ' set to smooth shading
glClearDepth 1.0                               ' Allow the deletion of the depth buffer
glEnable GL_DEPTH_TEST                         ' turn on depth testing
glDepthFunc GL_LEQUAL                          ' The Type Of Depth Test To Do
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST  ' niceness tweaks

do

glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT  ' clear screen and depth
glLoadIdentity

glTranslatef 0.0f, 0.0f, -6.0f                ' move camera back so we can see the triangle

glBegin GL_TRIANGLES                          ' Drawing Using Triangles
    glColor3f 1.0f, 0.0f, 0.0f                  ' red
    glVertex3f  0.0f, 1.0f, 0.0f              ' Top
    glColor3f 0.0f, 1.0f, 0.0f                  ' green
    glVertex3f -1.0f,-1.0f, 0.0f              ' Bottom Left
    glColor3f 0.0f, 0.0f, 1.0f                  ' blue
    glVertex3f  1.0f,-1.0f, 0.0f              ' Bottom Right
glEnd                                         ' Finished Drawing The Triangle

flip

loop while inkey = ""


sortTable: function [tbl][
    column: "0"
    reversed?: false
    unless null? c: <= attr 'column -> column: to :string c
    unless null? attr 'reverse -> reversed?: true

    result: new sort.by: column map tbl 'r [
        to :dictionary flatten couple 0..dec size r r
    ]

    if reversed? -> reverse 'result

    return map result 'r -> values r
]

printTable: function [tbl, title][
    print ["==" title]
    loop tbl 'row [
        print row
    ]
    print ""
]

lst: [
    ["a", "b", "c"]
    ["", "q", "z"]
    ["zap", "zip", "Zot"]
]

printTable sortTable lst "Default sort"
printTable sortTable.column:1 lst "Sorting by column=1"
printTable sortTable.reverse lst "Sorting, reversed"
printTable sortTable.reverse.column:1 lst "Sorting by column=1, reversed"


Gosub start ; create and show the gui
sort_table("Text", column := 2, reverse := 1)  ;  lexicographic sort
Sleep, 2000
sort_table("Integer", column := 2, reverse := 1)  ;  numerical sort
Return

start:
  Gui, Add, ListView, r20 w200, 1|2|3
  data =
  (
  1,2,3
  b,q,z
  c,z,z
  )
  Loop, Parse, data, `n
  {
    StringSplit, row, A_LoopField, `,
    LV_Add(row, row1, row2, row3)
  }
  LV_ModifyCol(50)  ; Auto-size columns
  Gui, Show
Return

; The function supporting named, defaulted arguments
sort_table(ordering = "Text", column = 0, reverse = 0)
{
  If reverse
    desc = desc
  LV_ModifyCol(column, "sort" . desc . " " . ordering)
}

GuiClose:
  ExitApp


package main

import (
    gl "github.com/chsc/gogl/gl21"
    "github.com/go-gl/glfw/v3.2/glfw"
    "log"
    "runtime"
)

// Window dimensions.
const (
    Width  = 640
    Height = 480
)

func check(err error) {
    if err != nil {
        log.Fatal(err)
    }
}

func main() {
    // OpenGL requires a dedicated OS thread.
    runtime.LockOSThread()
    defer runtime.UnlockOSThread()

    err := glfw.Init()
    check(err)
    defer glfw.Terminate()

    // Open window with the specified dimensions.
    window, err := glfw.CreateWindow(Width, Height, "Triangle", nil, nil)
    check(err)

    window.MakeContextCurrent()

    err = gl.Init()
    check(err) /* may need to comment out this line for this program to work on Windows 10 */

    // Initiate viewport.
    resize(Width, Height)

    // Register that we are interested in receiving close and resize events.
    window.SetCloseCallback(func(w *glfw.Window) {
        return
    })
    window.SetSizeCallback(func(w *glfw.Window, width, height int) {
        resize(width, height)
    })

    for !window.ShouldClose() {
        draw()
        window.SwapBuffers()
        glfw.PollEvents()
    }
}

// resize resizes the window to the specified dimensions.
func resize(width, height int) {
    gl.Viewport(0, 0, gl.Sizei(width), gl.Sizei(height))
    gl.MatrixMode(gl.PROJECTION)
    gl.LoadIdentity()
    gl.Ortho(-30.0, 30.0, -30.0, 30.0, -30.0, 30.0)
    gl.MatrixMode(gl.MODELVIEW)
}

// draw draws the triangle.
func draw() {
    gl.ClearColor(0.3, 0.3, 0.3, 0.0)
    gl.Clear(gl.COLOR_BUFFER_BIT | gl.DEPTH_BUFFER_BIT)

    gl.ShadeModel(gl.SMOOTH)

    gl.LoadIdentity()
    gl.Translatef(-15.0, -15.0, 0.0)

    gl.Begin(gl.TRIANGLES)

    gl.Color3f(1.0, 0.0, 0.0)
    gl.Vertex2f(0.0, 0.0)

    gl.Color3f(0.0, 1.0, 0.0)
    gl.Vertex2f(30.0, 0.0)

    gl.Color3f(0.0, 0.0, 1.0)
    gl.Vertex2f(0.0, 30.0)

    gl.End()

    gl.Flush()
}


100 DEF PROC sort_table REF t$(), ordering, col, reverse
110   DEFAULT ordering=0, col=1, reverse=0
120   REM implementation of sort not shown
190 END PROC


      DIM table$(100,100)
      PROCsort_default(table$())
      PROCsort_options(table$(), TRUE, 1, FALSE)
      END

      DEF PROCsort_options(table$(), ordering%, column%, reverse%)
      DEF PROCsort_default(table$()) : LOCAL ordering%, column%, reverse%
      REM The sort goes here, controlled by the options
      REM Zero/FALSE values for the options shall select the defaults
      ENDPROC


( ( sortTable
  =   table ordering column reverse
    .     !arg
        : ( ?table
          .   ( ? (ordering.?ordering) ?
              | ?&lexicographic:?ordering
              )
            : ( ? (column.?column) ?
              | ?&1:?column
              )
            : ( ? (reverse.?reverse) ?
              | ?&no:?reverse
              )
          )
      & (...)
  )
&     (12.Claes.left)
      (11.Otto.right)
      (8.Frederikke.middle)
  : ?table
& sortTable$(!table.(column.2) (reverse.yes))
);


#include <stdlib.h>
#include <stdarg.h>
#include <stdio.h>
#include <ctype.h>
#include <string.h>

typedef const char * String;
typedef struct sTable {
    String * *rows;
    int      n_rows,n_cols;
} *Table;

typedef int (*CompareFctn)(String a, String b);

struct {
   CompareFctn  compare;
   int   column;
   int   reversed;
} sortSpec;

int CmprRows( const void *aa, const void *bb)
{
   String *rA = *(String *const *)aa;
   String *rB = *(String *const *)bb;
   int sortCol = sortSpec.column;

   String left = sortSpec.reversed ? rB[sortCol] : rA[sortCol];
   String right = sortSpec.reversed ? rA[sortCol] : rB[sortCol];
   return sortSpec.compare( left, right );
}

/** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 * tbl parameter is a table of rows of strings
 * argSpec is a string containing zero or more of the letters o,c,r
 * if o is present - the corresponding optional argument is a function which
 *      determines the ordering of the strings.
 * if c is present - the corresponding optional argument is an integer that
 *      specifies the column to sort on.
 * if r is present - the corresponding optional argument is either
 *      true(nonzero) or false(zero) and if true, the sort will b in reverse order
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
int sortTable(Table tbl, const char* argSpec,... )
{
   va_list vl;
   const char *p;
   int c;
   sortSpec.compare = &strcmp;
   sortSpec.column = 0;
   sortSpec.reversed = 0;

   va_start(vl, argSpec);
   if (argSpec)
      for (p=argSpec; *p; p++) {
         switch (*p) {
         case 'o':
            sortSpec.compare = va_arg(vl,CompareFctn);
            break;
         case 'c':
            c = va_arg(vl,int);
            if ( 0<=c && c<tbl->n_cols)
               sortSpec.column  = c;
            break;
         case 'r':
            sortSpec.reversed = (0!=va_arg(vl,int));
            break;
         }
      }
   va_end(vl);
   qsort( tbl->rows, tbl->n_rows, sizeof(String *), CmprRows);
   return 0;
}

void printTable( Table tbl, FILE *fout, const char *colFmts[])
{
   int row, col;

   for (row=0; row<tbl->n_rows; row++) {
      fprintf(fout, "   ");
      for(col=0; col<tbl->n_cols; col++) {
         fprintf(fout, colFmts[col], tbl->rows[row][col]);
      }
      fprintf(fout, "\n");
   }
   fprintf(fout, "\n");
}

int ord(char v)
{
    return v-'0';
}

/* an alternative comparison function */
int cmprStrgs(String s1, String s2)
{
    const char *p1 = s1;
    const char *p2 = s2;
    const char *mrk1, *mrk2;
    while ((tolower(*p1) == tolower(*p2)) && *p1) {
       p1++; p2++;
    }
    if (isdigit(*p1) && isdigit(*p2)) {
        long v1, v2;
        if ((*p1 == '0') ||(*p2 == '0')) {
            while (p1 > s1) {
                p1--; p2--;
                if (*p1 != '0') break;
            }
            if (!isdigit(*p1)) {
                p1++; p2++;
            }
        }
        mrk1 = p1; mrk2 = p2;
        v1 = 0;
        while(isdigit(*p1)) {
            v1 = 10*v1+ord(*p1);
            p1++;
        }
        v2 = 0;
        while(isdigit(*p2)) {
            v2 = 10*v2+ord(*p2);
            p2++;
        }
        if (v1 == v2)
           return(p2-mrk2)-(p1-mrk1);
        return v1 - v2;
    }
    if (tolower(*p1) != tolower(*p2))
       return (tolower(*p1) - tolower(*p2));
    for(p1=s1, p2=s2; (*p1 == *p2) && *p1; p1++, p2++);
    return (*p1 -*p2);
}

int main()
{
   const char *colFmts[] = {" %-5.5s"," %-5.5s"," %-9.9s"};
   String r1[] = { "a101", "red",  "Java" };
   String r2[] = { "ab40", "gren", "Smalltalk" };
   String r3[] = { "ab9",  "blue", "Fortran" };
   String r4[] = { "ab09", "ylow", "Python" };
   String r5[] = { "ab1a", "blak", "Factor" };
   String r6[] = { "ab1b", "brwn", "C Sharp" };
   String r7[] = { "Ab1b", "pink", "Ruby" };
   String r8[] = { "ab1",  "orng", "Scheme" };

   String *rows[] = { r1, r2, r3, r4, r5, r6, r7, r8 };
   struct sTable table;
   table.rows = rows;
   table.n_rows = 8;
   table.n_cols = 3;

   sortTable(&table, "");
   printf("sort on col 0, ascending\n");
   printTable(&table, stdout, colFmts);

   sortTable(&table, "ro", 1, &cmprStrgs);
   printf("sort on col 0, reverse.special\n");
   printTable(&table, stdout, colFmts);

   sortTable(&table, "c", 1);
   printf("sort on col 1, ascending\n");
   printTable(&table, stdout, colFmts);

   sortTable(&table, "cr", 2, 1);
   printf("sort on col 2, reverse\n");
   printTable(&table, stdout, colFmts);
   return 0;
}


import Graphics.Rendering.OpenGL
import Graphics.UI.GLUT

main = do
  getArgsAndInitialize
  createWindow "Triangle"
  displayCallback $= display

  matrixMode $= Projection
  loadIdentity
  ortho2D 0 30 0 30
  matrixMode $= Modelview 0

  mainLoop

display = do
  clear [ColorBuffer]
  renderPrimitive Triangles $ do
    corner 1 0 0 5 5
    corner 0 1 0 25 5
    corner 0 0 1 5 25
  swapBuffers

corner r g b x y = do color  (Color3  r g b :: Color3  GLfloat)
                      vertex (Vertex2 x y   :: Vertex2 GLfloat)


coclass 'example'
(coinsert[require) 'jzopengl'

create=:3 :0
  ogl=: ''conew'jzopengl'
  wd 'pc p;cc c isigraph opengl rightmove bottommove;pas 0 0;pshow;'
)

p_close=: destroy=:3 :0
  destroy__ogl''
  wd'pclose'
  codestroy''
)

corner=:4 :0
  glColor3d x
  glVertex2d y
)

p_c_paint=:3 :0
  rc__ogl''
  glClear GL_COLOR_BUFFER_BIT
  glBegin GL_TRIANGLES
    1 0 0 corner 0 0-0.5
    0 1 0 corner 1 0-0.5
    0 0 1 corner 0 1-0.5
  glEnd''
  show__ogl''
)

conew~'example'


#include <vector>
#include <algorithm>
#include <string>

// helper comparator that is passed to std::sort()
template <class T>
struct sort_table_functor {
  typedef bool (*CompFun)(const T &, const T &);
  const CompFun ordering;
  const int column;
  const bool reverse;
  sort_table_functor(CompFun o, int c, bool r) :
    ordering(o), column(c), reverse(r) { }
  bool operator()(const std::vector<T> &x, const std::vector<T> &y) const {
    const T &a = x[column],
            &b = y[column];
    return reverse ? ordering(b, a)
                   : ordering(a, b);
  }
};

// natural-order less-than comparator
template <class T>
bool myLess(const T &x, const T &y) { return x < y; }

// this is the function we call, which takes optional parameters
template <class T>
void sort_table(std::vector<std::vector<T> > &table,
                int column = 0, bool reverse = false,
                bool (*ordering)(const T &, const T &) = myLess) {
  std::sort(table.begin(), table.end(),
            sort_table_functor<T>(ordering, column, reverse));
}

#include <iostream>

// helper function to print our 3x3 matrix
template <class T>
void print_matrix(std::vector<std::vector<T> > &data) {
  for () {
    for (int j = 0; j < 3; j++)
      std::cout << data[i][j] << "\t";
    std::cout << std::endl;
  }
}

// order in descending length
bool desc_len_comparator(const std::string &x, const std::string &y) {
  return x.length() > y.length();
}

int main() {

  std::string data_array[3][3] =
    {
      {"a", "b", "c"},
      {"", "q", "z"},
      {"zap", "zip", "Zot"}
    };

  std::vector<std::vector<std::string> > data_orig;
  for (int i = 0; i < 3; i++) {
    std::vector<std::string> row;
    for (int j = 0; j < 3; j++)
      row.push_back(data_array[i][j]);
    data_orig.push_back(row);
  }
  print_matrix(data_orig);

  std::vector<std::vector<std::string> > data = data_orig;
  sort_table(data);
  print_matrix(data);

  data = data_orig;
  sort_table(data, 2);
  print_matrix(data);

  data = data_orig;
  sort_table(data, 1);
  print_matrix(data);

  data = data_orig;
  sort_table(data, 1, true);
  print_matrix(data);

  data = data_orig;
  sort_table(data, 0, false, desc_len_comparator);
  print_matrix(data);

  return 0;
}


import org.lwjgl.LWJGLException;
import org.lwjgl.opengl.Display;
import org.lwjgl.opengl.DisplayMode;
import static org.lwjgl.opengl.GL11.*;

public class OpenGlExample {

	public void run() throws LWJGLException {
		Display.setDisplayMode(new DisplayMode(640, 480));
		Display.create();

		glMatrixMode(GL_PROJECTION);
		glLoadIdentity();
		glOrtho(-30, 30, -30, 30, -30, 30);
		glMatrixMode(GL_MODELVIEW);

		while(!Display.isCloseRequested()) {
			render();

			Display.update();
		}

		Display.destroy();
	}

	public void render() {

		glClearColor(0.3f, 0.3f, 0.3f, 0.0f);
		glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);

		glShadeModel(GL_SMOOTH);

		glLoadIdentity();
		glTranslatef(-15.0f, -15.0f, 0.0f);

		glBegin(GL_TRIANGLES);
		glColor3f(1.0f, 0.0f, 0.0f);
		glVertex2f(0.0f, 0.0f);
		glColor3f(0.0f, 1.0f, 0.0f);
		glVertex2f(30f, 0.0f);
		glColor3f(0.0f, 0.0f, 1.0f);
		glVertex2f(0.0f, 30.0f);
		glEnd();

	}

	public static void main(String[] args) {
		OpenGlExample openGlExmpl = new OpenGlExample();
		try {
			openGlExmpl.run();
		} catch(LWJGLException e) {
			System.err.println(e);
		}
	}

}


<html style="margin: 0;">
  <head>
    <title>Minimal WebGL Example</title>
    <!-- This use of <script> elements is so that we can have multiline text
         without quoting it inside of JavaScript; the web browser doesn't
         actually do anything besides store the text of these. -->
    <script id="shader-fs" type="x-shader/x-fragment">
      precision highp float;
      varying vec4 v_color;
      void main(void) {
        // "Varying" variables are implicitly interpolated across triangles.
        gl_FragColor = v_color;
      }
    </script>
    <script id="shader-vs" type="x-shader/x-vertex">
      attribute vec3 a_position;
      attribute vec4 a_color;
      varying vec4 v_color;
      void main(void) {
        gl_Position = vec4(a_position, 1.0);
        v_color = a_color;
      }
    </script>
    <script type="text/javascript">
      function getShader(gl, id) {
        var scriptElement = document.getElementById(id);
        // Create shader object
        var shader;
        if (scriptElement.type == "x-shader/x-fragment")
          shader = gl.createShader(gl.FRAGMENT_SHADER);
        else if (scriptElement.type == "x-shader/x-vertex")
          shader = gl.createShader(gl.VERTEX_SHADER);
        else
          throw new Error("unknown shader script type");
        // Compile shader from source
        gl.shaderSource(shader, scriptElement.textContent);
        gl.compileShader(shader);
        if (!gl.getShaderParameter(shader, gl.COMPILE_STATUS))
          throw new Error(gl.getShaderInfoLog(shader));
        return shader;
      }
    </script>
  </head>
  <body style="margin: 0;">
    <canvas id="glcanvas" style="border: none; margin: auto; display: block;" width="640" height="480"></canvas>
    <script type="text/javascript">
      var canvas = document.getElementById("glcanvas");

      // Get WebGL context.
      var gl = canvas.getContext("webgl")
            || canvas.getContext("experimental-webgl");
      if (!gl)
        throw new Error("WebGL context not found");

      // Create shader program from vertex and fragment shader code.
      var shaderProgram = gl.createProgram();
      gl.attachShader(shaderProgram, getShader(gl, "shader-vs"));
      gl.attachShader(shaderProgram, getShader(gl, "shader-fs"));
      gl.linkProgram(shaderProgram);
      if (!gl.getProgramParameter(shaderProgram, gl.LINK_STATUS))
        throw new Error(gl.getProgramInfoLog(shaderProgram));

      // Specify to render using that program.
      gl.useProgram(shaderProgram);

      // Get the indexes to communicate vertex attributes to the program.
      var positionAttr = gl.getAttribLocation(shaderProgram, "a_position");
      var colorAttr = gl.getAttribLocation(shaderProgram, "a_color");
      // And specify that we will be actually delivering data to those attributes.
      gl.enableVertexAttribArray(positionAttr);
      gl.enableVertexAttribArray(colorAttr);

      // Store vertex positions and colors in array buffer objects.
      var vertices;
      var positionBuffer = gl.createBuffer();
      gl.bindBuffer(gl.ARRAY_BUFFER, positionBuffer);
      gl.bufferData(gl.ARRAY_BUFFER, new Float32Array(vertices = [
        -0.5, -0.5, 0,
        +0.5, -0.5, 0,
        -0.5, +0.5, 0
      ]), gl.STATIC_DRAW);
      var colorBuffer = gl.createBuffer();
      gl.bindBuffer(gl.ARRAY_BUFFER, colorBuffer);
      gl.bufferData(gl.ARRAY_BUFFER, new Float32Array([
        1, 0, 0, 1,
        0, 1, 0, 1,
        0, 0, 1, 1
      ]), gl.STATIC_DRAW);
      var numVertices = vertices.length / 3; // 3 coordinates per vertex

      // Set GL state
      gl.clearColor(0.3, 0.3, 0.3, 1.0);
      gl.enable(gl.DEPTH_TEST);
      gl.viewport(0, 0, gl.drawingBufferWidth || canvas.width,
                        gl.drawingBufferHeight || canvas.height);

      // Draw scene.
      // If this were an animation, everything after this point would go in a main loop.
      //   Clear frame.
      gl.clear(gl.COLOR_BUFFER_BIT | gl.DEPTH_BUFFER_BIT);
      //   Specify the array data to render.
      //   3 and 4 are the lengths of the vectors (3 for XYZ, 4 for RGBA).
      gl.bindBuffer(gl.ARRAY_BUFFER, positionBuffer);
      gl.vertexAttribPointer(positionAttr, 3, gl.FLOAT, false, 0, 0);
      gl.bindBuffer(gl.ARRAY_BUFFER, colorBuffer);
      gl.vertexAttribPointer(colorAttr, 4, gl.FLOAT, false, 0, 0);
      //   Draw triangles using the specified arrays.
      gl.drawArrays(gl.TRIANGLES, 0, numVertices);

      // Check for errors.
      var e;
      while (e = gl.getError())
        console.log("GL error", e);
    </script>
  </body>
</html>


(defn sort [table & {:keys [ordering column reverse?]
                     :or {ordering :lex, column 1}}]
  (println table ordering column reverse?))

(sort [1 8 3] :reverse? true)
[1 8 3] :lex 1 true


(defun sort-table (table &key (ordering #'string<)
                              (column 0)
                              reverse)
  (sort table (if reverse
                  (complement ordering)
                  ordering)
              :key (lambda (row) (elt row column))))


import std.stdio, std.algorithm, std.functional;

string[][] sortTable(string[][] table,
                     in bool function(string[],string[]) ordering=null,
                     in int column = 0,
                     in bool reverse = false) {
    if (ordering is null)
        table.schwartzSort!(row => row[column])();
    else
        table.sort!ordering();
    if (reverse)
        table.reverse();
    return table;
}

void main() {
    auto data = [["a", "b", "c"],
                 ["", "q", "z"],
                 ["zap", "zip", "Zot"]];

    alias show = curry!(writefln, "%-(%s\n%)\n");
    show(data);
    show(sortTable(data));
    show(sortTable(data, null, 2));
    show(sortTable(data, null, 1));
    show(sortTable(data, null, 1, true));
    show(sortTable(data, (a,b) => b.length > a.length));
}


using Makie

mesh([(0.0, 0.0), (0.5, 1.0), (1.0, 0.0)], color = [:red, :green, :blue], shading = false)


// Kotlin Native version 0.3

import kotlinx.cinterop.*
import opengl.*

fun paint() {
    glClearColor(0.3f, 0.3f, 0.3f, 0.0f)
    glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT)

    glShadeModel(GL_SMOOTH)

    glLoadIdentity()
    glTranslatef(-15.0f, -15.0f, 0.0f)

    glBegin(GL_TRIANGLES)
    glColor3f(1.0f, 0.0f, 0.0f)
    glVertex2f(0.0f, 0.0f)
    glColor3f(0.0f, 1.0f, 0.0f)
    glVertex2f(30.0f, 0.0f)
    glColor3f(0.0f, 0.0f, 1.0f)
    glVertex2f(0.0f, 30.0f)
    glEnd()

    glFlush()
}

fun reshape(width: Int, height: Int) {
    glViewport(0, 0, width, height)
    glMatrixMode(GL_PROJECTION)
    glLoadIdentity()
    glOrtho(-30.0, 30.0, -30.0, 30.0, -30.0, 30.0)
    glMatrixMode(GL_MODELVIEW)
}

fun main(args: Array<String>) {
    memScoped {
        val argc = alloc<IntVar>().apply { value = 0 }
        glutInit(argc.ptr, null)
    }

    glutInitWindowSize(640, 480)
    glutCreateWindow("Triangle")

    glutDisplayFunc(staticCFunction(::paint))
    glutReshapeFunc(staticCFunction(::reshape))

    glutMainLoop()
}


program Optional_parameters;

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  TRow = TArray<string>;

  TOrderingFun = TFunc<TRow, TRow, Boolean>;

  TTable = array of TRow;

  TRowHelper = record helper for TRow
  public
    procedure Swap(var other: TRow);
    function ToString: string;
    function Length: Integer;
  end;

  TTableHelper = record helper for TTable
  private
    procedure ExchangeRow(i, j: Integer);
  public
    procedure Sort(OrderingFun: TOrderingFun);
    procedure Reverse;
    function ToString: string;
  end;

function Max(a, b: Integer): Integer;
begin
  if a > b then
    exit(a);
  Result := b;
end;

{ TRowHelper }

function TRowHelper.Length: Integer;
begin
  Result := System.Length(self);
end;

procedure TRowHelper.Swap(var other: TRow);
var
  aLengthOther, aLengthSelf, aLength: Integer;
  tmp: string;
  i: Integer;
begin
  aLengthOther := other.Length;
  aLengthSelf := self.Length;
  aLength := max(aLengthOther, aLengthSelf);
  if aLength = 0 then
    exit;

  SetLength(self, aLength);
  SetLength(other, aLength);

  for i := 0 to aLength - 1 do
  begin
    tmp := self[i];
    self[i] := other[i];
    other[i] := tmp;
  end;

  SetLength(self, aLengthOther);
  SetLength(other, aLengthSelf);
end;

function TRowHelper.ToString: string;
var
  i: Integer;
begin
  Result := '[';
  for i := 0 to High(self) do
  begin
    if i > 0 then
      Result := Result + ', ';
    Result := Result + '"' + self[i] + '"';
  end;
  Result := Result + ']';
end;

{ TTableHelper }

procedure TTableHelper.ExchangeRow(i, j: Integer);
begin
  Self[i].Swap(self[j]);
end;

procedure TTableHelper.reverse;
var
  aLength, aHalfLength: Integer;
  i: Integer;
begin
  aLength := Length(self);
  aHalfLength := aLength div 2;
  for i := 0 to aHalfLength - 1 do
    ExchangeRow(i, aLength - i - 1);
end;

procedure TTableHelper.Sort(OrderingFun: TOrderingFun);
var
  i, j, aLength: Integer;
begin
  if not Assigned(OrderingFun) then
    exit;

  aLength := Length(self);
  for i := 0 to aLength - 2 do
    for j := i + 1 to aLength - 1 do
      if OrderingFun(self[i], self[j]) then
        ExchangeRow(i, j);
end;

function TTableHelper.ToString: string;
var
  i: Integer;
begin
  Result := '[';
  for i := 0 to High(self) do
  begin
    if i > 0 then
      Result := Result + #10;
    Result := Result + self[i].ToString;
  end;
  Result := Result + ']';
end;

function SortTable(table: TTable; Ordering: TOrderingFun = nil; column: Integer
  = 0; reverse: Boolean = false): TTable;
var
  acolumn: Integer;
begin
  acolumn := column;
  if not Assigned(Ordering) then
    Ordering :=
      function(left, right: TRow): Boolean
      begin
        Result := left[acolumn] > right[acolumn];
      end;

  table.Sort(Ordering);
  if (reverse) then
    table.reverse();
  Result := table;
end;

var
  data: TTable = [['a', 'b', 'c'], ['', 'q', 'z'], ['zap', 'zip', 'Zot']];

begin
  Writeln(data.ToString, #10);
  Writeln(SortTable(data).ToString, #10);
  Writeln(SortTable(data).ToString, #10);
  Writeln(SortTable(data, nil, 2).ToString, #10);
  Writeln(SortTable(data, nil, 1).ToString, #10);
  Writeln(SortTable(data, nil, 1, True).ToString, #10);
  Writeln(SortTable(data,
    function(left, right: TRow): Boolean
    begin
      Result := left.Length > right.Length;
    end).ToString, #10);
  Readln;
end.


nomainwin
    struct rect, x as long, y as long, x2 as long, y2 as long
    struct PFD,   Size as word, Version as word, Flags as long,_
        PixelType as char[1], ColorBits as char[1], RedBits as char[1],_
        RedShift as char[1], GreenBits as char[1], GreenShift as char[1],_
        BlueBits as char[1], BlueShift as char[1], AlphaBits as char[1],_
        AlphaShift as char[1],AccumBits as char[1], AccumRedBits as char[1],_
        AccumGreenBits as char[1], AccumBlueBits as char[1], AccumAlphaBits as char[1],_
        DepthBits as char[1], StencilBits as char[1], AuxBuffers as char[1],_
        LayerType as char[1], Reserved as char[1], LayerMask as long,_
        VisibleMask as long, DamageMask as long
    PFD.Version.struct=1
    PFD.ColorBits.struct=24
    PFD.DepthBits.struct=16
    PFD.Size.struct=len(PFD.struct)
    PFD.Flags.struct=37
    GlColorBufferBit=16384
    open "opengl32.dll" for dll as #gl
    open "glu32.dll" for dll as #glu
    WindowWidth=500
    WindowHeight=500
    UpperLeftX=1
    UpperLeftY=1
    open "Triangle" for window_nf as #main
    print #main,"trapclose [quit]"
    MainH=hwnd(#main)
    calldll #user32,"GetDC", MainH as ulong, MainDC as ulong
    calldll #gdi32,"ChoosePixelFormat", MainDC as ulong, PFD as struct, ret as long
    calldll #gdi32, "SetPixelFormat", MainDC as ulong, ret as long, PFD as struct, t as long
    calldll #gl,"wglCreateContext", MainDC as ulong, GLContext as ulong
    calldll #gl,"wglMakeCurrent", MainDC as ulong, GLContext as ulong, ret as long
    calldll #gl,"glClear", GlColorBufferBit as long,  ret as long
    calldll #gl,"glRotated", 0 as double, 0 as double, 0 as double, 0 as double, ret as long
    calldll #gl,"glBegin", 4 as long, ret as long
    calldll #gl,"glColor3d", 0 as double, 0 as double, 255 as double, ret as long
    calldll #gl,"glVertex3i", -1 as long, -1 as long, 0 as long, ret as long
    calldll #gl,"glColor3d", 255 as double, 0 as double, 0 as double, ret as long
    calldll #gl,"glVertex3i", 0 as long, 1 as long, 0 as long, ret as long
    calldll #gl,"glColor3d", 0 as double, 255 as double, 0 as double, ret as long
    calldll #gl,"glVertex3i", 1 as long, -1 as long, 0 as long, ret as long
    calldll #gl,"glEnd", ret as void
    calldll #gdi32,"SwapBuffers", MainDC as ulong, ret as long
    wait
[quit]
    calldll #gl,"wglMakeCurrent", 0 as ulong, 0 as ulong, ret as long
    calldll #gl,"wglDeleteContext", GLContext as ulong, ret as long
    calldll #user32, "ReleaseDC", MainH as ulong, MainDC as ulong,ret as long
    close #main
    close #glu
    close #gl
    end


def defaultOrdering(a, b) { return a.op__cmp(b) }

def sort {

    to run(table) {
        return sort(table, 0, false, defaultOrdering)
    }
    to run(table, column) {
        return sort(table, column, false, defaultOrdering)
    }
    to run(table, column, reverse) {
        return sort(table, column, reverse, defaultOrdering)
    }

    to run(table :List[List[String]], column :int, reverse :boolean, ordering) {
        return table.sort(fn a, b {
            def ord := ordering(a[column], b[column])
            if (reverse) { -ord } else { ord }
        })
    }

}


defmodule Optional_parameters do
  def sort( table, options\\[] ) do
    options = options ++ [ ordering: :lexicographic, column: 0, reverse: false ]
    ordering = options[ :ordering ]
    column   = options[ :column ]
    reverse  = options[ :reverse ]
    sorted = sort( table, ordering, column )
    if reverse, do: Enum.reverse( sorted ), else: sorted
  end

  defp sort( table, :lexicographic, column ) do
    Enum.sort_by( table, &elem( &1, column ) )
  end
  defp sort( table, :numeric, column ) do
    Enum.sort_by( table, &elem( &1, column ) |> String.to_integer )
  end

  def task do
    table = [ { "123", "456", "0789" },
              { "456", "0789", "123" },
              { "0789", "123", "456" } ]
    IO.write "sort defaults "; IO.inspect sort( table )
    IO.write " & reverse    "; IO.inspect sort( table, reverse: true )
    IO.write "sort column 2 "; IO.inspect sort( table, column: 2)
    IO.write " & reverse    "; IO.inspect sort( table, column: 2, reverse: true)
    IO.write "sort numeric  "; IO.inspect sort( table, ordering: :numeric)
    IO.write " & reverse    "; IO.inspect sort( table, ordering: :numeric, reverse: true)
  end
end

Optional_parameters.task


global gOpenGL -- RavOpenGL xtra instance
global GL      -- OpenGL constants

on startMovie
    -- Load the OpenGL script xtra
    gOpenGL = xtra("RavOpenGL").new()

    -- Load GL DLL
    gOpenGL.RavLoadGL("", "")

    -- Function omitted in demo code: loads OpenGL constants into namespace GL
    loadGLConstants()

    -- Window settings
    w = 640
    h = 480
    _movie.stage.title = "Triangle"
    _movie.stage.rect = rect(0, 0, w, h)
    _movie.centerStage = TRUE

    -- Create OpenGL display sprite
    m = new(#RavOpenGLDisplay)
    _movie.puppetSprite(1, TRUE)
    sprite(1).rect = rect(0, 0, w, h)
    sprite(1).member = m
    _movie.updateStage()

    -- Create the OpenGL buffer
    mainBufferID = gOpenGL.RavCreateBuffer(w, h, 32, 32)

    -- Set the sharing mode between script and sprite xtras
    dcID = gOpenGL.RavGetBufferProp(mainBufferID, #ravGC)
    sprite(1).RavShareBuffer(dcID, #true)

    gOpenGL.glViewport(0, 0, w, h)
    gOpenGL.glMatrixMode(GL.PROJECTION)
    gOpenGL.glLoadIdentity()
    gOpenGL.glOrtho(-30.0, 30.0, -30.0, 30.0, -30.0, 30.0)
    gOpenGL.glMatrixMode(GL.MODELVIEW)

    gOpenGL.glClearColor(0.3, 0.3, 0.3, 0.0)
    gOpenGL.glClear(GL.COLOR_BUFFER_BIT + GL.DEPTH_BUFFER_BIT)
    gOpenGL.glShadeModel(GL.SMOOTH)
    gOpenGL.glLoadIdentity()
    gOpenGL.glTranslatef(-15.0, -15.0, 0.0)
    gOpenGL.glBegin(GL.TRIANGLES)
    gOpenGL.glColor3f(1.0, 0.0, 0.0)
    gOpenGL.glVertex2f(0.0, 0.0)
    gOpenGL.glColor3f(0.0, 1.0, 0.0)
    gOpenGL.glVertex2f(30.0, 0.0)
    gOpenGL.glColor3f(0.0, 0.0, 1.0)
    gOpenGL.glVertex2f(0.0, 30.0)
    gOpenGL.glEnd()
    gOpenGL.glFlush()

    -- Show the window
    _movie.stage.visible = TRUE
end


local gl = require "luagl"
local iup = require "iuplua"
require "iupluagl"

local function paint()
  gl.ClearColor(0.3,0.3,0.3,0.0)
  gl.Clear"COLOR_BUFFER_BIT,DEPTH_BUFFER_BIT"

  gl.ShadeModel"SMOOTH"

  gl.LoadIdentity()
  gl.Translate(-15.0, -15.0, 0.0)

  gl.Begin"TRIANGLES"
  gl.Color(1.0, 0.0, 0.0)
  gl.Vertex(0.0, 0.0)
  gl.Color(0.0, 1.0, 0.0)
  gl.Vertex(30.0, 0.0)
  gl.Color(0.0, 0.0, 1.0)
  gl.Vertex(0.0, 30.0)
  gl.End()

  gl.Flush()
end

local function reshape(width, height)
  gl.Viewport(0, 0, width, height)
  gl.MatrixMode"PROJECTION"
  gl.LoadIdentity()
  gl.Ortho(-30.0, 30.0, -30.0, 30.0, -30.0, 30.0)
  gl.MatrixMode"MODELVIEW"
end

local glc = iup.glcanvas{rastersize="640x480"}
function glc:action() paint() end
function glc:resize_cb(w,h) reshape(w,h) end
function glc:map_cb() iup.GLMakeCurrent(self) end

local dlg = iup.dialog{title="Triangle", shrink="yes"; glc}
dlg:show()

iup.MainLoop()


-module( optional_parameters ).

-export( [sort/2, task/0] ).

sort( Table, Options ) ->
	Ordering = proplists:get_value( ordering, Options, lexicographic ),
	Column = proplists:get_value( column, Options, 1 ),
	Is_reverse = proplists:get_value( reverse, Options, false ),
	Sorted = sort( Table, Ordering, Column ),
	sorted_reverse( Is_reverse, Sorted ).

task() ->
	io:fwrite( "sort defaults ~p~n", [sort( table(), [])] ),
	io:fwrite( "reverse ~p~n", [sort( table(), [reverse])] ),
	io:fwrite( "sort column 3 ~p~n", [sort( table(), [{column, 3}])] ),
	io:fwrite( "reverse ~p~n", [sort( table(), [{column, 3}, reverse])] ),
	io:fwrite( "sort numeric ~p~n", [sort( table(), [{ordering, numeric}])] ),
	io:fwrite( "reverse ~p~n", [sort( table(), [{ordering, numeric}, reverse])] ).

row_numeric( Tuple ) -> erlang:list_to_tuple( [{erlang:list_to_integer(X), X} || X <- erlang:tuple_to_list(Tuple)] ).

row_remove_numeric( Tuple ) -> erlang:list_to_tuple( [Y || {_X, Y} <- erlang:tuple_to_list(Tuple)] ).

sort( Table, lexicographic, Column ) -> lists:keysort( Column, Table );
sort( Table, numeric, Column ) ->
	Numeric_table = [row_numeric(X) || X <- Table],
	Sorted_numeric = lists:keysort( Column, Numeric_table ),
	[row_remove_numeric(X) || X <- Sorted_numeric].

sorted_reverse( true, Sorted ) -> lists:reverse( Sorted );
sorted_reverse( false, Sorted ) -> Sorted.

table() -> [table_row1(), table_row2(), table_row3()].

table_row1() -> {"123", "456", "0789"}.
table_row2() -> {"456", "0789", "123"}.
table_row3() -> {"0789", "123", "456"}.


Style[Graphics3D[{Polygon[{{-1, 0, 0}, {1, 0, 0}, {0, Sqrt[3], 0.5}},
    VertexColors -> {Red, Green, Blue}]}, Boxed -> False],
 RenderingOptions -> {"3DRenderingEngine" -> "OpenGL"}]


newMesh = mesh numVerts:3 numFaces:1
setMesh newMesh vertices:#([-100, -100, 0], [100, -100, 0], [-100, 100, 0]) faces:#([1, 2, 3])
defaultVCFaces newMesh
setVertColor newMesh 1 red
setVertColor newMesh 2 green
setVertColor newMesh 3 blue
setCVertMode newMesh true
update newMesh
viewport.setType #view_top
max tool maximize
viewport.SetRenderLevel #smoothhighlights


:- module opengl.
:- interface.

:- import_module io.
:- pred main(io::di, io::uo) is det.

:- implementation.
:- import_module list, glut, glut.callback, glut.window, mogl.

main(!IO) :-
   glut.init_window_size(640, 480, !IO),
   glut.window.create("Triangle", !IO),
   glut.callback.display_func(opengl.paint, !IO),
   glut.callback.reshape_func(opengl.reshape, !IO),
   glut.main_loop(!IO).

:- pred paint(io::di, io::uo) is det.

paint(!IO) :-
   mogl.clear_color(0.3, 0.3, 0.3 , 0.0, !IO),
   mogl.clear([color, depth], !IO),

   mogl.shade_model(smooth, !IO),

   mogl.load_identity(!IO),
   mogl.translate(-15.0, -15.0, 0.0, !IO),

   mogl.begin(triangles, !IO),
       mogl.color3(1.0, 0.0, 0.0, !IO),
       mogl.vertex2(0.0, 0.0, !IO),
       mogl.color3(0.0, 1.0, 0.0, !IO),
       mogl.vertex2(30.0, 0.0, !IO),
       mogl.color3(0.0, 0.0, 1.0, !IO),
       mogl.vertex2(0.0, 30.0, !IO),
   mogl.end(!IO),

   mogl.flush(!IO).

:- pred reshape(int::in, int::in, io::di, io::uo) is det.

reshape(Width, Height, !IO) :-
  mogl.viewport(0, 0, Width, Height, !IO),
  mogl.matrix_mode(projection, !IO),
  mogl.load_identity(!IO),
  mogl.ortho(-30.0, 30.0, -30.0, 30.0, -30.0, 30.0, !IO),
  mogl.matrix_mode(modelview, !IO).


import opengl, opengl/glut

proc paint() {.cdecl.} =
  glClearColor(0.3,0.3,0.3,0.0)
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT)

  glShadeModel(GL_SMOOTH)

  glLoadIdentity()
  glTranslatef(-15.0, -15.0, 0.0)

  glBegin(GL_TRIANGLES)
  glColor3f(1.0, 0.0, 0.0)
  glVertex2f(0.0, 0.0)
  glColor3f(0.0, 1.0, 0.0)
  glVertex2f(30.0, 0.0)
  glColor3f(0.0, 0.0, 1.0)
  glVertex2f(0.0, 30.0)
  glEnd()

  glFlush()

proc reshape(width, height: cint) {.cdecl.} =
  glViewport(0, 0, width, height)
  glMatrixMode(GL_PROJECTION)
  glLoadIdentity()
  glOrtho(-30.0, 30.0, -30.0, 30.0, -30.0, 30.0)
  glMatrixMode(GL_MODELVIEW)

enableAutoGlErrorCheck(false)
loadExtensions()
glutInit()
glutInitWindowSize(640, 480)
discard glutCreateWindow("Triangle")

glutDisplayFunc(paint)
glutReshapeFunc(reshape)

glutMainLoop()


type Table(rows:string[][]) =
   // in-place sorting of rows
   member x.Sort(?ordering, ?column, ?reverse) =
      let ordering = defaultArg ordering compare
      let column   = defaultArg column   0
      let reverse  = defaultArg reverse  false

      let factor = if reverse then -1 else 1
      let comparer (row1:string[]) (row2:string[]) =
         factor * ordering row1.[column] row2.[column]

      Array.sortInPlaceWith comparer rows

   member x.Print() =
      for row in rows do printfn "%A" row

// Example usage
let t = new Table([| [|"a";   "b"; "c"|]
                     [|"";    "q"; "z"|]
                     [|"can"; "z"; "a"|] |])

printfn "Unsorted"; t.Print()

t.Sort()
printfn "Default sort"; t.Print()

t.Sort(column=2)
printfn "Sorted by col. 2"; t.Print()

t.Sort(column=1)
printfn "Sorted by col. 1"; t.Print()

t.Sort(column=1, reverse=true)
printfn "Reverse sorted by col. 1"; t.Print()

t.Sort(ordering=fun s1 s2 -> compare s2.Length s1.Length)
printfn "Sorted by decreasing length"; t.Print()


USING: accessors combinators io kernel math.order prettyprint
sequences sorting ;

TUPLE: table-sorter
    data
    { column initial: 0 }
    reversed?
    { ordering initial: [ ] } ;

: <table-sorter> ( -- obj ) table-sorter new ;

: sort-table ( table-sorter -- matrix )
    {
        [ data>> ]
        [ column>> [ swap nth ] curry ]
        [ ordering>> compose ]
        [ reversed?>> [ >=< ] [ <=> ] ? [ [email protected] ] prepose curry ]
    } cleave [ sort ] curry call( x -- x ) ;

! ===== Now we can use the interface defined above =====

CONSTANT: table
    { { "a" "b" "c" } { "" "q" "z" } { "can" "z" "a" } }

"Unsorted" print
table simple-table.

"Default sort" print
<table-sorter>
    table >>data
sort-table simple-table.

"Sorted by col 2" print
<table-sorter>
    table >>data
    2 >>column
sort-table simple-table.

"Sorted by col 1" print
<table-sorter>
    table >>data
    1 >>column
sort-table simple-table.

"Reverse sorted by col 1" print
<table-sorter>
    table >>data
    1 >>column
    t >>reversed?
sort-table simple-table.

"Sorted by decreasing length" print
<table-sorter>
    table >>data
    t >>reversed?
    [ length ] >>ordering
sort-table simple-table.


open GL
open Glut

let display() =
  glClearColor 0.3 0.3 0.3 0.0;
  glClear[GL_COLOR_BUFFER_BIT; GL_DEPTH_BUFFER_BIT];

  glShadeModel GL_SMOOTH;

  glLoadIdentity();
  glTranslate (-15.0) (-15.0) (0.0);

  glBegin GL_TRIANGLES;
  glColor3 1.0 0.0 0.0;
  glVertex2 0.0 0.0;
  glColor3 0.0 1.0 0.0;
  glVertex2 30.0 0.0;
  glColor3 0.0 0.0 1.0;
  glVertex2 0.0 30.0;
  glEnd();

  glFlush();
;;

let reshape ~width ~height =
  glViewport 0 0 width height;
  glMatrixMode GL_PROJECTION;
  glLoadIdentity();
  glOrtho(-30.0) 30.0 (-30.0) 30.0 (-30.0) 30.0;
  glMatrixMode GL_MODELVIEW;
;;

let () =
  ignore(glutInit Sys.argv);
  glutInitWindowSize 640 480;
  ignore(glutCreateWindow "Triangle");

  glutDisplayFunc ~display;
  glutReshapeFunc ~reshape;

  glutMainLoop();
;;


(import (lib gl))
(gl:set-window-title "Rosettacode OpenGL example")

(import (OpenGL version-1-0))

(glShadeModel GL_SMOOTH)
(glClearColor 0.3 0.3 0.3 1)
(glMatrixMode GL_PROJECTION)
(glLoadIdentity)
(glOrtho -30.0 30.0 -30.0 30.0 -30.0 30.0)

(gl:set-renderer (lambda (mouse)
   (glClear GL_COLOR_BUFFER_BIT)

   (glMatrixMode GL_MODELVIEW)
   (glLoadIdentity)
   (glTranslatef -15.0 -15.0 0.0)

   (glBegin GL_TRIANGLES)
      (glColor3f 1.0 0.0 0.0)
      (glVertex2f 0.0 0.0)
      (glColor3f 0.0 1.0 0.0)
      (glVertex2f 30.0 0.0)
      (glColor3f 0.0 0.0 1.0)
      (glVertex2f 0.0 30.0)
   (glEnd)
))