/*REXX program  sounds  eight notes  of the    C  major   natural diatonic  music scale.*/
parse arg !                                      /*obtain optional arguments from the CL*/
                                                 /* [↓]  invoke boilerplate REXX code.  */
if !all( arg() )  then exit                      /*determine which REXX is running,  if */
                                                 /*    any form of help requested, exit.*/
if \!regina   & \!pcrexx  then do
                               say "***error***  this program can't execute under:"   !ver
                               exit 13
                               end

$ = 'do ra me fa so la te do'                    /*the words for music scale sounding.  */
dur = 1/4                                        /*define duration as a quarter second. */
           do j=1  for words($)                  /*sound each "note" in the string.     */
           call notes word($, j), dur            /*invoke a subroutine for the sounds.  */
           end   /*j*/                           /* [↑]   sound each of the words.      */
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
notes: procedure expose !regina !pcrexx; arg note,dur /*obtain the arguments from list. */
       @.= 0                                          /*define common names for sounds. */
       @.la= 220;        @.si= 246.94;    @.te= @.si;      @.ta= @.te;    @.ti=  @.te
       @.do= 261.6256;   @.ut= @.do;      @.re= 293.66;    @.ra= @.re;    @.mi=  329.63
       @.ma= @.mi;       @.fa= 349.23;    @.so= 392;                      @.sol= @.so
       if @.note==0  then return                      /*if frequency is zero,  skip it. */
       if !pcrexx  then call  sound @.note,dur        /*sound the note using SOUND bif. */
       if !regina  then do                            /* [↓]  reformat some numbers.    */
                        ms= format(dur*1000, , 0)     /*Regina requires DUR in millisec.*/
                        intN= format(@.note, , 0)     /*   "      "     NOTE is integer.*/
                        call  beep  intN, ms          /*sound the note using  BEEP  BIF.*/
                        end
       return
/*─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
!all: !!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1
!cal: if symbol('!CALL')\=="VAR"  then !call=;                             return !call
!env: !env= 'ENVIRONMENT';   if !sys=="MSDOS"  |  !brexx  |  !r4  |  !roo  then !env= 'SYSTEM';   if !os2  then !env= "OS2"!env;   !ebcdic= 3=='f3'x;   if !crx  then !env="DOS";                    return
!fid: parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .;  call !sys;  if !dos  then do;  _= lastpos('\',!fn);  !fm= left(!fn,_);  !fn= substr(!fn,_+1);  parse var !fn !fn "." !ft;  end;      return word(0 !fn !ft !fm, 1 + ('0'arg(1) ) )
!rex: parse upper version !ver !vernum !verdate .;  !brexx= 'BY'==!vernum; !kexx= "KEXX"==!ver; !pcrexx= 'REXX/PERSONAL'==!ver | "REXX/PC"==!ver; !r4= 'REXX-R4'==!ver; !regina= "REXX-REGINA"==left(!ver, 11); !roo= 'REXX-ROO'==!ver; call !env; return
!sys: !cms= !sys=='CMS';   !os2= !sys=="OS2";   !tso= !sys=='TSO'  |  !sys=="MVS";   !vse= !sys=='VSE';   !dos= pos("DOS", !sys)\==0  |  pos('WIN', !sys)\==0  |  !sys=="CMD";   !crx= left(!sys, 6)=='DOSCRX';                         call !rex; return
!var: call !fid;   if !kexx  then return space( dosenv( arg(1) ) );        return space( value( arg(1), , !env) )


class String {
    # Sort groups of digits in number order. Sort by order of magnitude then lexically.
    -> naturally { self.lc.gsub(/(\d+)/, {|s1| "0" + s1.len.chr + s1 }) + "\x0" + self };

    # Collapse multiple ws characters to a single.
    -> collapse { self.gsub(/(\s)\1+/, {|s1| s1 }) };

    # Convert all ws characters to a space.
    -> normalize { self.gsub(/(\s)/, ' ') };

    # Ignore common leading articles for title sorts
    -> title { self.sub(/^(?:a|an|the)\b\s*/i, '') };

    # Decompose ISO-Latin1 glyphs to their base character.
    -> latin1_decompose {
        static tr = Hash.new(%w(
           Æ AE æ ae Þ TH þ th Ð TH ð th ß ss À A Á A Â A Ã A Ä A Å A à a á a
            â a ã a ä a å a Ç C ç c È E É E Ê E Ë E è e é e ê e ë e Ì I Í I Î
            I Ï I ì i í i î i ï i Ò O Ó O Ô O Õ O Ö O Ø O ò o ó o ô o õ o ö o
            ø o Ñ N ñ n Ù U Ú U Û U Ü U ù u ú u û u ü u Ý Y ÿ y ý y
        )...);

        var re = Regex.new('(' + tr.keys.join('|') + ')');
        self.gsub(re, {|s1| tr{s1} });
    }
}


# Project : Musical scale

loadlib("C:\Ring\extensions\ringbeep\ringbeep.dll")
freqs = [[262,"Do"], [294,"Ra"], [330,"Me"], [349,"Fa"], [392,"So"], [440,"La"], [494,"Te"], [523,"do"]]
for f = 1 to len(freqs)
     see freqs[f][2] + nl
     beep(freqs[f][1],300)
next


import net.java.dev.sna.SNA

object PlayMusicScale extends App with SNA {

  snaLibrary = "Kernel32"
  val Beep = SNA[Int, Int, Unit]

  println("Please don't shoot the piano player, he's doing the best that he can!")
  List(0, 2, 4, 5, 7, 9, 11, 12).
    foreach(f => Beep((261.63 * math.pow(2, f / 12.0)).toInt, if (f == 12) 1000 else 500))
  println("That's all")
}


var sampleRate = 44100.0;
var duration = 8.0;
var dataLength = round(sampleRate * duration);
var dataLength_b0 = dataLength >> 0  & 0xff;
var dataLength_b1 = dataLength >> 8  & 0xff;
var dataLength_b2 = dataLength >> 16 & 0xff;
var dataLength_b3 = dataLength >> 24 & 0xff;

const adjustedHdrSize = 36;

var len = dataLength - adjustedHdrSize;
var len_b0 = len >> 0  & 0xff;
var len_b1 = len >> 8  & 0xff;
var len_b2 = len >> 16 & 0xff;
var len_b3 = len >> 24 & 0xff;

// WAV header
var wavhdr   = "RIFF";
    wavhdr ..= fmtstr("%c%c%c%c", len_b0, len_b1, len_b2, len_b3);
    wavhdr ..= "WAVE";
    wavhdr ..= "fmt ";
    wavhdr ..= "\x10\x00\x00\x00";
    wavhdr ..= "\x01\x00";
    wavhdr ..= "\x01\x00";
    wavhdr ..= "\x44\xac\x00\x00";
    wavhdr ..= "\x44\xac\x00\x00";
    wavhdr ..= "\x01\x00";
    wavhdr ..= "\x08\x00";
    wavhdr ..= "data";
    wavhdr ..= fmtstr("%c%c%c%c", dataLength_b0, dataLength_b1, dataLength_b2, dataLength_b3);

// write wav header
var f = fopen("notes.wav", "w");
fwrite(f, wavhdr);

// compute and write actual data
var frequs = { 261.6, 293.6, 329.6, 349.2, 392.0, 440.0, 493.9, 523.3 };

for var j = 0; j < duration; j++ {
	var frequ = frequs[j];
	var omega = 2 * M_PI * frequ;
	for var i = 0; i < dataLength / 8; i++ {
		var y = 32 * sin(omega * i / sampleRate);
		var byte = fmtstr("%c", round(y));
		fwrite(f, byte);
	}
}

fclose(f);


package require sound

# Encapsulate the tone generation
set filter [snack::filter generator 1 20000 0.5 sine -1]
set sound  [snack::sound -rate 22050]
proc play {frequency length} {
    global filter sound

    $filter configure $frequency
    $sound play -filter $filter

    # Need to run event loop; Snack uses it internally
    after $length {set donePlay 1}
    vwait donePlay

    $sound stop
}

# Major scale up, then down; extra delay at ends of scale
set tonicFrequency 261.63; # C4
foreach i {0 2 4 5 7 9 11 12 11 9 7 5 4 2 0} {
    play [expr {$tonicFrequency*2**($i/12.0)}] [expr {$i%12?250:500}]
}


package require Tcl 8.5

proc sortWithCollationKey {keyBuilder list} {
    if {![llength $list]} return
    foreach value $list {
	lappend toSort [{*}$keyBuilder $value]
    }
    foreach idx [lsort -indices $toSort] {
	lappend result [lindex $list $idx]
    }
    return $result
}
proc normalizeSpaces {str} {
    regsub -all {[ ]+} [string trim $str " "] " "
}
proc equivalentWhitespace {str} {
    regsub -all {\s} $str " "
}

proc show {description sorter strings} {
    puts "Input:\n\t[join $strings \n\t]"
    set sorted [lsort $strings]
    puts "Normally sorted:\n\t[join $sorted \n\t]"
    set sorted [{*}$sorter $strings]
    puts "Naturally sorted with ${description}:\n\t[join $sorted \n\t]"
}

# Two demonstrations of the space normalizer
show "normalized spaces" {sortWithCollationKey normalizeSpaces} {
    {ignore leading spaces: 2-2}
    { ignore leading spaces: 2-1}
    {  ignore leading spaces: 2+0}
    {   ignore leading spaces: 2+1}}
show "normalized spaces" {sortWithCollationKey normalizeSpaces} {
    {ignore m.a.s spaces: 2-2}
    {ignore m.a.s  spaces: 2-1}
    {ignore m.a.s   spaces: 2+0}
    {ignore m.a.s    spaces: 2+1}}

# Use a collation key that maps all whitespace to spaces
show "all whitespace equivalent" {sortWithCollationKey equivalentWhitespace} {
    "Equiv. spaces: 3-3"
    "Equiv.\rspaces: 3-2"
    "Equiv.\u000cspaces: 3-1"
    "Equiv.\u000bspaces: 3+0"
    "Equiv.\nspaces: 3+1"
    "Equiv.\tspaces: 3+2"}

# These are built-in modes
show "(built-in) case insensitivity" {lsort -nocase} {
    {cASE INDEPENENT: 3-2}
    {caSE INDEPENENT: 3-1}
    {casE INDEPENENT: 3+0}
    {case INDEPENENT: 3+1}}
show "digit sequences as numbers" {lsort -dictionary} {
    foo100bar99baz0.txt
    foo100bar10baz0.txt
    foo1000bar99baz10.txt
    foo1000bar99baz9.txt}


decl double<> notes
append 261.63 293.66 329.63 349.23 392.00 440.00 493.88 523.25 notes

for (decl int i) (< i (size notes)) (inc i)
        ursa.util.sound.beep notes<i> 0.5
end for


Option Explicit

Declare Function Beep Lib "kernel32" (ByVal Freq As Long, ByVal Dur As Long) As Long

Sub Musical_Scale()
Dim Fqs, i As Integer
   Fqs = Array(264, 297, 330, 352, 396, 440, 495, 528)
   For i = LBound(Fqs) To UBound(Fqs)
      Beep Fqs(i), 500
   Next
End Sub


import strings
import os
import encoding.binary
import math

const (
    sample_rate = 44100
    duration   = 8
    data_length = sample_rate * duration
    hdr_size    = 44
    file_len    = data_length + hdr_size - 8
)
fn main() {

    // buffers
    mut buf1 := []byte{len:1}
    mut buf2 := []byte{len:2}
    mut buf4 := []byte{len:4}

    // WAV header
    mut sb := strings.new_builder(128)
    sb.write_string("RIFF")
    binary.little_endian_put_u32(mut &buf4, file_len)
    sb.write(buf4)? // file size - 8
    sb.write_string("WAVE")
    sb.write_string("fmt ")
    binary.little_endian_put_u32(mut &buf4, 16)
    sb.write(buf4)? // length of format data (= 16)
    binary.little_endian_put_u16(mut &buf2, 1)
    sb.write(buf2)? // type of format (= 1 (PCM))
    sb.write(buf2)? // number of channels (= 1)
    binary.little_endian_put_u32(mut &buf4, sample_rate)
    sb.write(buf4)? // sample rate
    sb.write(buf4)? // sample rate * bps(8) * channels(1) / 8 (= sample rate)
    sb.write(buf2)? // bps(8) * channels(1) / 8  (= 1)
    binary.little_endian_put_u16(mut &buf2, 8)
    sb.write(buf2)? // bits per sample (bps) (= 8)
    sb.write_string("data")
    binary.little_endian_put_u32(mut &buf4, data_length)
    sb.write(buf4)? // size of data section
    wavhdr := sb.str().bytes()

    // write WAV header
    mut f := os.create("notes.wav")?
    defer {
        f.close()
    }
    f.write(wavhdr)?

    // compute and write actual data
    freqs := [261.6, 293.6, 329.6, 349.2, 392.0, 440.0, 493.9, 523.3]!
    for j in 0..duration {
        freq := freqs[j]
        omega := 2 * math.pi * freq
        for i in 0..data_length/duration {
            y := 32 * math.sin(omega*f64(i)/f64(sample_rate))
            buf1[0] = u8(math.round(y))
            f.write(buf1)?
        }
    }
}


import "/sound" for Wav

var sampleRate = 44100
var duration = 8
var data = List.filled(sampleRate * duration, 0)
var freqs = [261.6, 293.6, 329.6, 349.2, 392.0, 440.0, 493.9, 523.3]
for (j in 0...duration) {
    var freq = freqs[j]
    var omega = 2 * Num.pi * freq
    for (i in 0...sampleRate) {
        var y = (32 * (omega * i / sampleRate).sin).round & 255
        data[i + j * sampleRate] = y
    }
}
Wav.create("musical_scale.wav", data, sampleRate)


\Square waves on the beeper speaker:
code Sound=39;
real Period;  int I;
[Period:= 1190000.0/261.625565;     \middle C
for I:= 2 to 9 do
    [Sound(1, 4, fix(Period));      \times 2^(-1/6) else 2^(-1/12)
    Period:= Period * (if I&3 then 0.890898719 else 0.943874313);
    ];
]

\MIDI grand piano (requires 32-bit Windows or Sound Blaster 16):
code Sound=39;
int  Note, I;
[port($331):= $3F;      \set MPU-401 into UART mode
Note:= 60;              \start at middle C
for I:= 2 to 9+1 do     \(last note is not played)
    [port($330):= $90;  port($330):= Note;  port($330):= $7F;
    Sound(0, 4, 1);     \This "Sound" is off, but convenient 0.22 sec delay
    Note:= Note + (if I&3 then 2 else 1);
    ];
]


import "/pattern" for Pattern
import "/str" for Str
import "/fmt" for Fmt
import "/sort" for Cmp, Sort

var p2 = Pattern.new("+2 ")
var p3 = Pattern.new("/s") // any whitespace character
var p5 = Pattern.new("+1/d")

/** Only covers ISO-8859-1 accented characters plus (for consistency) Ÿ */
var ucAccented = ["ÀÁÂÃÄÅ", "Ç", "ÈÉÊË", "ÌÍÎÏ", "Ñ", "ÒÓÔÕÖØ", "ÙÚÛÜ", "ÝŸ"]
var lcAccented = ["àáâãäå", "ç", "èéêë", "ìíîï", "ñ", "òóôõöø", "ùúûü", "ýÿ"]
var ucNormal   = "ACEINOUY"
var lcNormal   = "aceinouy"

/** Only the commoner ligatures */
var ucLigatures = "ÆĲŒ"
var lcLigatures = "æĳœ"
var ucSeparated = ["AE", "IJ", "OE"]
var lcSeparated = ["ae", "ij", "oe"]

/** Miscellaneous replacements */
var miscLetters = "ßſʒ"
var miscReplacements = ["ss", "s", "s"]

/** Displays strings including whitespace as if the latter were literal characters */
var toDisplayString = Fn.new { |s|
    var whitespace  = ["\t", "\n", "\v", "\f", "\r"]
    var whitespace2 = ["\\t", "\\n", "\\v", "\\f", "\\r"]
    for (i in 0..4) s = s.replace(whitespace[i], whitespace2[i])
    return s
}

/** Ignoring leading space(s) */
var selector1 = Fn.new { |s| s.trimStart(" ") }

/** Ignoring multiple adjacent spaces i.e. condensing to a single space */
var selector2 = Fn.new { |s| p2.replaceAll(s, " ") }

/** Equivalent whitespace characters (equivalent to a space say) */
var selector3 = Fn.new { |s| p3.replaceAll(s, " ") }

/** Case independent sort */
var selector4 = Fn.new { |s| Str.lower(s) }

/** Numeric fields as numerics (deals with up to 20 digits) */
var selector5 = Fn.new { |s|
    for (m in p5.findAll(s)) {
        var ix = m.index
        var repl = Fmt.swrite("$020d", Num.fromString(m.text))
        s = s[0...ix] + repl + s[ix + m.length..-1]
    }
    return s
}

/** Title sort */
var selector6 = Fn.new { |s|
    var t = Str.lower(s)
    if (t.startsWith("the ")) return s.skip(4).join()
    if (t.startsWith("an ")) return s.skip(3).join()
    if (t.startsWith("a ")) return s.skip(2).join()
    return s
}

/** Equivalent accented characters (and case) */
var selector7 = Fn.new { |s|
    var sb = ""
    for (c in s) {
        var outer = false
        var i = 0
        for (ucs in ucAccented) {
            if (ucs.contains(c)) {
                sb = sb + ucNormal[i]
                outer = true
                break
            }
            i = i + 1
        }
        if (outer) continue
        i = 0
        for (lcs in lcAccented) {
            if (lcs.contains(c)) {
                sb = sb + lcNormal[i]
                outer = true
                break
            }
            i = i + 1
        }
        if (outer) continue
        sb = sb + c
    }
    return Str.lower(sb)
}

/** Separated ligatures */
var selector8 = Fn.new { |s|
    var i = 0
    for (c in ucLigatures) {
        s = s.replace(c, ucSeparated[i])
        i = i + 1
    }
    i = 0
    for (c in lcLigatures) {
        s = s.replace(c, lcSeparated[i])
        i = i + 1
    }
    return s
}

/** Character replacements */
var selector9 = Fn.new { |s|
    var i = 0
    for (c in miscLetters) {
        s = s.replace(c, miscReplacements[i])
        i = i + 1
    }
    return s
}

System.print("The 9 string lists, sorted 'naturally':\n")
var selectors = [selector1, selector2, selector3, selector4, selector5,
                 selector6, selector7, selector8, selector9]
var ss = [
    [
        "ignore leading spaces: 2-2",
        " ignore leading spaces: 2-1",
        "  ignore leading spaces: 2+0",
        "   ignore leading spaces: 2+1"
    ],
    [
        "ignore m.a.s spaces: 2-2",
        "ignore m.a.s  spaces: 2-1",
        "ignore m.a.s   spaces: 2+0",
        "ignore m.a.s    spaces: 2+1"
    ],
    [
        "Equiv. spaces: 3-3",
        "Equiv.\rspaces: 3-2",
        "Equiv.\vspaces: 3-1",
        "Equiv.\fspaces: 3+0",
        "Equiv.\nspaces: 3+1",
        "Equiv.\tspaces: 3+2"
    ],
    [
        "cASE INDEPENENT: 3-2",
        "caSE INDEPENENT: 3-1",
        "casE INDEPENENT: 3+0",
        "case INDEPENENT: 3+1"
    ],
    [
        "foo100bar99baz0.txt",
        "foo100bar10baz0.txt",
        "foo1000bar99baz10.txt",
        "foo1000bar99baz9.txt"
    ],
    [
        "The Wind in the Willows",
        "The 40th step more",
        "The 39 steps",
        "Wanda"
    ],
    [
        "Equiv. ý accents: 2-2",
        "Equiv. Ý accents: 2-1",
        "Equiv. y accents: 2+0",
        "Equiv. Y accents: 2+1"
    ],
    [
        "Ĳ ligatured ij",
        "no ligature"
    ],
    [
        "Start with an ʒ: 2-2",
        "Start with an ſ: 2-1",
        "Start with an ß: 2+0",
        "Start with an s: 2+1"
    ]
]
for (i in 0..8) {
    var sel = selectors[i]
    var cmp = Fn.new { |s1, s2| Cmp.string.call(sel.call(s1), sel.call(s2)) }
    Sort.insertion(ss[i], cmp)
    System.print(ss[i].map { |s| "'%(s)'" }.join("\n"))
    if (i < 8) System.print()
}


// Rosetta Code problem: http://rosettacode.org/wiki/Musical_scale
// by Galileo, 03/2022

sample_rate = 44100
duration = 8
dataLength = sample_rate * duration
hdrSize = 44
fileLen = dataLength + hdrSize - 8
data 261.6, 293.6, 329.6, 349.2, 392.0, 440.0, 493.9, 523.3

sub int_to_bytes(dato, long)
    local dato$, esp, esp$, i

    esp$ = "00000000"
    dato$ = hex$(dato)
    esp = long * 2
    dato$ = right$(esp$ + dato$, esp)
    for i = esp - 1 to 1 step -2
        poke #fn, dec(mid$(dato$, i, 2))
    next
end sub

fn = open("notesyab.wav", "wb")

print #fn, "RIFF";
int_to_bytes(fileLen, 4)
print #fn, "WAVEfmt ";
int_to_bytes(16, 4)             // length of format data (= 16)
int_to_bytes(1, 2)              // type of format (= 1 (PCM))
int_to_bytes(1, 2)              // number of channels (= 1)
int_to_bytes(sample_rate, 4)    // sample rate
int_to_bytes(sample_rate, 4)    // sample rate * bps(8) * channels(1) / 8 (= sample rate)
int_to_bytes(1,2)               // bps(8) * channels(1) / 8  (= 1)
int_to_bytes(8,2)               // bits per sample (bps) (= 8)
print #fn, "data";
int_to_bytes(dataLength, 4)     // size of data section

for j = 1 to duration
    read f
    omega = 2 * PI * f
    for i = 0 to dataLength/duration-1
        y = 32 * sin(omega * i / sample_rate)
        byte = and(y, 255)
        poke #fn, byte
    next
next

close(fn)

if peek$("os") = "windows" then
    system("notesyab.wav")
else // Linux
    system("aplay notesyab.wav")
endif


10 REM Musical scale
20 LET n=0: REM Start at middle C
30 LET d=0.2: REM Make each note 0.2 seconds in duration
40 FOR l=1 TO 8
50 BEEP d,n
60 READ i: REM Number of semitones to increment
70 LET n=n+i
80 NEXT l
90 STOP
9000 DATA 2,2,1,2,2,2,1,2:REM WWHWWWH


fcn dsuSort(x,orig){ // decorate-sort-undecorate sort
   x.enumerate().sort(fcn([(_,a)],[(_,b)]){a<b})
   .apply('wrap([(n,_)]){orig[n]});
}


V _suffix = [‘th’, ‘st’, ‘nd’, ‘rd’, ‘th’, ‘th’, ‘th’, ‘th’, ‘th’, ‘th’]

F nth(n)
   R ‘#.'#.’.format(n, I n % 100 <= 10 | n % 100 > 20 {:_suffix[n % 10]} E ‘th’)

L(j) (0..1000).step(250)
   print_elements(Array(j.+25).map(i -> nth(i)))


		org	100h
		jmp	demo
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Given a 16-bit unsigned integer in HL, return a string
		;; consisting of its ASCII representation plus an ordinal
		;; suffix in HL.
nth:		lxi	b,-10		; Divisor for digit loop
		push	h		; Push integer to stack
		lxi	h,nthsfx	; Pointer to end of digit area
		xthl			; Swap digit pointer with integer
nthdigit:	lxi	d,-1		; Get current digit - DE holds quotient
nthdiv10:	inx	d		; Increment quotient,
		dad	b		; subtract 10 from integer,
		jc	nthdiv10	; Keep going until HL<0
		mvi	a,'0'+10	; Calculate ASCII value for digit
		add	l		; Modulus is in (H)L
		xthl			; Swap integer with pointer
		dcx	h		; Point to one digit further left
		mov	m,a		; Store the digit
		xthl			; Swap pointer with integer
		xchg			; Put quotient in HL
		mov	a,h		; Is it zero?
		ora	l
		jnz	nthdigit	; If not, go calculate next digit
		mvi	e,0		; Default suffix is 'th'.
		lxi	h,nthnum+3	; Look at tens digit
		mov	a,m
		cpi	'1'		; Is it '1'?
		jz	nthsetsfx	; Then it is always 'th'.
		inx	h		; Look at zeroes digit
		mov	a,m
		sui	'0'		; Subtract ASCII '0'
		cpi	4		; 4 or higher?
		jnc	nthsetsfx	; Then it is always 'th'.
		rlc			; Otherwise, suffix is at N*2+nthord
		mov	e,a
nthsetsfx:	mvi	d,0		; Look up suffix in list
		lxi	h,nthord
		dad	d		; Pointer to suffix in HL
		lxi	d,nthsfx	; Pointer to space for suffix in DE
		mov	a,m		; Get first letter of suffix
		stax	d		; Store it in output
		inx	h		; Increment both pointers
		inx	d
		mov 	a,m		; Get second letter of suffix
		stax	d		; Store it in output
		pop	h		; Return pointer to leftmost digit
		ret
nthord:		db	'thstndrd'	; Ordinal suffixes
nthnum:		db	'*****'		; Room for digits
nthsfx:		db	'**$'		; Room for suffix
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
demo:		;; Demo code
		lxi	h,0		; Starting at 0...
		mvi	b,26		; ...print 26 numbers [0..25]
		call	printnums
		lxi	h,250		; Starting at 250...
		mvi	b,16		; ...print 16 numbers [250..265]
		call	printnums
		lxi	h,1000		; Starting at 1000...
		mvi	b,26		; ...print 26 numbers [1000..1025]
		;; Print values from HL up to HL+B
printnums:	push	h		; Keep number
		push	b		; Keep counter
		call	nth		; Get string for current HL
		xchg			; Put it in DE
		mvi	c,9		; CP/M print string
		call	5
		mvi	e,' '		; Separate numbers with spaces
		mvi	c,2		; CP/M print character
		call	5
		pop	b		; Restore counter
		pop	h		; Restore number
		inx	h 		; Increment number
		dcr	b		; Decrement counter
		jnz	printnums	; If not zero, print next number
		ret


		bits	16
		cpu	8086
segment		.text
		org	100h
		jmp	demo
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Given a number in AX, return string with ordinal suffix
		;; in DX.
nth:		mov	cx,10			; Divisor
		mov	bx,.sfx			; Pointer to end of number
.digit:		xor	dx,dx			; Zero DX
		div	cx			; AX = DX:AX/10; DX=remainder
		add	dl,'0'			; Make digit
		dec	bx			; Back up the pointer
		mov	[bx],dl			; Store digit
		and	ax,ax			; Done yet? (AX=0?)
		jnz	.digit			; If not, get next digit
		mov	dx,bx			; Keep string pointer in DX
		xor	bx,bx			; Default suffix is 'th'.
		cmp	byte [.num+3],'1'	; Is the tens digit '1'?
		je	.setsfx			; Then the suffix is 'th'.
		mov	cl,[.num+4]		; Get the ones digit
		cmp	cl,'4'			; Is it '4' or higher?
		jae	.setsfx			; Then the suffix is 'th'.
		mov	bl,cl
		sub	bl,'0'			; Calculate offset.
		shl	bl,1			; [0..3]*2 + .ord
.setsfx:	mov	ax,[bx+.ordsfx]		; Set suffix
		mov	[.sfx],ax
		ret
.ordsfx:	db	'thstndrd'
.num:		db	'*****'
.sfx:		db	'**$'
		;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
		;; Print numbers.
demo:		mov	ax,0		; Starting at 0...
		mov	bl,26		; ...print 26 numbers [0..25]
		call	printn
		mov	ax,250		; Starting at 250...
		mov	bl,16		; ...print 16 numbers [250..265]
		call	printn
		mov	ax,1000		; Starting at 1000...
		mov	bl,26		; ...print 26 numbers [1000..1025]
		;; Print BL numbers starting at AX
printn:		push	ax		; Keep number
		push	bx		; Keep counter
		call	nth		; Get string for current AX
		mov	ah,9		; MS-DOS print string
		int	21h
		mov	dl,' '		; Separate numbers by spaces
		mov	ah,2		; MS-DOS print character
		int	21h
		pop	bx		; Restore counter
		pop	ax		; Restore number
		inc	ax		; Next number
		dec	bl		; Are we done yet?
		jnz	printn
		ret


PROC Nth(CARD val,CHAR ARRAY s)
  CHAR ARRAY sfx
  BYTE d

  StrC(val,s)
  s(0)=s(0)+1
  s(s(0))=''

  d=val MOD 100
  IF d>10 AND d<14 THEN
    sfx="th"
  ELSE
    d=val MOD 10
    IF d=1 THEN sfx="st"
    ELSEIF d=2 THEN sfx="nd"
    ELSEIF d=3 THEN sfx="rd"
    ELSE sfx="th"
    FI
  FI

  s(0)=s(0)+2
  SAssign(s,sfx,s(0)-1,s(0)+1)
RETURN

PROC Main()
  CARD ARRAY n=[0 250 1000]
  CHAR ARRAY s(10)
  CARD i,j

  FOR i=0 TO 2
  DO
    FOR j=n(i) TO n(i)+25
    DO
      Nth(j,s)
      PrintF("%S ",s)
    OD
    PutE() PutE()
  OD
RETURN


with Ada.Text_IO;

procedure Nth is

   function Suffix(N: Natural) return String is
   begin
      if    N mod 10 = 1 and then N mod 100 /= 11 then return "st";
      elsif N mod 10 = 2 and then N mod 100 /= 12 then return "nd";
      elsif N mod 10 = 3 and then N mod 100 /= 13 then return "rd";
      else return "th";
      end if;
   end Suffix;

   procedure Print_Images(From, To: Natural) is
   begin
      for I in From .. To loop
	 Ada.Text_IO.Put(Natural'Image(I) & Suffix(I));
      end loop;
      Ada.Text_IO.New_Line;
   end Print_Images;

begin
   Print_Images(   0,   25);
   Print_Images( 250,  265);
   Print_Images(1000, 1025);
end Nth;


# PROC to suffix a number with st, nd, rd or th as appropriate #
PROC nth = ( INT number )STRING:
BEGIN

    INT number mod 100 = number MOD 100;

# RESULT #
    whole( number, 0 )
  + IF number mod 100 >= 10 AND number mod 100 <= 20
    THEN
        # numbers in the range 10 .. 20 always have "th" #
        "th"
    ELSE
        # not in the range 10 .. 20, suffix is st, nd, rd or th #
        # depending on the final digit                          #
        CASE number MOD 10
        IN  # 1 # "st"
        ,   # 2 # "nd"
        ,   # 3 # "rd"
        OUT       "th"
        ESAC
    FI
END; # nth #

# PROC to test nth, displays nth for all numbers in the range from .. to  #
PROC test nth = ( INT from, INT to )VOID:
BEGIN
    INT test count := 0;
    FOR test value FROM from TO to
    DO
        STRING test result = nth( test value );
        print( ( "        "[ 1 : 8 - UPB test result ], nth( test value ) ) );
        test count +:= 1;
        IF test count MOD 8 = 0
        THEN
            print( ( newline ) )
        FI
    OD;
    print( ( newline ) )
END; # test nth #

main: (

    test nth(    0,   25 );
    test nth(  250,  265 );
    test nth( 1000, 1025 )

)


 nth←{
    sfx←4 2⍴'stndrdth'
    tens←(10<100|⍵)∧20>100|⍵
    (⍕⍵),sfx[(4×tens)⌈(⍳3)⍳10|⍵;]
 }


-- ORDINAL STRINGS -----------------------------------------------------------

-- ordinalString :: Int -> String
on ordinalString(n)
    (n as string) & ordinalSuffix(n)
end ordinalString

-- ordinalSuffix :: Int -> String
on ordinalSuffix(n)
    set modHundred to n mod 100
    if (11 ≤ modHundred) and (13 ≥ modHundred) then
        "th"
    else
        item ((n mod 10) + 1) of ¬
            {"th", "st", "nd", "rd", "th", "th", "th", "th", "th", "th"}
    end if
end ordinalSuffix

-- TEST ----------------------------------------------------------------------
on run

    -- showOrdinals :: [Int] -> [String]
    script showOrdinals
        on |λ|(lstInt)
            map(ordinalString, lstInt)
        end |λ|
    end script

    map(showOrdinals, ¬
        map(uncurry(enumFromTo), ¬
            [[0, 25], [250, 265], [1000, 1025]]))
end run

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

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m > n then
        set d to -1
    else
        set d to 1
    end if
    set lst to {}
    repeat with i from m to n by d
        set end of lst to i
    end repeat
    return lst
end enumFromTo

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

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

-- uncurry :: Handler (a -> b -> c) -> Script |λ| ((a, b) -> c)
on uncurry(f)
    script
        on |λ|(xy)
            set {x, y} to xy
            mReturn(f)'s |λ|(x, y)
        end |λ|
    end script
end uncurry


0 OP = 1
10 FOR N = 0 TO 25 : GOSUB 100 : NEXT
20 FOR N = 250 TO 265 : GOSUB 100 : NEXT
30 FOR N = 1000 TO 1025 : GOSUB 100 : NEXT
40 END

100 GOSUB 200"NTH
110 PRINT NTH$ " ";
120 RETURN

200 M1 = N - INT(N / 10) * 10
210 M2 = N - INT(N / 100) * 100
220 NTH$ = "TH"
230 IF M1 = 1 AND M2 <> 11 THEN NTH$ = "ST"
240 IF M1 = 2 AND M2 <> 12 THEN NTH$ = "ND"
250 IF M1 = 3 AND M2 <> 13 THEN NTH$ = "RD"
260 IF NOT OP THEN NTH$ = "'" + NTH$
270 NTH$ = STR$(N) + NTH$
280 RETURN


suffixes: ["th" "st" "nd" "rd" "th" "th" "th" "th" "th" "th"]

nth: function [n][
    if? or? 100 >= n%100
            20 < n%100
            -> (to :string n) ++ "'" ++ suffixes\[n%10]
    else    -> (to :string n) ++ "'th"
]

loop range.step:250 0 1000 'j [
    loop j..j+24 'i ->
        prints (nth i)++" "
    print ""
]


# syntax: GAWK -f NTH.AWK
BEGIN {
    prn(0,25)
    prn(250,265)
    prn(1000,1025)
    exit(0)
}
function prn(start,stop,  i) {
    printf("%d-%d: ",start,stop)
    for (i=start; i<=stop; i++) {
      printf("%d%s ",i,nth(i))
    }
    printf("\n")
}
function nth(yearday,  nthday) {
    if (yearday ~ /1[1-3]$/) {         # 11th,12th,13th
      nthday = "th"
    }
    else if (yearday ~ /1$/) {         # 1st,21st,31st,etc.
      nthday = "st"
    }
    else if (yearday ~ /2$/) {         # 2nd,22nd,32nd,etc.
      nthday = "nd"
    }
    else if (yearday ~ /3$/) {         # 3rd,23rd,33rd,etc.
      nthday = "rd"
    }
    else if (yearday ~ /[0456789]$/) { # 4th-10th,20th,24th-30th,etc.
      nthday = "th"
    }
    return(nthday)
}


' Nth (sans apostrophes)
FUNCTION nth$(NUMBER n) TYPE STRING
    LOCAL suffix
    IF n < 0 THEN RETURN STR$(n)
    IF MOD(n, 100) >= 11 AND MOD(n, 100) <= 13 THEN
        suffix = "th"
    ELSE
        suffix = MID$("thstndrdthththththth", MOD(n, 10) * 2 + 1, 2)
    ENDIF
    RETURN CONCAT$(STR$(n), suffix)
END FUNCTION

' Test a few ranges
FOR i = 1 TO 4
    READ first, last
    per = 1
    FOR n = first TO last
        PRINT nth$(n) FORMAT "%s "
        ' limit to 10 entries per line
        IF per = 10 OR n = last THEN
            per = 1
            PRINT
        ELSE
            INCR per
        ENDIF
    NEXT
NEXT
DATA 0, 25, 250, 265, 1000, 1025, -20, -11


function ordinal(n)
	ns$ = string(n)
	begin case
		case right(ns$, 1) = "1"
			if right(ns$, 2) = "11" then return ns$ + "th"
			return ns$ + "st"
		case right(ns$, 1) = "2"
			if right(ns$, 2) = "12" then return ns$ + "th"
			return ns$ + "nd"
		case right(ns$, 1) = "3"
			if right(ns$, 2) = "13" then return ns$ + "th"
			return ns$ + "rd"
		else
			return ns$ + "th"
	end case
end function

subroutine imprimeOrdinal(a, b)
	for i = a to b
		print ordinal(i); " ";
	next i
	print
end subroutine

call imprimeOrdinal (0, 25)
call imprimeOrdinal (250, 265)
call imprimeOrdinal (1000, 1025)
end


@echo off
::Main thing...
call :Nth 0 25
call :Nth 250 265
call :Nth 1000 1025
pause
exit /b

::The subroutine
:Nth <lbound> <ubound>
setlocal enabledelayedexpansion
for /l %%n in (%~1,1,%~2) do (
	set curr_num=%%n
	set "out=%%nth"
	if !curr_num:~-1!==1 (set "out=%%nst")
	if !curr_num:~-1!==2 (set "out=%%nnd")
	if !curr_num:~-1!==3 (set "out=%%nrd")
	set "range_output=!range_output! !out!"
)
echo."!range_output:~1!"
goto :EOF


      PROCNth(   0,  25)
      PROCNth( 250, 265)
      PROCNth(1000,1025)
      END

      DEF PROCNth(s%,e%)
      LOCAL i%,suff$
      FOR i%=s% TO e%
        suff$="th"
        IF i% MOD 10 = 1 AND i% MOD 100 <> 11 suff$="st"
        IF i% MOD 10 = 2 AND i% MOD 100 <> 12 suff$="nd"
        IF i% MOD 10 = 3 AND i% MOD 100 <> 13 suff$="rd"
        PRINT STR$i%+suff$+" ";
      NEXT
      PRINT
      ENDPROC


get "libhdr"

// Generate ASCII string of number n with ordinal suffix
// The string is stored at v.
let nth(n, v) = valof
$(  let sfx = "thstndrd"
    let c, s = 0, ?
    // Generate digits
    $(  c := c + 1
        v%c := n rem 10 + '0'
        n := n / 10
    $) repeatuntil n = 0

    // Put digits in correct order
    for i = 1 to c/2 do
    $(  let d = v%i
        v%i := v%(c+1-i)
        v%(c+1-i) := d
    $)

    // The length of the string is the amount of digits + 2
    v%0 := c+2;

    // Figure out the proper suffix from the last two digits
    test v%(c-1)='1' | v%c>'3'
        then s := 0
        else s := 2*(v%c - '0')

    v%(c+1) := sfx%(s+1)
    v%(c+2) := sfx%(s+2)

    resultis v
$)

let start() be
$(  let buf = vec 10
    for i =    0 to   25 do writef("%S*N", nth(i, buf))
    for i =  250 to  265 do writef("%S*N", nth(i, buf))
    for i = 1000 to 1025 do writef("%S*N", nth(i, buf))
$)


#include <stdio.h>

char* addSuffix(int num, char* buf, size_t len)
{
    char *suffixes[4] = { "th", "st", "nd", "rd" };
    int i;

    switch (num % 10)
    {
        case 1 : i = (num % 100 == 11) ? 0 : 1;
	         break;
        case 2 : i = (num % 100 == 12) ? 0 : 2;
                 break;
        case 3 : i = (num % 100 == 13) ? 0 : 3;
                 break;
        default: i = 0;
    };

    snprintf(buf, len, "%d%s", num, suffixes[i]);
    return buf;
}

int main(void)
{
    int i;

    printf("Set [0,25]:\n");
    for (i = 0; i < 26; i++)
    {
        char s[5];
        printf("%s ", addSuffix(i, s, 5));
    }
    putchar('\n');

    printf("Set [250,265]:\n");
    for (i = 250; i < 266; i++)
    {
        char s[6];
        printf("%s ", addSuffix(i, s, 6));
    }
    putchar('\n');

    printf("Set [1000,1025]:\n");
    for (i = 1000; i < 1026; i++)
    {
        char s[7];
        printf("%s ", addSuffix(i, s, 7));
    }
    putchar('\n');

    return 0;
}


using System;
using System.Linq;

class Program
{
    private static string Ordinalize(int i)
    {
        i = Math.Abs(i);

        if (new[] {11, 12, 13}.Contains(i%100))
            return i + "th";

        switch (i%10)
        {
            case 1:
                return i + "st";
            case 2:
                return i + "nd";
            case 3:
                return i + "rd";
            default:
                return i + "th";
        }
    }

    static void Main()
    {
        Console.WriteLine(string.Join(" ", Enumerable.Range(0, 26).Select(Ordinalize)));
        Console.WriteLine(string.Join(" ", Enumerable.Range(250, 16).Select(Ordinalize)));
        Console.WriteLine(string.Join(" ", Enumerable.Range(1000, 26).Select(Ordinalize)));
    }
}


#include <string>
#include <iostream>

using namespace std;

string Suffix(int num)
{
    switch (num % 10)
    {
        case 1 : if(num % 100 != 11) return "st";
           break;
        case 2 : if(num % 100 != 12) return "nd";
           break;
        case 3 : if(num % 100 != 13) return "rd";
    }

    return "th";
}

int main()
{
    cout << "Set [0,25]:" << endl;
    for (int i = 0; i < 26; i++)
        cout << i << Suffix(i) << " ";

    cout << endl;

    cout << "Set [250,265]:" << endl;
    for (int i = 250; i < 266; i++)
        cout << i << Suffix(i) << " ";

    cout << endl;

    cout << "Set [1000,1025]:" << endl;
    for (int i = 1000; i < 1026; i++)
        cout << i << Suffix(i) << " ";

    cout << endl;

    return 0;
}


(defn n-th [n]
  (str n
    (let [rem (mod n 100)]
      (if (and (>= rem 11) (<= rem 13))
        "th"
        (condp = (mod n 10)
          1 "st"
          2 "nd"
          3 "rd"
          "th")))))

(apply str (interpose " " (map n-th (range 0 26))))
(apply str (interpose " " (map n-th (range 250 266))))
(apply str (interpose " " (map n-th (range 1000 1026))))


nth = proc (n: int) returns (string)
    num: string := int$unparse(n)
    sfx: array[string] := array[string]$[0: "th", "st", "nd", "rd"]

    if n / 10 // 10 = 1 cor n // 10 > 3 then
        return(num || sfx[0])
    else
        return(num || sfx[n // 10])
    end
end nth

do_range = proc (from, to: int)
    po: stream := stream$primary_output()
    col: int := 0

    for i: int in int$from_to(from,to) do
        stream$putleft(po, nth(i), 7)
        col := col + 1
        if col = 10 then
            stream$putc(po, '\n')
            col := 0
        end
    end
    stream$putl(po, "\n")
end do_range

start_up = proc ()
    do_range(0,25)
    do_range(250,265)
    do_range(1000,1025)
end start_up


IDENTIFICATION DIVISION.
PROGRAM-ID. NTH-PROGRAM.
DATA DIVISION.
WORKING-STORAGE SECTION.
01  WS-NUMBER.
    05 N               PIC 9(8).
    05 LAST-TWO-DIGITS PIC 99.
    05 LAST-DIGIT      PIC 9.
    05 N-TO-OUTPUT     PIC Z(7)9.
    05 SUFFIX          PIC AA.
PROCEDURE DIVISION.
TEST-PARAGRAPH.
    PERFORM NTH-PARAGRAPH VARYING N FROM 0 BY 1 UNTIL N IS GREATER THAN 25.
    PERFORM NTH-PARAGRAPH VARYING N FROM 250 BY 1 UNTIL N IS GREATER THAN 265.
    PERFORM NTH-PARAGRAPH VARYING N FROM 1000 BY 1 UNTIL N IS GREATER THAN 1025.
    STOP RUN.
NTH-PARAGRAPH.
    MOVE 'TH' TO SUFFIX.
    MOVE N (7:2) TO LAST-TWO-DIGITS.
    IF LAST-TWO-DIGITS IS LESS THAN 4,
    OR LAST-TWO-DIGITS IS GREATER THAN 20,
    THEN PERFORM DECISION-PARAGRAPH.
    MOVE N TO N-TO-OUTPUT.
    DISPLAY N-TO-OUTPUT WITH NO ADVANCING.
    DISPLAY SUFFIX WITH NO ADVANCING.
    DISPLAY SPACE WITH NO ADVANCING.
DECISION-PARAGRAPH.
    MOVE N (8:1) TO LAST-DIGIT.
    IF LAST-DIGIT IS EQUAL TO 1 THEN MOVE 'ST' TO SUFFIX.
    IF LAST-DIGIT IS EQUAL TO 2 THEN MOVE 'ND' TO SUFFIX.
    IF LAST-DIGIT IS EQUAL TO 3 THEN MOVE 'RD' TO SUFFIX.


(defun add-suffix (number)
  (let* ((suffixes #10("th"  "st"  "nd"  "rd"  "th"))
         (last2 (mod number 100))
         (last-digit (mod number 10))
         (suffix (if (< 10 last2 20)
                   "th"
                   (svref suffixes last-digit))))
    (format nil "~a~a" number suffix)))


include "cowgol.coh";
include "strings.coh";

# Given an int32, return decimal string and add an ordinal suffix
sub ordsfx(n: int32, buf: [uint8]): (out: [uint8]) is
    var sfx: [uint8][] := {"th", "st", "nd", "rd"};
    out := buf;
    buf := IToA(n, 10, buf); # IToA is included in standard library

    # Since we now already have the digits, we can make the decision
    # without doing any more work.
    if (n > 10 and [@prev @prev buf] == '1')
    or ([@prev buf] > '3') then
        CopyString(sfx[0], buf);
    else
        CopyString(sfx[[@prev buf]-'0'], buf);
    end if;
end sub;

# Print suffixed numerals from start to end inclusive
sub test(start: int32, end_: int32) is
    var buf: uint8[16]; # buffer

    var n: uint8 := 10;
    while start <= end_ loop
        print(ordsfx(start, &buf[0]));
        print_char(' ');
        start := start + 1;
        n := n - 1;
        if n == 0 then
            print_nl();
            n := 10;
        end if;
    end loop;
    print_nl();
end sub;

test(0, 25);
test(250,265);
test(1000,1025);


struct Int
  def ordinalize
    num = self.abs
    ordinal = if (11..13).includes?(num % 100)
      "th"
    else
      case num % 10
        when 1; "st"
        when 2; "nd"
        when 3; "rd"
        else    "th"
      end
    end
    "#{self}#{ordinal}"
  end
end

[(0..25),(250..265),(1000..1025)].each{|r| puts r.map{ |n| n.ordinalize }.join(", "); puts}


import std.stdio, std.string, std.range, std.algorithm;

string nth(in uint n) pure {
    static immutable suffix = "th st nd rd th th th th th th".split;
    return "%d'%s".format(n, (n % 100 <= 10 || n % 100 > 20) ?
                             suffix[n % 10] : "th");
}

void main() {
    foreach (r; [iota(26), iota(250, 266), iota(1000, 1026)])
        writefln("%-(%s %)", r.map!nth);
}


proc nonrec nth(word n; *char buf) *char:
    channel output text ch;
    open(ch, buf);
    write(ch; n,
        if   (n/10)%10=1 then "th"
        elif n%10=1 then "st"
        elif n%10=2 then "nd"
        elif n%10=3 then "rd"
        else "th"
        fi
    );
    close(ch);
    buf
corp;

proc nonrec print_range(word start, stop) void:
    [8] char buf;
    word col, n;
    col := 0;
    for n from start upto stop do
        write(nth(n, &buf[0]));
        col := col + 1;
        if col%10=0 then writeln() else write('\t') fi
    od;
    writeln()
corp

proc nonrec main() void:
    print_range(0, 25);
    print_range(250, 265);
    print_range(1000, 1025)
corp


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

extension op
{
    ordinalize()
    {
        int i := self.Absolute;
        if (new int[]{11,12,13}.ifExists(i.mod:100))
        {
            ^ i.toPrintable() + "th"
        };

        (i.mod(10)) =>
            1 { ^ i.toPrintable() + "st" }
            2 { ^ i.toPrintable() + "nd" }
            3 { ^ i.toPrintable() + "rd" };

        ^ i.toPrintable() + "th"
    }
}

public program()
{
    console.printLine(new Range(0,26).selectBy(mssgconst ordinalize<op>[1]));
    console.printLine(new Range(250,26).selectBy(mssgconst ordinalize<op>[1]));
    console.printLine(new Range(1000,26).selectBy(mssgconst ordinalize<op>[1]))
}


defmodule RC do
  def ordinalize(n) do
    num = abs(n)
    ordinal = if rem(num, 100) in 4..20 do
                "th"
              else
                case rem(num, 10) do
                  1 -> "st"
                  2 -> "nd"
                  3 -> "rd"
                  _ -> "th"
                end
              end
    "#{n}#{ordinal}"
  end
end

Enum.each([0..25, 250..265, 1000..1025], fn range ->
  Enum.map(range, fn n -> RC.ordinalize(n) end) |> Enum.join(" ") |> IO.puts
end)


PROGRAM NTH_SOLVE

!
! for rosettacode.org
!

PROCEDURE NTH(S%,E%)
      LOCAL I%,SUFF$
      FOR I%=S% TO E% DO
        SUFF$="th"
        IF I% MOD 10=1 AND I% MOD 100<>11 THEN SUFF$="st" END IF
        IF I% MOD 10=2 AND I% MOD 100<>12 THEN SUFF$="nd" END IF
        IF I% MOD 10=3 AND I% MOD 100<>13 THEN SUFF$="rd" END IF
        PRINT(STR$(I%)+SUFF$+" ";)
      END FOR
      PRINT
END PROCEDURE

BEGIN
   NTH(0,25)
   NTH(250,265)
   NTH(1000,1025)
END PROGRAM


open System

let ordinalsuffix n =
    let suffixstrings = [|"th"; "st"; "nd"; "rd"|]
    let (d, r) = Math.DivRem(n, 10)
    n.ToString() + suffixstrings.[ if r < 4 && (d &&& 1) = 0 then r else 0 ]

[<EntryPoint>]
let main argv =
    let show = (Seq.iter (ordinalsuffix >> (printf " %s"))) >> (Console.WriteLine)
    [0..25] |> show
    [250..265] |> show
    [1000..1025] |> show
    0


USING: io kernel math math.order math.parser math.ranges qw
sequences ;
IN: rosetta-code.nth

: n'th ( n -- str )
    dup 10 /mod swap 1 = [ drop 0 ] when
    [ number>string ]
    [ 4 min qw{ th st nd rd th } nth ] bi* append ;

: n'th-demo ( -- )
    0 25 250 265 1000 1025 [ [a,b] ] [email protected]
    [ [ n'th write bl ] each nl ] [email protected] ;

MAIN: n'th-demo


: 'nth ( -- c-addr )  s" th st nd rd th th th th th th " drop ;
: .nth ( n -- )
  dup 10 20 within if 0 .r ." th " exit then
  dup 0 .r 10 mod 3 * 'nth + 3 type ;

: test ( n n -- )  cr do i 5 mod 0= if cr then i .nth loop ;
: tests ( -- )
  26 0 test  266 250 test  1026 1000 test ;

tests


!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Fri Jun  6 15:40:18
!
!a=./f && make -k $a && echo 0 25 | $a && echo 250 265 | $a && echo 1000 1025 | $a
!gfortran -std=f2008 -Wall -fopenmp -ffree-form -fall-intrinsics -fimplicit-none -g f.f08 -o f
!                  0'th                  1'st                  2'nd
!                  3'rd                  4'th                  5'th
!                  6'th                  7'th                  8'th
!                  9'th                 10'th                 11'th
!                 12'th                 13'th                 14'th
!                 15'th                 16'th                 17'th
!                 18'th                 19'th                 20'th
!                 21'st                 22'nd                 23'rd
!                 24'th                 25'th
!                                      250'th                251'st
!                252'nd                253'rd                254'th
!                255'th                256'th                257'th
!                258'th                259'th                260'th
!                261'st                262'nd                263'rd
!                264'th                265'th
!                                     1000th                1001st
!               1002nd                1003rd                1004th
!               1005th                1006th                1007th
!               1008th                1009th                1010th
!               1011th                1012th                1013th
!               1014th                1015th                1016th
!               1017th                1018th                1019th
!               1020th                1021st                1022nd
!               1023rd                1024th                1025th
!
!Compilation finished at Fri Jun  6 15:40:18

program nth
  implicit none
  logical :: need
  integer :: here, there, n, i, iostat
  read(5,*,iostat=iostat) here, there
  if (iostat .ne. 0) then
     write(6,*)'such bad input never before seen.'
     write(6,*)'I AYE EYE QUIT!'
     call exit(1)
  end if
  need = .false.
  n = abs(there - here) + 1
  i = 0
  do while (0 /= mod(3+mod(here-i, 3), 3))
     write(6,'(a22)',advance='no') ''
     i = i+1
  end do
  do i = here, there, sign(1, there-here)
     write(6,'(a22)',advance='no') ordinate(i)
     if (2 /= mod(i,3)) then
        need = .true.
     else
        write(6,'(a)')''
        need = .false.
     end if
  end do
  if (need) write(6,'(a)')''

contains

  character(len=22) function ordinate(n)
    character(len=19) :: a
    character(len=20), parameter :: &
         &a09 =   "thstndrdthththththth",&
         &ateen = "thththththththththth"
    integer :: ones, tens, ones_index
    integer, intent(in) :: n
    write(a,'(i19)') n
    ones = mod(n,10)
    tens = mod(n,100)
    ones_index = ones*2+1
    if (n < 1000) then
       if ((10 .le. tens) .and. (tens .lt. 20)) then
          ordinate = a // "'" // ateen(ones_index:ones_index+1)
          !            ^^^^^^  remove these characters to remove the important '
       else
          ordinate = a // "'" // a09(ones_index:ones_index+1)
          !            ^^^^^^  remove these characters to remove the important '
       end if
    else
       if ((10 .le. tens) .and. (tens .lt. 20)) then
          ordinate = a // ateen(ones_index:ones_index+1)
       else
          ordinate = a // a09(ones_index:ones_index+1)
       end if
    end if
  end function ordinate

end program nth


' FB 1.05.0 Win64

' Apostrophes NOT used as incorrect English

Function ordinal(n As UInteger) As String
  Dim ns As String = Str(n)
  Select Case Right(ns, 1)
    Case "0", "4" To "9"
      Return ns + "th"
    Case "1"
      If Right(ns, 2) = "11" Then Return ns + "th"
      Return ns + "st"
    Case "2"
      If Right(ns, 2) = "12" Then Return ns + "th"
      Return ns + "nd"
    Case "3"
      If Right(ns, 2) = "13" Then Return ns + "th"
      Return ns + "rd"
  End Select
End Function

Dim i As Integer
For i = 0 To 25
  Print ordinal(i); " ";
Next
Print : Print

For i = 250 To 265
  Print ordinal(i); " ";
Next
Print : Print

For i = 1000 To 1025
  Print ordinal(i); " ";
Next
Print : Print

Print "Press any key to quit"
Sleep


Public Sub Main()
Dim siNums As Short[] = [0, 25, 250, 265, 1000, 1025]
Dim siCount, siNumbers As Short
Dim sOrdinal As String

For siNumbers = 0 To 4 Step 2
  For siCount = siNums[siNumbers] To siNums[siNumbers + 1]
    sOrdinal = "th"
    If Right(Str(siCount), 1) = "1" And Right(Str(siCount), 2) <> "11" Then sOrdinal = "st"
    If Right(Str(siCount), 1) = "2" And Right(Str(siCount), 2) <> "12" Then sOrdinal = "nd"
    If Right(Str(siCount), 1) = "3" And Right(Str(siCount), 2) <> "13" Then sOrdinal = "rd"
    Print siCount & sOrdinal;;
  Next
  Print gb.NewLine
Next

End


package main

import "fmt"

func ord(n int) string {
    s := "th"
    switch c := n % 10; c {
    case 1, 2, 3:
        if n%100/10 == 1 {
            break
        }
        switch c {
        case 1:
            s = "st"
        case 2:
            s = "nd"
        case 3:
            s = "rd"
        }
    }
    return fmt.Sprintf("%d%s", n, s)
}

func main() {
    for n := 0; n <= 25; n++ {
        fmt.Printf("%s ", ord(n))
    }
    fmt.Println()
    for n := 250; n <= 265; n++ {
        fmt.Printf("%s ", ord(n))
    }
    fmt.Println()
    for n := 1000; n <= 1025; n++ {
        fmt.Printf("%s ", ord(n))
    }
    fmt.Println()
}


10  ' N'th
20  LET LOLIM% = 0
30  LET HILIM% = 25
40  GOSUB 1000
50  LET LOLIM% = 250
60  LET HILIM% = 265
70  GOSUB 1000
80  LET LOLIM% = 1000
90  LET HILIM% = 1025
100 GOSUB 1000
110 END

995  ' Print images
1000 FOR I% = LOLIM% TO HILIM%
1010  LET NR% = I%
1020  GOSUB 1500
1030  LET SI$ = STR$(I%)
1040  PRINT RIGHT$(SI$, LEN(SI$) - 1); SUF$; " ";
1050 NEXT I%
1060 PRINT
1070 RETURN

1495 ' Get suffix
1500 IF (NR% MOD 10 = 1) AND (NR% MOD 100 <> 11) THEN LET SUF$ = "st": GOTO 2000
1600 IF (NR% MOD 10 = 2) AND (NR% MOD 100 <> 12) THEN LET SUF$ = "nd": GOTO 2000
1700 IF (NR% MOD 10 = 3) AND (NR% MOD 100 <> 13) THEN LET SUF$ = "rd": GOTO 2000
1800 LET SUF$ = "th"
2000 RETURN


import Data.Array

ordSuffs :: Array Integer String
ordSuffs = listArray (0,9) ["th", "st", "nd", "rd", "th",
                            "th", "th", "th", "th", "th"]

ordSuff :: Integer -> String
ordSuff n = show n ++ suff n
  where suff m | (m `rem` 100) >= 11 && (m `rem` 100) <= 13 = "th"
               | otherwise          = ordSuffs ! (m `rem` 10)

printOrdSuffs :: [Integer] -> IO ()
printOrdSuffs = putStrLn . unwords . map ordSuff

main :: IO ()
main = do
  printOrdSuffs [   0..  25]
  printOrdSuffs [ 250.. 265]
  printOrdSuffs [1000..1025]


public class Nth {
	public static String ordinalAbbrev(int n){
		String ans = "th"; //most of the time it should be "th"
		if(n % 100 / 10 == 1) return ans; //teens are all "th"
		switch(n % 10){
			case 1: ans = "st"; break;
			case 2: ans = "nd"; break;
			case 3: ans = "rd"; break;
		}
		return ans;
	}

	public static void main(String[] args){
		for(int i = 0; i <= 25;i++){
			System.out.print(i + ordinalAbbrev(i) + " ");
		}
		System.out.println();
		for(int i = 250; i <= 265;i++){
			System.out.print(i + ordinalAbbrev(i) + " ");
		}
		System.out.println();
		for(int i = 1000; i <= 1025;i++){
			System.out.print(i + ordinalAbbrev(i) + " ");
		}
	}
}


console.log(function () {

  var lstSuffix = 'th st nd rd th th th th th th'.split(' '),

    fnOrdinalForm = function (n) {
      return n.toString() + (
        11 <= n % 100 && 13 >= n % 100 ?
        "th" : lstSuffix[n % 10]
      );
    },

    range = function (m, n) {
      return Array.apply(
        null, Array(n - m + 1)
      ).map(function (x, i) {
        return m + i;
      });
    };

  return [[0, 25], [250, 265], [1000, 1025]].map(function (tpl) {
    return range.apply(null, tpl).map(fnOrdinalForm).join(' ');
  }).join('\n\n');

}());


# ordinalize an integer input, positive or negative
def ordinalize:
 (if . < 0 then -(.) else . end) as $num
 | ($num % 100) as $small
 | (if 11 <= $small and $small <= 13 then "th"
    else
    ( $num % 10)
      | (if   . == 1 then "st"
         elif . == 2 then "nd"
         elif . == 3 then "rd"
         else             "th"
         end)
    end) as $ordinal
 | "\(.)\($ordinal)" ;

([range(-5; -1)], [range(0;26)], [range(250;266)], [range(1000;1026)])
 | map(ordinalize)


fun Int.ordinalAbbrev() =
        if (this % 100 / 10 == 1) "th"
        else when (this % 10) { 1 -> "st" 2 -> "nd" 3 -> "rd" else -> "th" }

fun IntRange.ordinalAbbrev() = map { "$it" + it.ordinalAbbrev() }.joinToString(" ")

fun main(args: Array<String>) {
    listOf((0..25), (250..265), (1000..1025)).forEach { println(it.ordinalAbbrev()) }
}


{def fnOrdinalForm
 {lambda {:n}
  {if {and {<= 11 {% :n 100}} {>= 13 {% :n 100}}}
   then :nth
   else :n{A.get {% :n 10} th st nd rd th th th th th th}}}}
-> fnOrdinalForm

{S.map fnOrdinalForm {S.serie 0 25}}
-> 0th 1st 2nd 3rd 4th 5th 6th 7th 8th 9th 10th 11th 12th 13th 14th 15th
 16th 17th 18th 19th 20th 21st 22nd 23rd 24th 25th

{S.map fnOrdinalForm {S.serie 250 265}}
-> 250th 251st 252nd 253rd 254th 255th 256th 257th 258th 259th 260th
261st 262nd 263rd 264th 265th

{S.map fnOrdinalForm {S.serie 1000 1025}}
-> 1000th 1001st 1002nd 1003rd 1004th 1005th 1006th 1007th 1008th 1009th 1010th
1011th 1012th 1013th 1014th 1015th 1016th 1017th 1018th 1019th 1020th
1021st 1022nd 1023rd 1024th 1025th


call printImages    0,   25
call printImages  250,  265
call printImages 1000, 1025
end

sub printImages loLim, hiLim
  loLim = int(loLim)
  hiLIm = int(hiLim)
  for i = loLim to hiLim
    print str$(i) + suffix$(i) + " ";
  next i
  print
end sub

function suffix$(n)
  n = int(n)
  nMod10 = n mod 10
  nMod100 = n mod 100
  if (nMod10 = 1) and (nMod100 <> 11) then
    suffix$ = "st"
  else
    if (nMod10 = 2) and (nMod100 <> 12) then
      suffix$ = "nd"
    else
      if (NMod10 = 3) and (NMod100 <> 13) then
        suffix$ = "rd"
      else
        suffix$ = "th"
      end if
    end if
  end if
end function


function getSuffix (n)
    local lastTwo, lastOne = n % 100, n % 10
    if lastTwo > 3 and lastTwo < 21 then return "th" end
    if lastOne == 1 then return "st" end
    if lastOne == 2 then return "nd" end
    if lastOne == 3 then return "rd" end
    return "th"
end

function Nth (n) return n .. "'" .. getSuffix(n) end

for i = 0, 25 do print(Nth(i), Nth(i + 250), Nth(i + 1000)) end


toOrdinal := proc(n:: nonnegint)
	if 1 <= n and n <= 10 then
		if n >= 4 then
			printf("%ath", n);
		elif n = 3 then
			printf("%ard", n);
		elif n = 2 then
			printf("%and", n);
		else
			printf("%ast", n);
		end if:
	else
		printf(convert(n, 'ordinal'));
	end if:
	return NULL;
end proc:

a := [[0, 25], [250, 265], [1000, 1025]]:
for i in a do
	for j from i[1] to i[2] do
		toOrdinal(j);
		printf("   ");
	end do;
	printf("\n\n");
end do;


suffixlist = {"th", "st", "nd", "rd", "th", "th", "th", "th", "th","th"};
addsuffix[n_] := Module[{suffix},
  suffix = Which[
    Mod[n, 100] <= 10, suffixlist[[Mod[n, 10] + 1]],
    Mod[n, 100] > 20, suffixlist[[Mod[n, 10] + 1]],
    True, "th"
    ];
  ToString[n] <> suffix
  ]
addsuffix[#] & /@ Range[0, 25] (* test 1 *)
addsuffix[#] & /@ Range[250, 265] (* test 2 *)
addsuffix[#] & /@ Range[1000, 1025] (* test 3 *)


function s = nth(n)
    tens = mod(n, 100);
    if tens > 9 && tens < 20
        suf = 'th';
    else
        switch mod(n, 10)
            case 1
                suf = 'st';
            case 2
                suf = 'nd';
            case 3
                suf = 'rd';
            otherwise
                suf = 'th';
        end
    end
    s = sprintf('%d%s', n, suf);
end


loLim = 0
hiLim = 25
PrintImages()
loLim = 250
hiLim = 265
PrintImages()
loLim = 1000
hiLim = 1025
PrintImages()

Sub PrintImages
  For i = loLim To hiLim
    nr = i
    GetSuffix()
    TextWindow.Write(i + suffix + " ")
  EndFor
  TextWindow.WriteLine("")
EndSub

Sub GetSuffix
  rem10  = Math.Remainder(nr, 10)
  rem100 = Math.Remainder(nr, 100)
  If rem10 = 1 And rem100 <> 11 Then
    suffix = "st"
  ElseIf rem10 = 2 And rem100 <> 12 Then
    suffix = "nd"
  ElseIf rem10 = 3 And rem100 <> 13 Then
    suffix = "rd"
  Else
    suffix = "th"
  EndIf
EndSub


ordinal = function(n)
    if n > 3 and n < 20 then return n + "th"
    if n % 10 == 1 then return n + "st"
    if n % 10 == 2 then return n + "nd"
    if n % 10 == 3 then return n + "rd"
    return n + "th"
end function

out = []
test = function(from, to)
    for i in range(from, to)
        out.push ordinal(i)
    end for
end function

test 0, 25
test 250, 265
test 1000, 1025
print out.join


MODULE Nth;

FROM STextIO IMPORT
  WriteString, WriteLn;
FROM WholeStr IMPORT
  IntToStr;

PROCEDURE Suffix(N: CARDINAL; VAR OUT Destination: ARRAY OF CHAR);
VAR
  NMod10, NMod100: CARDINAL;
BEGIN
  NMod10 := N MOD 10;
  NMod100 := N MOD 100;
  IF (NMod10 = 1) AND (NMod100 <> 11) THEN
    Destination := "st";
  ELSIF (NMod10 = 2) AND (NMod100 <> 12) THEN
    Destination := "nd";
  ELSIF (NMod10 = 3) AND (NMod100 <> 13) THEN
    Destination := "rd";
  ELSE
    Destination := "th";
  END;
END Suffix;

PROCEDURE PrintImages(LoLim, HiLim: CARDINAL);
VAR
  I: CARDINAL;
  IString: ARRAY [0 .. 15] OF CHAR;
  ISuff: ARRAY [0 .. 1] OF CHAR;
BEGIN
  FOR I := LoLim TO HiLim DO
    IntToStr(I, IString);
    Suffix(I, ISuff);
    WriteString(IString);
    WriteString(ISuff);
    WriteString(" ");
  END;
  WriteLn;
END PrintImages;

BEGIN
  PrintImages(   0,   25);
  PrintImages( 250,  265);
  PrintImages(1000, 1025);
END Nth.


def ordinalAbbrev(n)
        if int(n % 100 / 10) = 1
                return "th"
        end

        if n % 10 = 1
                return "st"
        else if n % 10 = 2
                return "nd"
        else if n % 10 = 3
                return "rd"
        else
                return "th"
        end
end

for i in range(0, 25)
        print (i + "'" + ordinalAbbrev(i) + " ")
end
println

for i in range(250, 265)
        print (i + "'" + ordinalAbbrev(i) + " ")
end
println

for i in range(1000, 1025)
        print (i + "'" + ordinalAbbrev(i) + " ")
end
println


const Suffix = ["th", "st", "nd", "rd", "th", "th", "th", "th", "th", "th"]

proc nth(n: Natural): string =
  $n & "'" & (if n mod 100 in 11..20: "th" else: Suffix[n mod 10])

for j in countup(0, 1000, 250):
  for i in j..j+24:
    stdout.write nth(i), " "
  echo ""


class Nth {
  function : OrdinalAbbrev(n : Int ) ~ String {
    ans := "th"; # most of the time it should be "th"
    if(n % 100 / 10 = 1) {
      return ans; # teens are all "th"
    };

    select(n % 10){
      label 1: { ans := "st"; }
      label 2: { ans := "nd"; }
      label 3: { ans := "rd"; }
    };

    return ans;
  }

  function : Main(args : String[]) ~ Nil {
    for(i := 0; i <= 25; i+=1;) {
      abbr := OrdinalAbbrev(i);
      "{$i}{$abbr} "->Print();
    };

    ""->PrintLine();
    for(i := 250; i <= 265; i+=1;) {
      abbr := OrdinalAbbrev(i);
      "{$i}{$abbr} "->Print();
    };

    ""->PrintLine();
    for(i := 1000; i <= 1025; i+=1;) {
      abbr := OrdinalAbbrev(i);
      "{$i}{$abbr} "->Print();
    };
  }
}


let show_nth n =
  if (n mod 10 = 1) && (n mod 100 <> 11) then "st"
  else if (n mod 10 = 2) && (n mod 100 <> 12) then "nd"
  else if (n mod 10 = 3) && (n mod 100 <> 13) then "rd"
  else "th"

let () =
  let show_ordinals (min, max) =
    for i=min to max do
      Printf.printf "%d%s " i (show_nth i)
    done;
    print_newline() in

  List.iter show_ordinals [ (0,25); (250,265); (1000,1025) ]


: nth(n)
| r |
   n "th" over 10 mod ->r
   r 1 == ifTrue: [ n 100 mod 11 == ifFalse: [ drop "st" ] ]
   r 2 == ifTrue: [ n 100 mod 12 == ifFalse: [ drop "nd" ] ]
   r 3 == ifTrue: [ n 100 mod 13 == ifFalse: [ drop "rd" ] ]
   + ;


Program n_th;

function Suffix(N: NativeInt):AnsiString;
var
  res: AnsiString;
begin
  res:= 'th';
  case N mod 10 of
  1:IF N mod 100 <> 11 then
      res:= 'st';
  2:IF N mod 100 <> 12 then
      res:= 'nd';
  3:IF N mod 100 <> 13 then
      res:= 'rd';
  else
  end;
  Suffix := res;
end;

procedure Print_Images(loLim, HiLim: NativeInt);
var
  i : NativeUint;
begin
  for I := LoLim to HiLim do
    write(i,Suffix(i),' ');
  writeln;
end;

begin
   Print_Images(   0,   25);
   Print_Images( 250,  265);
   Print_Images(1000, 1025);
end.


constant ordinals = {"th","st","nd","rd"}

function Nth(integer n, bool apostrophe=false)
    integer mod10 = mod(n,10)+1
    if mod10>4 or mod(n,100)=mod10+9 then mod10 = 1 end if
    return sprintf("%d%s",{n,repeat('\'',apostrophe)&ordinals[mod10]})
end function

constant ranges = {{0,25},{250,265},{1000,1025}}
for i=1 to length(ranges) do
    for j=ranges[i][1] to ranges[i][2] do
        if mod(j,10)=0 then puts(1,"\n") end if
        printf(1," %6s",{Nth(j,i=2)})
    end for
    puts(1,"\n")
end for


nth2(N) = N.to_string() ++ Th =>
  ( tween(N)     -> Th = "th"
  ; 1 = N mod 10 -> Th = "st"
  ; 2 = N mod 10 -> Th = "nd"
  ; 3 = N mod 10 -> Th = "rd"
  ; Th = "th" ).
tween(N) => Tween = N mod 100, between(11, 13, Tween).


(de rangeth (A B)
   (mapcar
      '((I)
         (pack I
            (if (member (% I 100) (11 12 13))
               'th
               (case (% I 10)
                  (1 'st)
                  (2 'nd)
                  (3 'rd)
                  (T 'th) ) ) ) )
         (range A B) ) )

(prinl (glue " " (rangeth 0 25)))
(prinl (glue " " (rangeth 250 265)))
(prinl (glue " " (rangeth 1000 1025)))

(bye)


Nth: procedure options (main);   /* 1 June 2014 */
   declare i fixed (10);

   do i = 0 to 25, 250 to 265, 1000 to 1025;
      if i = 250 | i = 1000 then put skip (2);
      put edit (enth(i)) (x(1), a);
   end;

enth: procedure (i) returns (character (25) varying);
   declare i fixed (10);
   declare suffix character (2);

   select (mod(i, 10));
      when (1)  suffix = 'st';
      when (2)  suffix = 'nd';
      when (3)  suffix = 'rd';
      otherwise suffix = 'th';
   end;
   select (mod(i, 100));
      when (11, 12, 13) suffix = 'th';
      otherwise ;
   end;
   return ( trim(i) || suffix );
end enth;

end Nth;


function nth($inp){
	$suffix = "th"

	switch($inp % 10){
		1{$suffix="st"}
		2{$suffix="nd"}
		3{$suffix="rd"}
	}
	return "$inp$suffix "
}

0..25 | %{Write-host -nonewline (nth "$_")};""
250..265 | %{Write-host -nonewline (nth "$_")};""
1000..1025 | %{Write-host -nonewline (nth "$_")};""


nth(N, N_Th) :-
    ( tween(N)      -> Th = "th"
    ; 1 is N mod 10 -> Th = "st"
    ; 2 is N mod 10 -> Th = "nd"
    ; 3 is N mod 10 -> Th = "rd"
    ; Th = "th" ),
    string_concat(N, Th, N_Th).

tween(N) :- Tween is N mod 100, between(11, 13, Tween).

test :-
    forall( between(0,25, N),     (nth(N, N_Th), format('~w, ', N_Th)) ),
    nl, nl,
    forall( between(250,265,N),   (nth(N, N_Th), format('~w, ', N_Th)) ),
    nl, nl,
    forall( between(1000,1025,N), (nth(N, N_Th), format('~w, ', N_Th)) ).


Procedure.s Suffix(n.i)
  Select n%10
    Case 1 : If n%100<>11 : ProcedureReturn "st" : EndIf
    Case 2 : If n%100<>12 : ProcedureReturn "nd" : EndIf
    Case 3 : If n%100<>13 : ProcedureReturn "rd" : EndIf
  EndSelect
  ProcedureReturn "th"
EndProcedure

Procedure put(a.i,b.i)
  For i=a To b : Print(Str(i)+Suffix(i)+" ") : Next
  PrintN("")
EndProcedure

If OpenConsole()=0 : End 1 : EndIf
put(0,25)
put(250,265)
put(1000,1025)
Input()


_suffix = ['th', 'st', 'nd', 'rd', 'th', 'th', 'th', 'th', 'th', 'th']

def nth(n):
    return "%i'%s" % (n, _suffix[n%10] if n % 100 <= 10 or n % 100 > 20 else 'th')

if __name__ == '__main__':
    for j in range(0,1001, 250):
        print(' '.join(nth(i) for i in list(range(j, j+25))))


  [ table ]                is suffix   (   n --> $ )

  $ "th st nd rd th th th th th th"
  nest$ witheach [ ' suffix put ]

  [ dup number$
    swap dup 100 mod
    10 21 within iff
      [ drop $ "th" join ]
    else
      [ 10 mod
        suffix join ] ]    is ordinal$ (   n --> $ )

  [ over - 1+
    [] swap times
      [ over i^ + ordinal$
        nested join ]
    nip  50 wrap$ ]        is test     ( n n -->   )

  0 25 test
  cr
  250 265 test
  cr
  1000 1025 test


nth <- function(n)
{
  if (length(n) > 1) return(sapply(n, nth))

  mod <- function(m, n) ifelse(!(m%%n), n, m%%n)
  suffices <- c("th", "st", "nd", "rd", "th", "th", "th", "th", "th", "th")

  if (n %% 100 <= 10 || n %% 100 > 20)
    suffix <- suffices[mod(n+1, 10)]
  else
    suffix <- 'th'

  paste(n, "'", suffix, sep="")
}

range <- list(0:25, 250:275, 500:525, 750:775, 1000:1025)

sapply(range, nth)


#lang racket
(define (teen? n) (<= 11 (modulo n 100) 19))
(define (Nth n)
  (format
   "~a'~a" n
   (match* ((modulo n 10) n)
     [((or 1 2 3) (? teen?)) 'th] [(1 _) 'st] [(2 _) 'nd] [(3 _) 'rd] [(_ _) 'th])))

(for ((range (list  (in-range 26) (in-range 250 266) (in-range 1000 1026))))
  (displayln (string-join (for/list ((nth (sequence-map Nth range))) nth) " ")))


Red[]

nth: function [n][
    d: n % 10
    suffix: either any [d < 1 d > 4 1 = to-integer n / 10] [4] [d]
    rejoin [n pick ["st" "nd" "rd" "th"] suffix]
]

test: function [low high][
    repeat i high - low + 1 [
        prin [nth i + low - 1 ""]
    ]
    prin newline
]

test 0 25
test 250 265
test 1000 1025


/*REXX program shows ranges of numbers  with  ordinal  (st/nd/rd/th)  suffixes attached.*/
call tell     0,    25                           /*display the  1st  range of numbers.  */
call tell   250,   265                           /*   "     "   2nd    "    "    "      */
call tell  1000,  1025                           /*   "     "   3rd    "    "    "      */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
tell: procedure; parse arg L,H,,$                /*get the Low and High #s, nullify list*/
           do j=L  to  H;   $=$ th(j);   end     /*process the range, from low ───► high*/
      say 'numbers from  '    L    " to "    H    ' (inclusive):'  /*display the title. */
      say strip($);    say;     say                                /*display line; 2 sep*/
      return                                                       /*return to invoker. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
th: parse arg z; x=abs(z); return z||word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4))


for nr = 0 to 25
    see Nth(nr) + Nth(nr + 250) + Nth(nr + 1000) + nl
next

func getSuffix n
     lastTwo = n % 100
     lastOne = n % 10
     if lastTwo > 3 and lastTwo < 21  "th" ok
     if lastOne = 1 return "st" ok
     if lastOne = 2 return "nd" ok
     if lastOne = 3 return "rd" ok
     return "th"

func Nth n
     return  "" + n + "'" +  getSuffix(n) + " "


class Integer
  def ordinalize
    num = self.abs
    ordinal = if (11..13).include?(num % 100)
      "th"
    else
      case num % 10
        when 1; "st"
        when 2; "nd"
        when 3; "rd"
        else    "th"
      end
    end
    "#{self}#{ordinal}"
  end
end

[(0..25),(250..265),(1000..1025)].each{|r| puts r.map(&:ordinalize).join(", "); puts}


object Nth extends App {
  def abbrevNumber(i: Int) = print(s"$i${ordinalAbbrev(i)} ")

  def ordinalAbbrev(n: Int) = {
    val ans = "th" //most of the time it should be "th"
    if (n % 100 / 10 == 1) ans //teens are all "th"
    else (n % 10) match {
      case 1 => "st"
      case 2 => "nd"
      case 3 => "rd"
      case _ => ans
    }
  }

  (0 to 25).foreach(abbrevNumber)
  println()
  (250 to 265).foreach(abbrevNumber)
  println();
  (1000 to 1025).foreach(abbrevNumber)
}


$ include "seed7_05.s7i";

const func string: suffix (in integer: num) is func
  result
    var string: suffix is "";
  begin
    if    num rem 10 = 1 and num rem 100 <> 11 then suffix := "st";
    elsif num rem 10 = 2 and num rem 100 <> 12 then suffix := "nd";
    elsif num rem 10 = 3 and num rem 100 <> 13 then suffix := "rd";
    else suffix := "th";
    end if;
   end func;

const proc: printImages (in integer: start, in integer: stop) is func
  local
    var integer: num is 0;
  begin
    for num range start to stop do
      write(num <& suffix(num) <& " ");
    end for;
    writeln;
  end func;

const proc: main is func
  begin
    printImages(   0,   25);
    printImages( 250,  265);
    printImages(1000, 1025);
  end func;


set o 49
set t 50
set h 51
set n !
set ! n
set ! 39
[n=o] set ? 13
[n=t] set ? 16
[n=h] set ? 19
set ! T
set ! H
set ? 21
set ! S
set ! T
set ? 21
set ! N
set ! D
set ? 12
set ! R
set ! D
> EOF


func nth(n) {
    static irregulars = Hash(<1 ˢᵗ 2 ⁿᵈ 3 ʳᵈ 11 ᵗʰ 12 ᵗʰ 13 ᵗʰ>...)
    n.to_s + (irregulars{n % 100} \\ irregulars{n % 10} \\ 'ᵗʰ')
}

for r in [0..25, 250..265, 1000..1025] {
    say r.map {|n| nth(n) }.join(" ")
}


 10 FOR N=0 TO 25
 20 GOSUB 160
 30 PRINT N$;" ";
 40 NEXT N
 50 PRINT
 60 FOR N=250 TO 265
 70 GOSUB 160
 80 PRINT N$;" ";
 90 NEXT N
100 PRINT
110 FOR N=1000 TO 1025
120 GOSUB 160
130 PRINT N$;" ";
140 NEXT N
150 STOP
160 LET N$=STR$ N
170 LET S$="TH"
180 IF LEN N$=1 THEN GOTO 200
190 IF N$(LEN N$-1)="1" THEN GOTO 230
200 IF N$(LEN N$)="1" THEN LET S$="ST"
210 IF N$(LEN N$)="2" THEN LET S$="ND"
220 IF N$(LEN N$)="3" THEN LET S$="RD"
230 LET N$=N$+S$
240 RETURN


SELECT level card,
        to_char(to_date(level,'j'),'fmjth') ord
FROM dual
CONNECT BY level <= 15;

SELECT to_char(to_date(5373485,'j'),'fmjth')
FROM dual;


local
  val v = Vector.tabulate (10, fn 1 => "st" | 2 => "nd" | 3 => "rd" | _ => "th")
  fun getSuffix x =
    if 3 < x andalso x < 21 then "th" else Vector.sub (v, x mod 10)
in
  fun nth n =
    Int.toString n ^ getSuffix (n mod 100)
end

(* some test ouput *)
val () = (print o concat o List.tabulate)
  (26, fn i => String.concatWith "\t" (map nth [i, i + 250, i + 1000]) ^ "\n")


func addSuffix(n:Int) -> String {
    if n % 100 / 10 == 1 {
        return "th"
    }

    switch n % 10 {
    case 1:
        return "st"
    case 2:
        return "nd"
    case 3:
        return "rd"
    default:
        return "th"
    }
}

for i in 0...25 {
    print("\(i)\(addSuffix(i)) ")
}
println()
for i in 250...265 {
    print("\(i)\(addSuffix(i)) ")
}
println()
for i in 1000...1025 {
    print("\(i)\(addSuffix(i)) ")
}
println()


proc ordinal {n} {
    if {$n%100<10 || $n%100>20} {
	set suff [lindex {th st nd rd th th th th th th} [expr {$n % 10}]]
    } else {
	set suff th
    }
    return "$n'$suff"
}

foreach start {0 250 1000} {
    for {set n $start; set l {}} {$n<=$start+25} {incr n} {
	lappend l [ordinal $n]
    }
    puts $l
}


SUB sufijo (n)
    LET n = INT(n)
    LET NMod10 = MOD(n, 10)
    LET NMod100 = MOD(n, 100)
    IF (NMod10 = 1) AND (NMod100 <> 11) THEN
       LET sufi$ = "st"
    ELSE
       IF (NMod10 = 2) AND (NMod100 <> 12) THEN
          LET sufi$ = "nd"
       ELSE
          IF (NMod10 = 3) AND (NMod100 <> 13) THEN
             LET sufi$ = "rd"
          ELSE
             LET sufi$ = "th"
          END IF
       END IF
    END IF
    PRINT sufi$;
END SUB

SUB imprimeOrdinal (loLim, hiLim)
    LET loLim = INT(loLim)
    LET hiLim = INT(hiLim)
    FOR i = loLim TO hiLim
        PRINT i;
        CALL sufijo (i)
        PRINT " ";
    NEXT i
    PRINT
END SUB

CALL imprimeOrdinal (0, 25)
CALL imprimeOrdinal (250, 265)
CALL imprimeOrdinal (1000, 1025)
END


// N'th
function suffix(n: number): string {
  var nMod10: number = n % 10;
  var nMod100: number = n % 100;
  if (nMod10 == 1 && nMod100 != 11)
    return "st";
  else if (nMod10 == 2 && nMod100 != 12)
    return "nd";
  else if (nMod10 == 3 && nMod100 != 13)
    return "rd";
  else
    return "th";
}

function printImages(loLim: number, hiLim: number) {
  for (i = loLim; i <= hiLim; i++)
    process.stdout.write(`${i}` + suffix(i) + " ");
  process.stdout.write("\n");
}

printImages(   0,   25);
printImages( 250,  265);
printImages(1000, 1025);


For x = 0 to 25                        ' Test range 0..25
  Push x : GoSub _PrintOrdinal
Next x  : Print

For x = 250 to 265                     ' Test range 250..265
  Push x : GoSub _PrintOrdinal
Next x : Print

For x = 1000 to 1025                   ' Test range 1000..1025
  Push x : GoSub _PrintOrdinal
Next x : Print

End                                    ' End test program
                                       ' ( n --)
_PrintOrdinal                          ' Ordinal subroutine
  If Tos() > -1 Then                   ' If within range then
    Print Using "____#";Tos();"'";     ' Print the number
                                       ' Take care of 11, 12 and 13
    If (Tos()%100 > 10) * (Tos()%100 < 14) Then
       Gosub (Pop() * 0) + 100         ' Clear stack and print "th"
       Return                          ' We're done here
    EndIf

    Push Pop() % 10                    ' Calculate n mod 10
    GoSub 100 + 10 * ((Tos()>0) + (Tos()>1) + (Tos()>2) - (3 * (Pop()>3)))
  Else                                 ' And decide which ordinal to use
    Print Pop();" is less than zero"   ' Otherwise, it is an error
  EndIf

Return
                                       ' Select and print proper ordinal
100 Print "th"; : Return
110 Print "st"; : Return
120 Print "nd"; : Return
130 Print "rd"; : Return


Private Function ordinals() As Variant
    ordinals = [{"th","st","nd","rd"}]
End Function

Private Function Nth(n As Variant, Optional apostrophe As Boolean = False) As String
    Dim mod10 As Integer: mod10 = n Mod 10 + 1
    If mod10 > 4 Or n Mod 100 = mod10 + 9 Then mod10 = 1
    Nth = CStr(n) & String$(Val(-apostrophe), "'") & ordinals()(mod10)
End Function

Public Sub main()
    Ranges = [{0,25;250,265;1000,1025}]
    For i = 1 To UBound(Ranges)
        For j = Ranges(i, 1) To Ranges(i, 2)
            If j Mod 10 = 0 Then Debug.Print
            Debug.Print Format(Nth(j, i = 2), "@@@@@@@");
        Next j
        Debug.Print
    Next i
End Sub


import "/fmt" for Conv

var ranges = [ 0..25, 250..265, 1000..1025 ]
for (r in ranges) {
    r.each { |i| System.write("%(Conv.ord(i))  ") }
    System.print("\n")
}


PROGRAM "nth"
VERSION "0.0002"

DECLARE FUNCTION  Entry()
INTERNAL FUNCTION Suffix$(n&&)
INTERNAL FUNCTION PrintImages (loLim&&, hiLim&&)

FUNCTION Entry()
  PrintImages(   0,   25)
  PrintImages( 250,  265)
  PrintImages(1000, 1025)
END FUNCTION

FUNCTION Suffix$(n&&)
  nMod10@@ = n&& MOD 10
  nMod100@@ = n&& MOD 100
  SELECT CASE TRUE
    CASE (nMod10@@ = 1) AND (nMod100@@ <> 11):
      RETURN ("st")
    CASE (nMod10@@ = 2) AND (nMod100@@ <> 12):
      RETURN ("nd")
    CASE (nMod10@@ = 3) AND (nMod100@@ <> 13):
      RETURN ("rd")
    CASE ELSE:
      RETURN ("th")
  END SELECT
END FUNCTION

FUNCTION PrintImages(loLim&&, hiLim&&)
  FOR i&& = loLim&& TO hiLim&&
    PRINT TRIM$(STRING$(i&&)); Suffix$(i&&); " ";
  NEXT
  PRINT
END FUNCTION
END PROGRAM


(DEFUN NTH (N)
    (COND
        ((AND (> (MOD N 100) 3) (< (MOD N 100) 21)) `(,N TH))
        ((= (MOD N 10) 1) `(,N ST))
        ((= (MOD N 10) 2) `(,N ND))
        ((= (MOD N 10) 3) `(,N RD))
        (T `(,N TH))))

(DEFUN RANGE (X Y)
    (IF (<= X Y)
        (CONS X (RANGE (+ X 1) Y))))

(DEFUN TEST-NTH ()
    (DISPLAY (MAPCAR NTH (RANGE 1 25)))
    (NEWLINE)
    (DISPLAY (MAPCAR NTH (RANGE 250 265)))
    (NEWLINE)
    (DISPLAY (MAPCAR NTH (RANGE 1000 1025))))

(TEST-NTH)


\N'th
code Rem=2, CrLf=9, IntIn=10, IntOut=11, Text=12;

  procedure Suf(N, S);
  integer N;
  character S;
  integer NMod10, NMod100;
  begin
  NMod10:= Rem(N/10);
  NMod100:= Rem(N/100);
  case of
    NMod10 = 1 & NMod100 # 11: S(0):= "st";
    NMod10 = 2 & NMod100 # 12: S(0):= "nd";
    NMod10 = 3 & NMod100 # 13: S(0):= "rd"
  other
    S(0):= "th";
  end;

  procedure PrintImages(LoLim, HiLim);
  integer LoLim, HiLim;
  integer I;
  character S;
  begin
  for I:= LoLim, HiLim do
    begin
    Suf(I, addr S);
    IntOut(0, I); Text(0, S); Text(0, " ")
    end;
  CrLf(0)
  end;

begin
PrintImages(0, 25);
PrintImages(250, 265);
PrintImages(1000, 1025)
end


sub ordinal$ (n)
    NMod10 = mod(n, 10)
    NMod100 = mod(n, 100)
    if (NMod10 = 1) and (NMod100 <> 11) then
       return "st"
    else
       if (NMod10 = 2) and (NMod100 <> 12) then
          return "nd"
       else
          if (NMod10 = 3) and (NMod100 <> 13) then
             return "rd"
          else
             return "th"
          end if
       end if
    end if
end sub

sub imprimeOrdinal(a, b)
    for i = a to b
        print i, ordinal$(i), " ";
    next i
    print
end sub

imprimeOrdinal (0, 25)
imprimeOrdinal (250, 265)
imprimeOrdinal (1000, 1025)
end


#if 0
fcn addSuffix(n){
   z:=n.abs()%100;
   if(11<=z<=13) return(String(n,"th"));
   z=z%10;
   String(n,(z==1 and "st") or (z==2 and "nd") or (z==3 and "rd") or "th");
}
#else
fcn addSuffix(n){
   var suffixes=T("th","st","nd","rd","th","th","th","th","th","th"); //0..10
   z:=n.abs()%100;
   String(n,(z<=10 or z>20) and suffixes[z%10] or "th");
}
#endif


 10 FOR n=0 TO 25
 20 GO SUB 140
 30 PRINT n$;" ";
 40 NEXT n
 50 FOR n=250 TO 265
 60 GO SUB 140
 70 PRINT n$;" ";
 80 NEXT n
 90 FOR n=1000 TO 1025
100 GO SUB 140
110 PRINT n$;" ";
120 NEXT n
130 STOP
140 LET s$="th"
150 LET n$=STR$ n
160 IF LEN n$=1 THEN GO TO 180
170 IF n$(LEN n$-1)="1" THEN GO TO 210
180 IF n$(LEN n$)="1" THEN LET s$="st"
190 IF n$(LEN n$)="2" THEN LET s$="nd"
200 IF n$(LEN n$)="3" THEN LET s$="rd"
210 LET n$=n$+s$
220 RETURN


PROC PutBigPixel(BYTE x,y,c)
  BYTE i

  Color=c
  x=x*3+16
  y=y*12
  FOR i=0 TO 11
  DO
    Plot(x,y+i)
    DrawTo(x+2,y+i)
  OD
RETURN

PROC Main()
  BYTE
    CH=$02FC, ;Internal hardware value for last key pressed
    x,y

  Graphics(9)

  FOR y=0 TO 15
  DO
    FOR x=0 TO 15
    DO
      PutBigPixel(x,y,x!y)
    OD
  OD

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


with Cairo; use Cairo;
with Cairo.Png; use Cairo.Png;
with Cairo.Image_Surface; use Cairo.Image_Surface;
procedure XorPattern is
   type xorable is mod 256;
   Surface : Cairo_Surface;
   Data : RGB24_Array_Access;
   Status : Cairo_Status;
   Num : Byte;
begin
   Data := new RGB24_Array(0..256*256-1);
   for x in Natural range 0..255 loop
      for y in Natural range 0..255 loop
         Num := Byte(xorable(x) xor xorable(y));
         Data(x+256*y) := RGB24_Data'(Num,0,Num);
      end loop;
   end loop;
   Surface := Create_For_Data_RGB24(Data, 256, 256);
   Status := Write_To_Png (Surface, "AdaXorPattern.png");
   pragma Assert (Status = Cairo_Status_Success);
end XorPattern;


BEGIN {
    # square size
    s = 256
    # the PPM image header needs 3 lines:
    # P3
    # width height
    # max colors number (per channel)
    print("P3\n", s, s, "\n", s - 1)
    # and now we generate pixels as a RGB pair in a relaxed
    # form "R G B\n"
    for (x = 0; x < s; x++) {
        for (y = 0; y < s; y++) {
            p = xor(x, y)
            print(0, p, p)
        }
    }
}


      size% = 256

      VDU 23,22,size%;size%;8,8,16,0
      OFF

      DIM coltab%(size%-1)
      FOR I% = 0 TO size%-1
        coltab%(I%) = ((I% AND &FF) * &010101) EOR &FF0000
      NEXT

      GCOL 1
      FOR I% = 0 TO size%-1
        FOR J% = 0 TO size%-1
          C% = coltab%(I% EOR J%)
          COLOUR 1, C%, C%>>8, C%>>16
          PLOT I%*2, J%*2
        NEXT
      NEXT I%

      REPEAT WAIT 1 : UNTIL FALSE


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

void hue_to_rgb(double hue, double sat, unsigned char *p)
{
	double x;
	int c = 255 * sat;
	hue /= 60;
	x = (1 - fabs(fmod(hue, 2) - 1)) * 255;

	switch((int)hue) {
	case 0:	p[0] = c; p[1] = x; p[2] = 0; return;
	case 1:	p[0] = x; p[1] = c; p[2] = 0; return;
	case 2:	p[0] = 0; p[1] = c; p[2] = x; return;
	case 3:	p[0] = 0; p[1] = x; p[2] = c; return;
	case 4:	p[0] = x; p[1] = 0; p[2] = c; return;
	case 5:	p[0] = c; p[1] = 0; p[2] = x; return;
	}
}

int main(void)
{
	const int size = 512;
	int i, j;
	unsigned char *colors = malloc(size * 3);
	unsigned char *pix = malloc(size * size * 3), *p;
	FILE *fp;

	for (i = 0; i < size; i++)
		hue_to_rgb(i * 240. / size, i * 1. / size, colors + 3 * i);

	for (i = 0, p = pix; i < size; i++)
		for (j = 0; j < size; j++, p += 3)
			memcpy(p, colors + (i ^ j) * 3, 3);

	fp = fopen("xor.ppm", "wb");
	fprintf(fp, "P6\n%d %d\n255\n", size, size);
	fwrite(pix, size * size * 3, 1, fp);
	fclose(fp);

	return 0;
}


using System.Drawing;
using System.Drawing.Imaging;
using System.Linq;

class XORPattern
{
    static void Main()
    {
        var size = 0x100;
        var black = Color.Black.ToArgb();
        var palette = Enumerable.Range(black, size).Select(Color.FromArgb).ToArray();
        using (var image = new Bitmap(size, size))
        {
            for (var x = 0; x < size; x++)
            {
                for (var y = 0; y < size; y++)
                {
                    image.SetPixel(x, y, palette[x ^ y]);
                }
            }
            image.Save("XORPatternCSharp.png", ImageFormat.Png);
        }
    }
}


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

//--------------------------------------------------------------------------------------------------
using namespace std;

//--------------------------------------------------------------------------------------------------
const int BMP_SIZE = 512;

//--------------------------------------------------------------------------------------------------
class myBitmap
{
public:
    myBitmap() : pen( NULL ), brush( NULL ), clr( 0 ), wid( 1 ) {}
    ~myBitmap()
    {
	DeleteObject( pen );
	DeleteObject( brush );
	DeleteDC( hdc );
	DeleteObject( bmp );
    }

    bool create( int w, int h )
    {
	BITMAPINFO    bi;
	ZeroMemory( &bi, sizeof( bi ) );
	bi.bmiHeader.biSize        = sizeof( bi.bmiHeader );
	bi.bmiHeader.biBitCount    = sizeof( DWORD ) * 8;
	bi.bmiHeader.biCompression = BI_RGB;
	bi.bmiHeader.biPlanes      = 1;
	bi.bmiHeader.biWidth       =  w;
	bi.bmiHeader.biHeight      = -h;

	HDC dc = GetDC( GetConsoleWindow() );
	bmp = CreateDIBSection( dc, &bi, DIB_RGB_COLORS, &pBits, NULL, 0 );
	if( !bmp ) return false;

	hdc = CreateCompatibleDC( dc );
	SelectObject( hdc, bmp );
	ReleaseDC( GetConsoleWindow(), dc );

	width = w; height = h;
	return true;
    }

    void clear( BYTE clr = 0 )
    {
	memset( pBits, clr, width * height * sizeof( DWORD ) );
    }

    void setBrushColor( DWORD bClr )
    {
	if( brush ) DeleteObject( brush );
	brush = CreateSolidBrush( bClr );
	SelectObject( hdc, brush );
    }

    void setPenColor( DWORD c ) { clr = c; createPen(); }

    void setPenWidth( int w )   { wid = w; createPen(); }

    void saveBitmap( string path )
    {
	BITMAPFILEHEADER fileheader;
	BITMAPINFO       infoheader;
	BITMAP           bitmap;
	DWORD            wb;

	GetObject( bmp, sizeof( bitmap ), &bitmap );
	DWORD* dwpBits = new DWORD[bitmap.bmWidth * bitmap.bmHeight];

	ZeroMemory( dwpBits, bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD ) );
	ZeroMemory( &infoheader, sizeof( BITMAPINFO ) );
	ZeroMemory( &fileheader, sizeof( BITMAPFILEHEADER ) );

	infoheader.bmiHeader.biBitCount = sizeof( DWORD ) * 8;
	infoheader.bmiHeader.biCompression = BI_RGB;
	infoheader.bmiHeader.biPlanes = 1;
	infoheader.bmiHeader.biSize = sizeof( infoheader.bmiHeader );
	infoheader.bmiHeader.biHeight = bitmap.bmHeight;
	infoheader.bmiHeader.biWidth = bitmap.bmWidth;
	infoheader.bmiHeader.biSizeImage = bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD );

	fileheader.bfType    = 0x4D42;
	fileheader.bfOffBits = sizeof( infoheader.bmiHeader ) + sizeof( BITMAPFILEHEADER );
	fileheader.bfSize    = fileheader.bfOffBits + infoheader.bmiHeader.biSizeImage;

	GetDIBits( hdc, bmp, 0, height, ( LPVOID )dwpBits, &infoheader, DIB_RGB_COLORS );

	HANDLE file = CreateFile( path.c_str(), GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL );
	WriteFile( file, &fileheader, sizeof( BITMAPFILEHEADER ), &wb, NULL );
	WriteFile( file, &infoheader.bmiHeader, sizeof( infoheader.bmiHeader ), &wb, NULL );
	WriteFile( file, dwpBits, bitmap.bmWidth * bitmap.bmHeight * 4, &wb, NULL );
	CloseHandle( file );

	delete [] dwpBits;
    }

    HDC getDC() const     { return hdc; }
    int getWidth() const  { return width; }
    int getHeight() const { return height; }

private:
    void createPen()
    {
	if( pen ) DeleteObject( pen );
	pen = CreatePen( PS_SOLID, wid, clr );
	SelectObject( hdc, pen );
    }

    HBITMAP bmp;
    HDC     hdc;
    HPEN    pen;
    HBRUSH  brush;
    void    *pBits;
    int     width, height, wid;
    DWORD   clr;
};
//--------------------------------------------------------------------------------------------------
class mSquares
{
public:
    mSquares()
    {
        bmp.create( BMP_SIZE, BMP_SIZE );
        createPallete();
    }

    void draw()
    {
	HDC dc = bmp.getDC();
	for( int y = 0; y < BMP_SIZE; y++ )
	    for( int x = 0; x < BMP_SIZE; x++ )
	    {
		int c = ( x ^ y ) % 256;
		SetPixel( dc, x, y, clrs[c] );
	    }

	BitBlt( GetDC( GetConsoleWindow() ), 30, 30, BMP_SIZE, BMP_SIZE, dc, 0, 0, SRCCOPY );
	//bmp.saveBitmap( "f:\\rc\\msquares_cpp.bmp" );
    }

private:
    void createPallete()
    {
	for( int x = 0; x < 256; x++ )
	clrs[x] = RGB( x<<1, x, x<<2 );//rand() % 180 + 50, rand() % 200 + 50, rand() % 180 + 50 );
    }

    unsigned int clrs[256];
    myBitmap bmp;
};
//--------------------------------------------------------------------------------------------------
int main( int argc, char* argv[] )
{
    ShowWindow( GetConsoleWindow(), SW_MAXIMIZE );
    srand( GetTickCount() );
    mSquares s; s.draw();
    return system( "pause" );
}
//--------------------------------------------------------------------------------------------------


void main() {
    import std.stdio;

    enum width = 512, height = 512;

    auto f = File("xor_pattern.ppm", "wb");
    f.writefln("P6\n%d %d\n255", width, height);
    foreach (immutable y; 0 .. height)
        foreach (immutable x; 0 .. width) {
            immutable c = (x ^ y) & ubyte.max;
            immutable ubyte[3] u3 = [255 - c, c / 2, c];
            f.rawWrite(u3);
        }
}


(lib 'types)
(lib 'plot)
(plot-size 512 512) ;; for example

;; use m = 16, 32, 44, .. to change the definition (number of losanges)
(define (plot-munch (m 256))
	(define PIX (pixels->int32-vector)) ;; get canvas image
	(define (pcolor x y) ;; color at (x,y)
		(hsv->rgb
			(// (bitwise-xor (modulo x m) (modulo y m)) m)
			0.9
			0.9))
	(pixels-map pcolor PIX)
	(vector->pixels PIX)) ;; draw canvas image

(plot-much) ;; ESC to see tge drawing


USING: accessors images images.loader kernel math sequences ;
IN: rosetta-code.munching-squares

: img-data ( -- seq ) 256 sq [ B{ 0 0 0 255 } ] replicate ;

: (munching) ( elt index -- elt' )
    256 /mod bitxor [ rest ] dip prefix ;

: munching ( -- seq )
    img-data [ (munching) ] map-index B{ } concat-as ;

: <munching-img> ( -- img )
    <image>
    { 256 256 }      >>dim
    BGRA             >>component-order
    ubyte-components >>component-type
    munching         >>bitmap ;

: main ( -- ) <munching-img> "munching.png" save-graphic-image ;

MAIN: main


' version 03-11-2016
' compile with: fbc -s gui

Dim As ULong x, y, r, w = 256

ScreenRes w, w, 32

For x = 0 To w -1
    For y = 0 To w -1
        r =(x Xor y) And 255
        PSet(x, y), RGB(r, r , r)         ' gray scale
        ' PSet(x, y), RGB(r, 255 - r, 0)  ' red + green
        ' PSet(x, y), RGB(r, 0, 0)        ' red
    Next
Next

' empty keyboard buffer
While Inkey <> "" : Wend
WindowTitle "Close window or hit any key to end program"
Sleep
End


vec3 color;
float c,p;
vec2 b;

void main(void)
{
	vec2 uv = gl_FragCoord.xy / iResolution.xy;
	float scale = iResolution.x / iResolution.y;
	uv = uv-0.5;
	uv.y/=scale;

	b    = uv*256.0+256.0;
	c = 0.0;

	for(float i=16.0;i>=1.0;i-=1.0)
	{
		p = pow(2.0,i);

		if((p < b.x) ^^
		   (p < b.y))
		{
			c += p;
		}

		if(p < b.x)
		{
			b.x -= p;
		}

		if(p < b.y)
		{
			b.y -= p;
		}

	}

	c=mod(c/128.0,1.0);

	color = vec3(sin(c+uv.x*cos(uv.y*1.2)), tan(c+uv.y-0.3)*1.1, cos(c-uv.y+0.9));

	gl_FragColor = vec4(color,1.0);
}


set pm3d map
set size square
set isosamples 255,255
splot [0:255][0:255]-(floor(x)^floor(y))


package main

import (
    "image"
    "image/png"
    "os"
)

func main() {
    g := image.NewGray(image.Rect(0, 0, 256, 256))
    for i := range g.Pix {
        g.Pix[i] = uint8(i>>8 ^ i)
    }
    f, _ := os.Create("xor.png")
    png.Encode(f, g)
    f.Close()
}


import qualified Data.ByteString as BY (writeFile, pack)

import Data.Bits (xor)

main :: IO ()
main =
  BY.writeFile
    "out.pgm"
    (BY.pack
       (fmap (fromIntegral . fromEnum) "P5\n256 256\n256\n" ++
        [ x `xor` y
        | x <- [0 .. 255]
        , y <- [0 .. 255] ]))


link printf

procedure main(A)   #: XOR graphic
   wsize := 512
   cmax  := 32768
   wparms := ["Xmas Xor Graphic","g",sprintf("size=%d,%d",wsize),"bg=black"]
   &window := open!wparms | stop("Unable to open window")

   every y := 0 to wsize - 1 do
      every x := 0 to wsize - 1 do {
         c := cmax/wsize * iand(wsize-1,ixor(x,y))
         Fg(sprintf("%d,%d,%d",c,cmax-c,0))
         DrawPoint(x,y)
         }

  until Event() == &lpress     # wait for left button to quit
  close(&window)
end


   require 'viewmat'
   viewmat ~:"1/&.#: ~ i.256


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

import javax.swing.JFrame;
import javax.swing.JPanel;

public class XorPattern extends JFrame{
    private JPanel xorPanel;

    public XorPattern(){
        xorPanel = new JPanel(){
            @Override
            public void paint(Graphics g) {
                for(int y = 0; y < getHeight();y++){
                    for(int x = 0; x < getWidth();x++){
                        g.setColor(new Color(0, (x ^ y) % 256, 0));
                        g.drawLine(x, y, x, y);
                    }
                }
            }
        };
        add(xorPanel);
        setSize(300, 300);
        setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
        setVisible(true);
    }

    public static void main(String[] args){
        new XorPattern();
    }
}


jq -n -r -f Munching_squares.jq > Munching_squares.svg


using Gtk, Cairo

const can = @GtkCanvas()
const win = GtkWindow(can, "Munching Squares", 512, 512)

@guarded draw(can) do widget
    ctx = getgc(can)
    for x in 0:255, y in 0:255
        set_source_rgb(ctx, abs(255 - x - y) / 255, ((255 - x) ⊻ y) / 255, (x ⊻ (255 - y)) / 255)
        circle(ctx, 2x, 2y, 2)
        fill(ctx)
    end
end

show(can)
const cond = Condition()
endit(w) = notify(cond)
signal_connect(endit, win, :destroy)
wait(cond)


// version 1.1.4-3

import javax.swing.JFrame
import javax.swing.JPanel
import java.awt.Graphics
import java.awt.Graphics2D
import java.awt.Color
import java.awt.Dimension
import java.awt.BorderLayout
import java.awt.RenderingHints
import javax.swing.SwingUtilities

class XorPattern : JPanel() {

    init {
        preferredSize = Dimension(256, 256)
        background = Color.white
    }

    override fun paint(gg: Graphics) {
        super.paintComponent(gg)
        val g = gg as Graphics2D
        g.setRenderingHint(RenderingHints.KEY_ANTIALIASING,
                           RenderingHints.VALUE_ANTIALIAS_ON)
        for (y in 0 until width) {
            for (x in 0 until height) {
                g.color = Color(0, (x xor y) % 256, 255)
                g.drawLine(x, y, x, y)
            }
        }
    }
}

fun main(args: Array<String>) {
    SwingUtilities.invokeLater {
        val f = JFrame()
        with (f) {
            defaultCloseOperation = JFrame.EXIT_ON_CLOSE
            title = "Munching squares"
            isResizable = false
            add(XorPattern(), BorderLayout.CENTER)
            pack()
            setLocationRelativeTo(null)
            isVisible = true
        }
    }
}


    nomainwin

    w =512
    '   allow for title bar and window border
    WindowWidth  =w +2
    WindowHeight =w +34

    open "XOR Pattern" for graphics_nsb_nf as #w

    #w "trapclose quit"

    #w "down"

    for x =0 to w -1
        for y =0 to w -1
            b =( x xor y) and 255
            print b
            #w "color "; 255 -b; " "; b /2; " "; b
            #w "set "; x; " "; w -y -1
            scan
        next y
    next x

    #w "flush"

    wait

    sub quit j$
    close #w
    end
    end sub


local clr =  {}
function drawMSquares()
	local points = {}
	for y = 0, hei-1 do
		for x = 0, wid-1 do
			local idx = bit.bxor(x, y)%256
			local r, g, b = clr[idx][1], clr[idx][2], clr[idx][3]
			local point = {x+1, y+1, r/255, g/255, b/255, 1}
			table.insert (points, point)
		end
	end
	love.graphics.points(points)
end

function createPalette()
	for i = 0, 255 do
		clr[i] = {i*2.8%256, i*3.2%256, i*1.5%256}
	end
end

function love.load()
	wid, hei = 256, 256
	love.window.setMode(wid, hei)
	canvas = love.graphics.newCanvas()
	love.graphics.setCanvas(canvas)
		createPalette()
		drawMSquares()
	love.graphics.setCanvas()
end

function love.draw()
	love.graphics.setColor(1,1,1)
	love.graphics.draw(canvas)
end


ListDensityPlot[
 Table[Table[
   FromDigits[BitXor[IntegerDigits[x, 2, 8], IntegerDigits[y, 2, 8]],
    2], {x, 0, 255}], {y, 0, 255}]]


size = 256;
[x,y] = meshgrid([0:size-1]);

c = bitxor(x,y);

colormap bone(size);
image(c);
axis equal;


' Munching squares - smallbasic  - 27/07/2018
  size=256
  GraphicsWindow.Width=size
  GraphicsWindow.Height=size
  For i=0 To size-1
    For j=0 To size-1
      BitXor() 'color=i Xor j
      GraphicsWindow.SetPixel(i,j,GraphicsWindow.GetColorFromRGB(0,color,color))
    EndFor
  EndFor

Sub BitXor '(i,j)->color
  n=i
  Int2Bit()
  ib=ret
  n=j
  Int2Bit()
  jb=ret
  color=0
  For k=1 to 8
    ki=Text.GetSubText(ib,k,1)
    kj=Text.GetSubText(jb,k,1)
    If ki="1" Or kj="1" Then
      kk="1"
    Else
      kk="0"
    EndIf
    If ki="1" And kj="1" Then
      kk="0"
    EndIf
    color=2*color+kk
  EndFor
EndSub

Sub Int2Bit 'n->ret
  x=n
  ret=""
  For k=1 to 8
    t=Math.Floor(x/2)
    r=Math.Remainder(x,2)
    ret=Text.Append(r,ret)
    x=t
  EndFor
EndSub


xor = function(a, b)
	result = 0
	bit = 1
	while a > 0 or b > 0
		if (a%2 == 0) != (b%2 == 0) then result = result + bit
		bit = bit * 2
		a = floor(a/2)
		b = floor(b/2)
	end while
	return result
end function

for x in range(0,255)
	for y in range(0,255)
		gfx.setPixel x, y, color.rgb(0, xor(x,y), 0)
	end for
end for


import random
import imageman

randomize()

# Build a color table.
var colors: array[256, ColorRGBU]
for color in colors.mitems:
  color = ColorRGBU [byte rand(255), byte rand(255), byte rand(255)]

var image = initImage[ColorRGBU](256, 256)

for i in 0..255:
  for j in 0..255:
    image[i, j] = colors[i xor j]

image.savePNG("munching_squares.png")


open Graphics

let () =
  open_graph "";
  resize_window 256 256;
  for y = 0 to pred (size_y()) do
    for x = 0 to pred (size_x()) do
      let v = (x lxor y) land 0xFF in
      set_color (rgb v (255 - v) 0);
      plot x y
    done;
  done;
  ignore(read_key())


size = 256;
[x,y] = meshgrid([0:size-1]);

c = bitxor(x,y);

colormap(jet(size));
image(c);
axis equal;


use GD;

my $img = new GD::Image(256, 256, 1);

for my $y(0..255) {
        for my $x(0..255) {
                my $color = $img->colorAllocate( abs(255 - $x - $y),  (255-$x) ^ $y , $x ^ (255-$y));
                $img->setPixel($x, $y, $color);
        }
}

print $img->png


--
-- demo\rosetta\Munching_squares.exw
-- =================================
--
with javascript_semantics
include pGUI.e

Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, /*posy*/)
integer {width, height} = IupGetIntInt(canvas, "DRAWSIZE")
    cdCanvasActivate(cddbuffer)
    for y=0 to height-1 do
        for x=0 to width-1 do
            cdCanvasPixel(cddbuffer, x, y, xor_bits(x,y))
        end for
    end for
    cdCanvasFlush(cddbuffer)
    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    cdCanvasSetBackground(cddbuffer, CD_WHITE)
    cdCanvasSetForeground(cddbuffer, CD_RED)
    return IUP_DEFAULT
end function

procedure main()
    IupOpen()
    canvas = IupCanvas("RASTERSIZE=250x250")
    IupSetCallbacks(canvas, {"MAP_CB", Icallback("map_cb"),
                             "ACTION", Icallback("redraw_cb")})
    dlg = IupDialog(canvas, `TITLE="Munching squares",RESIZE=NO`)
    IupShow(dlg)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


header("Content-Type: image/png");

$w = 256;
$h = 256;

$im = imagecreate($w, $h)
    or die("Cannot Initialize new GD image stream");

$color = array();
for($i=0;$i<256;$i++)
{
        array_push($color,imagecolorallocate($im,sin(($i)*(2*3.14/256))*128+128,$i/2,$i));
}

for($i=0;$i<$w;$i++)
{
        for($j=0;$j<$h;$j++)
        {
                imagesetpixel($im,$i,$j,$color[$i^$j]);
        }
}

imagepng($im);
imagedestroy($im);


munch: procedure options (main); /* 21 May 2014 */

   declare screen (0:255, 0:255) bit(24) aligned;
   declare b bit(8) aligned;
   declare (x, y) unsigned fixed binary (8);

   do x = 0 upthru hbound(screen,2);
      do y = 0 upthru hbound(screen,1);
         b = unspec(x) ^ unspec(y);
         screen(x,y) = b;
      end;
   end;
   call writeppm(screen);
end munch;


//Aamrun, 26th June 2022

size(1200,720);

loadPixels();

for(int i=0;i<height;i++){
  for(int j=0;j<width;j++){
    pixels[j + i*width] = color(i^j);
  }
}

updatePixels();


xor_pattern :-
	new(D, window('XOR Pattern')),
	send(D, size, size(512,512)),
	new(Img, image(@nil, width := 512, height := 512 , kind := pixmap)),

	forall(between(0,511, I),
	       (   forall(between(0,511, J),
			  (   V is I xor J,
			      R is (V * 1024) mod 65536,
			      G is (65536 - V * 1024) mod 65536,
			      (	  V mod 2 =:= 0
			      ->  B is  (V * 4096) mod 65536
			      ;	   B is  (65536 - (V * 4096)) mod 65536),
			      send(Img, pixel(I, J, colour(@default, R, G, B))))))),

	new(Bmp, bitmap(Img)),
	send(D, display, Bmp, point(0,0)),
	send(D, open).


#palletteSize = 128
Procedure.f XorPattern(x, y) ;compute the gradient value from the pixel values
  Protected result = x ! y
  ProcedureReturn Mod(result, #palletteSize) / #palletteSize
EndProcedure

Procedure drawPattern()
  StartDrawing(ImageOutput(0))
    DrawingMode(#PB_2DDrawing_Gradient)
    CustomGradient(@XorPattern())
    ;specify a gradient pallette from which only specific indexes will be used
    For i = 1 To #palletteSize
      GradientColor(1 / i, i * $BACE9B) ; or alternatively use $BEEFDEAD
    Next
    Box(0, 0, ImageWidth(0), ImageHeight(0))
  StopDrawing()
EndProcedure

If OpenWindow(0, 0, 0, 128, 128, "XOR Pattern", #PB_Window_SystemMenu)
  CreateImage(0, WindowWidth(0), WindowHeight(0))
  drawPattern()
  ImageGadget(0, 0, 0, ImageWidth(0), ImageHeight(0), ImageID(0))
  Repeat
    event = WaitWindowEvent(20)
  Until event = #PB_Event_CloseWindow
EndIf


import Image, ImageDraw

image = Image.new("RGB", (256, 256))
drawingTool = ImageDraw.Draw(image)

for x in range(256):
    for y in range(256):
        drawingTool.point((x, y), (0, x^y, 0))

del drawingTool
image.save("xorpic.png", "PNG")


w = 254

SCREEN 13
VIEW (0, 0)-(w / 2, w / 2), , 0

FOR x = 0 TO w
    FOR y = 0 TO w
        COLOR ((x XOR y) AND 255)
        PSET (x, y)
    NEXT y
NEXT x


#lang racket
(require racket/draw)
(define palette (for/vector ([x 256]) (make-object color% 0 0 x)))
(define bm (make-object bitmap% 256 256))
(define dc (new bitmap-dc% [bitmap bm]))
(for* ([x 256] [y 256])
  (define c (vector-ref palette (bitwise-xor x y)))
  (send dc set-pixel x y c))
bm


my $ppm = open("munching0.ppm", :w) orelse .die;

$ppm.print(q :to 'EOT');
P3
256 256
255
EOT

for 0 .. 255 -> $row {
    for 0 .. 255 -> $col {
        my $color = $row +^ $col;
        $ppm.print("0 $color 0 ");
    }
    $ppm.say();
}

$ppm.close();