sub esplit$(instring$)
	if len(instring$) < 2 return instring$
    ret$ = left$(instring$,1)
    for i = 2 to len(instring$)
	if mid$(instring$,i,1) <> mid$(instring$, i - 1, 1) ret$ = ret$ + ", "
        ret$ = ret$ + mid$(instring$, i, 1)
    next i
   return ret$
end sub

print esplit$("gHHH5YY++///\\")


PrintChar equ &BB5A ;Amstrad CPC BIOS call
Terminator equ 0    ;marks the end of a string
        org &8000

	LD HL,StringA
loop:
	ld a,(HL)		;load a char from (HL)
	cp Terminator	        ;is it the terminator?
	ret z			;if so, exit
	ld e,a			;store this char in E temporarily
	inc hl			;next char
	ld a,(HL)		;get next char
	cp Terminator	        ;is the next char the terminator?
	jp z,StringDone	        ;if so, print E and exit.

	;needed to prevent the last char from getting a comma and space.

	dec hl			;go back one so we don't skip any chars
	cp e                    ;does (HL) == (HL+1)?

	push af
	ld a,e
	call PrintChar		;either way, print E to screen.
	pop af			;retrieve the results of the last compare.

	jr z,SkipComma		;if A=E, no comma or space. Just loop again.
	ld a,','
	call PrintChar
	ld a,' '
	call PrintChar
SkipComma:
	inc hl			;next char
	jp loop			;back to start
StringDone:
	ld a,e			;last character in string is printed here.
	jp PrintChar

ReturnToBasic:
	RET

StringA:
	byte "gHHH5YY++///\",0


fcn group(str){
   C,out := str[0],Sink(C);
   foreach c in (str[1,*]){ out.write(if(c==C) c else String(", ",C=c)) }
   out.close();
}
group("gHHH5YY++///\\").println();


 10 LET s$="gHHH5YY++///\"
 20 LET c$=s$(1)
 30 LET n$=c$
 40 FOR i=2 TO LEN s$
 50 IF s$(i)<>c$ THEN LET n$=n$+", "
 60 LET n$=n$+s$(i)
 70 LET c$=s$(i)
 80 NEXT i
 90 PRINT n$


L
   L(rod) ‘\|/-’
      print(rod, end' "\r")
      sleep(0.25)


PROC Wait(BYTE frames)
  BYTE RTCLOK=$14
  frames==+RTCLOK
  WHILE frames#RTCLOK DO OD
RETURN

PROC Main()
  CHAR ARRAY spin="|/-\"
  BYTE i,
    CH=$02FC, ;Internal hardware value for last key pressed
    CRSINH=$02F0 ;Controls visibility of cursor

  Print("Press any key to exit...")
  CRSINH=1 ;hide cursor
  i=1
  WHILE CH=$FF
  DO
    Put(spin(i))
    Put(30) ;move cursor left
    i==+1
    IF i>spin(0) THEN
      i=1
    FI
    Wait(5)
  OD
  CH=$FF
  CRSINH=0 ;show cursor
RETURN


with Ada.Text_IO;

procedure Spinning_Rod is
   use Ada.Text_IO;

   type Index_Type is mod 4;
   Rod   : constant array (Index_Type) of Character := ('|', '/', '-', '\');
   Index : Index_Type := 0;
   Char  : Character;
   Avail : Boolean;
begin
   Put (ASCII.ESC & "[?25l");           -- Hide the cursor
   loop
      Put (ASCII.ESC & "[2J");          -- Clear Terminal
      Put (ASCII.ESC & "[0;0H");        -- Place Cursor at Top Left Corner
      Get_Immediate (Char, Avail);
      exit when Avail;
      Put (Rod (Index));
      Index := Index_Type'Succ (Index);
      delay 0.250;
   end loop;
   Put (ASCII.ESC & "[?25h");           -- Restore the cursor
end Spinning_Rod;


FOR i TO 1 000 DO # increase/decrease the TO value for a longer/shorter animation #
    FOR d TO 2 000 000 DO SKIP OD; # adjust to change the spin rate #
    print( ( CASE 1 + i MOD 4 IN "/", "-", "\", "|" ESAC, REPR 8 ) )
OD


# syntax: GAWK -f SPINNING_ROD_ANIMATION_TEXT.AWK
@load "time"
BEGIN {
    while (1) {
      printf(" %s\r",substr("|/-\\",x++%4+1,1))
      sleep(.25)
    }
    exit(0)
}


WHILE TRUE
    PRINT CR$, TOKEN$("🌑 🌒 🌓 🌔 🌕 🌖 🌗 🌘", x);
    x = IIF(x>7, 1, x+1)
    SLEEP 250
WEND


while : ; do
  for rod in \| / - \\ ; do printf '  %s\r' $rod; sleep 0.25; done
done


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

int main() {
    int i, j, ms = 250;
    const char *a = "|/-\\";
    time_t start, now;
    struct timespec delay;
    delay.tv_sec = 0;
    delay.tv_nsec = ms * 1000000L;
    printf("\033[?25l");  // hide the cursor
    time(&start);
    while(1) {
        for (i = 0; i < 4; i++) {
            printf("\033[2J");          // clear terminal
            printf("\033[0;0H");        // place cursor at top left corner
            for (j = 0; j < 80; j++) {  // 80 character terminal width, say
                printf("%c", a[i]);
            }
            fflush(stdout);
            nanosleep(&delay, NULL);
        }
        // stop after 20 seconds, say
        time(&now);
        if (difftime(now, start) >= 20) break;
    }
    printf("\033[?25h"); // restore the cursor
    return 0;
}


while 1
  foreach rod ('|' '/' '-' '\')
    printf '  %s\r' $rod; sleep 0.25
  end
end


SPINROD
  ; spin 10 times with quarter-second wait
  for i = 1:1:10 {
    for j = 1:1:4 {
      set x = $case(j,1:"|",2:"/",3:"-",:"\")

      ; $char(8) backspaces on the terminal
      write $char(8)_x
      hang 0.25
    }
  }
  quit


(while t
  (dolist (char (string-to-list "\\|/-"))
    (message "%c" char)
    (sit-for 0.25)))


USING: calendar combinators.extras formatting io sequences
threads ;

[
    "\\|/-" [ "%c\r" printf flush 1/4 seconds sleep ] each
] forever


: rod
  cr
  begin
            [char] \ emit 250 ms
    13 emit [char] | emit 250 ms
    13 emit [char] - emit 250 ms
    13 emit [char] / emit 250 ms
    13 emit
    key?
  until
;
rod


' version 13-07-2018
' compile with: fbc -s console

Dim As String spinning_rod = "|/-" + Chr(92)
Dim As UInteger c

While InKey <> "" : Wend

While InKey = ""
    Cls
    Print
    Print " hit any key to end program "; Chr(spinning_rod[c And 3])
    c += 1
    Sleep(250)  ' in milliseconds
Wend

End


debug="|"
wait 250 ms
debug="/"
wait 250 ms
debug="-"
wait 250 ms
debug="\"
wait 250 ms


package main

import (
    "fmt"
    "time"
)

func main() {
    a := `|/-\`
    fmt.Printf("\033[?25l")  // hide the cursor
    start := time.Now()
    for {
        for i := 0; i < 4; i++ {
            fmt.Print("\033[2J")       // clear terminal
            fmt.Printf("\033[0;0H")    // place cursor at top left corner
            for j := 0; j < 80; j++ {  // 80 character terminal width, say
                fmt.Printf("%c", a[i])
            }
            time.Sleep(250 * time.Millisecond)
        }
        if time.Since(start).Seconds() >= 20.0 { // stop after 20 seconds, say
            break
        }
    }
    fmt.Print("\033[?25h") // restore the cursor
}


import Control.Concurrent (threadDelay)
import Control.Exception (bracket_)
import Control.Monad (forM_)
import System.Console.Terminfo
import System.IO (hFlush, stdout)

-- Use the terminfo database to write the terminal-specific characters
-- for the given capability.
runCapability :: Terminal -> String -> IO ()
runCapability term cap =
  forM_ (getCapability term (tiGetOutput1 cap)) (runTermOutput term)

-- Control the visibility of the cursor.
cursorOff, cursorOn :: Terminal -> IO ()
cursorOff term = runCapability term "civis"
cursorOn  term = runCapability term "cnorm"

-- Print the spinning cursor.
spin :: IO ()
spin = forM_ (cycle "|/-\\") $ \c ->
  putChar c >> putChar '\r' >>
  hFlush stdout >> threadDelay 250000

main :: IO ()
main = do
  putStrLn "Spinning rod demo.  Hit ^C to stop it.\n"
  term <- setupTermFromEnv
  bracket_ (cursorOff term) (cursorOn term) spin


public class SpinningRod
{
    public static void main(String[] args) throws InterruptedException {
        String a = "|/-\\";
        System.out.print("\033[2J");   // hide the cursor
        long start = System.currentTimeMillis();
        while (true) {
            for (int i = 0; i < 4; i++) {
                System.out.print("\033[2J");     // clear terminal
                System.out.print("\033[0;0H");   // place cursor at top left corner
                for (int j = 0; j < 80; j++) {   // 80 character terminal width, say
                    System.out.print(a.charAt(i));
                }
                Thread.sleep(250);
            }
            long now = System.currentTimeMillis();
            // stop after 20 seconds, say
            if (now - start >= 20000) break;
        }
        System.out.print("\033[?25h"); // restore the cursor
    }
}


const rod = (function rod() {
    const chars = "|/-\\";
    let i=0;
    return function() {
        i= (i+1) % 4;
        // We need to use process.stdout.write since console.log automatically adds a \n to the end of lines
        process.stdout.write(` ${chars[i]}\r`);
    }
})();
setInterval(rod, 250);


while true
  for rod in "\|/-" # this needs to be a string, a char literal cannot be iterated over
    print(rod,'\r')
    sleep(0.25)
  end
end


// Version 1.2.50

const val ESC = "\u001b"

fun main(args: Array<String>) {
    val a = "|/-\\"
    print("$ESC[?25l") // hide the cursor
    val start = System.currentTimeMillis()
    while (true) {
        for (i in 0..3) {
            print("$ESC[2J")       // clear terminal
            print("$ESC[0;0H")     // place cursor at top left corner
            for (j in 0..79) {     // 80 character terminal width, say
                print(a[i])
            }
            Thread.sleep(250)
        }
        val now = System.currentTimeMillis()
        // stop after 20 seconds, say
        if (now - start >= 20000) break
    }
    print("$ESC[?25h") // restore the cursor
}


--
-- Simple String Animation - semi-hard-coded variant - you can alter the chars table - update the count and run it...
--

-- The basic animation runtime controller. This is where you assign the active animation ( you could create a simple function to replace the animation table and nil count, index and expiry to extend this system to allow multiple animations -
--	and since you can replace after a previous has been output, it would appear as though you were running different animations at the same time - that wouldn't be async compatible though )...
-- So you can either activate the animation you want permanently, or create a simple function to update the animation table and reset the control variables... ie: ( function string.SetBasicAnimation( _tab_of_chars ) string.__basic_anim_runtime.anim = _tab_of_chars; string.__basic_anim_runtime.index = nil; string.__basic_anim_runtime.count = nil; string.__basic_anim_runtime.expiry = nil; end )
string.__basic_anim_runtime = {
	-- The animation - can not ping pong... requires full sequence. Resets to first after full sequence. Dots animation.. Requires center segment because of ping / pong
	anim = { '.', '..', '...', '..' };

	-- Pipes animation - This performs a complete rotation, no need to add extra segments.
	-- anim = { '|', '/', '─', '\\' };

	-- Stars - This is reversible so requires the center segments..
	-- anim = { '⁎', '⁑', '⁂', '⁑' };

	-- Clock - This still needs to be ordered...
	-- anim = { '🕛', '🕧', '🕐', '🕜', '🕑', '🕝', '🕒', '🕞', '🕓', '🕟', '🕔', '🕠', '🕕', '🕖', '🕗', '🕘', '🕙', '🕚', '🕡', '🕢', '🕣', '🕤', '🕥', '🕦' };

	-- Arrows - This does a complete circle and doesn't need to reverse
	-- anim = { '⬍', '⬈', '➞', '⬊', '⬍', '⬋', '⬅', '⬉' };

	-- Bird Flying - this is reversible so it requires all.. 1 2 3 4 5 6 5 4 3 2
	-- anim = { '︷', '︵', '︹', '︺', '︶', '︸', '︶', '︺', '︹', '︵' };

	-- Plants - Set as reversible, requires all..
	-- anim = { '☘', '❀', '❁', '❀' };

	-- Eclipse - From Raku Throbber post author
	-- anim = { '🌑', '🌒', '🌓', '🌔', '🌕', '🌖', '🌗', '🌘' };
};

--
-- The basic animator function - accepts a numerical delay and a boolean backwards switch.. It only accepts a single animation from the helper local table above..
--
-- Argument - _delay - <Number> - Accepts a time, in seconds with fraction support, that designates how long a frame should last. Optional. If no number given, it uses the default value of 1 / 8 seconds.
-- Argument - _play_backwards - <Boolean> - Toggles whether or not the animation plays backwards or forwards. Default is forwards. Optional.
--
-- RETURN: <String> - Character( s ) of the current animation frame - if the frame is invalid, it returns an empty string.
-- RETURN: <Boolean> - Has Advanced Frame Controller - set to true if this call resulted in a new frame / index being assigned with new character( s )
--
function string.BasicAnimation( _delay, _play_backwards )
	-- Setup delay - make sure it is a number and Reference our runtime var
	local _delay = ( ( type( _delay ) == 'number' ) and _delay or 1 / 8 ), string.__basic_anim_runtime, os.clock( );

	-- cache our count so we count once per refresh.
	_data.count = ( type( _data.count ) == 'number' ) and _data.count or #_data.anim;

	-- Setup our helpers...
	local _expiry, _index, _chars, _count, _has_advanced_frame = _data.expiry, ( _data.index or ( _play_backwards and _data.count or 1 ) ), _data.anim, _data.count, false;

	-- If expiry has occurred, advance... Expiry can be nil the first call, this is ok because it will just use the first character - or the last if playing backwards.
	if ( _expiry and _expiry < _time ) then
		-- Advance..
		_index, _has_advanced_frame = ( ( _index + ( 1 * ( _play_backwards and -1 or 1 ) ) ) % ( _count + 1 ) ), true;

		-- If 0, add 1 otherwise keep the same.
		_index = _index < 1 and ( _play_backwards and _count or 1 ) or _index;

		-- Update the index
		_data.index = _index;
	end

	-- Update the trackers and output the char. -- Note: This is best done in the loop, but since we are checking the expiry above I decided to integrate it here.
	_data.expiry = ( not _data.expiry or _has_advanced_frame ) and _time + _delay or _data.expiry;

	-- Return the character at the index or nothing.
	return _chars[ _index ] or '', _has_advanced_frame;
end

--
-- Helper / OPTIONAL FUNCTION - Updates the animation and resets the controlling variables
--
-- Argument: _tab - <Table> - This is the table containing the animation characters... ie: { '.', '..', '...', '..' } would be a valid entry. Requires at least 2 entries.
--
function string.SetBasicAnimation( _tab )
	-- Prevent non tables, empty tables, or tables with only 1 entry.
	if not ( type( _tab ) == 'table' and #_tab > 1 ) then return error( 'Can not update basic animation without argument #1 as a table, with at least 2 entries...' ); end

	-- Helper
	local _data = string.__basic_anim_runtime;

	-- Update the animation table and Clear the controllers...
	_data.anim, _data.count, _data.index, _data.expiry = _tab, nil, nil, nil;
end


Module Checkit {
      n$=lambda$ n=1, a$="|/-\" -> {
            =mid$(a$, n, 1)
            n++
            if n>4 then n=1
      }
      \\ 1000 is 1 second
      Every 250 {
      \\ Print Over: erase line before print. No new line append.
      Print Over  n$()
      }
}
CheckIt


chars = "|/\[Dash]\\";
pos = 1;
Dynamic[c]
While[True,
 pos = Mod[pos + 1, StringLength[chars], 1];
 c = StringTake[chars, {pos}];
 Pause[0.25];
 ]


Wait:0.25
Delete:1
Say:/
Wait:0.25
Delete:1
Say:-
Wait:0.25
Delete:1
Say:\
Wait:0.25
Delete:1
Goto:1


a[1]="|"
a[2]="/"
a[3]="-"
a[4]="\"
b=0
While b=0
  For c=1 To 4
    TextWindow.Clear()
    TextWindow.WriteLine(a[c])
    Program.Delay(250)
  EndFor
EndWhile


print "Press control-C to exit..."
while true
    for c in "|/-\"
        text.setCell 0, 0, c
        wait 0.25
    end for
end while


import std/monotimes, times, os

const A = ["|", "/", "—", "\\"]
stdout.write "$\e[?25l"       # Hide the cursor.
let start = getMonoTime()
while true:
  for s in A:
    stdout.write "$\e[2J"     # Clear terminal.
    stdout.write "$\e[0;0H"   # Place cursor at top left corner.
    for _ in 1..40:
      stdout.write s & ' '
    stdout.flushFile
    os.sleep(250)
  let now = getMonoTime()
  if (now - start).inSeconds >= 5:
    break
echo "$\e[?25h"   # Restore the cursor.


$|= 1;

while () {
    for (qw[ | / - \ ]) {
        select undef, undef, undef, 0.25;
        printf "\r ($_)";
    }
}


without js -- (cursor, sleep)
puts(1,"please_wait... ")
cursor(NO_CURSOR)
for i=1 to 10 do    -- (approx 10 seconds)
    for j=1 to 4 do
        printf(1," \b%c\b",`|/-\`[j])
        sleep(0.25)
    end for
end for
puts(1," \ndone") -- clear rod, "done" on next line


(de rod ()
   (until ()
      (for R '(\\ | - /)
         (prin R (wait 250) "\r")(flush) ) ) )
(rod)


from time import sleep
while True:
    for rod in r'\|/-':
        print(rod, end='\r')
        sleep(0.25)


#lang racket
(define (anim)
  (for ([c "\\|/-"])
    (printf "~a\r" c)
    (sleep 0.25))
  (anim))
(anim)


class throbber {
    has @.frames;
    has $.delay is rw = 0;
    has $!index = 0;
    has Bool $.marquee = False;
    method next {
        $!index = ($!index + 1) % +@.frames;
        sleep $.delay if $.delay;
        if $!marquee {
            ("\b" x @.frames) ~ @.frames.rotate($!index).join;
        }
        else {
            "\b" ~ @.frames[$!index];
        }
    }
}

my $rod = throbber.new( :frames(< | / - \ >), :delay(.25) );
print "\e[?25lLong running process...  ";
print $rod.next for ^20;

my $clock = throbber.new( :frames("🕐" .. "🕛") );
print "\r\nSomething else with a delay...   ";
until my $done {
    # do something in a loop;
    sleep 1/12;
    print "\b", $clock.next;
    $done = True if $++ >= 60;
}

my $moon = throbber.new( :frames('🌑🌒🌓🌔🌕🌖🌗🌘'.comb) );
print "\r\nGonna be a long night...   ";
until my $end {
    # do something in a loop;
    sleep 1/8;
    print "\b", $moon.next;
    $end = True if $++ >= 60;
}

my $scroll = throbber.new( :frames('PLEASE STAND BY...      '.comb), :delay(.1), :marquee );
print "\r\nEXPERIENCING TECHNICAL DIFFICULTIES: { $scroll.frames.join }";
print $scroll.next for ^95;

END { print "\e[?25h\n" } # clean up on exit


/*REXX program displays a  "spinning rod"  (AKA:  trobbers  or  progress indicators).   */

if 4=='f4'x  then bs= "16"x                      /*EBCDIC?  Then use this backspace chr.*/
             else bs= "08"x                      /* ASCII?    "   "    "      "      "  */

signal on halt                                   /*jump to   HALT   when user halts pgm.*/
$= '│/─\'                                        /*the throbbing characters for display.*/
                  do j=1                         /*perform  until  halted by the user.  */
                  call charout ,  bs  ||  substr($, 1 + j//length($), 1)
                  call delay .25                 /*delays a quarter of a second.        */
                  if result==1  then leave       /*see if  HALT  was issued during DELAY*/
                  end   /*j*/

halt: say bs  ' '                                /*stick a fork in it,  we're all done. */


load "stdlib.ring"
rod = ["|", "/", "-", "\"]
for n = 1 to len(rod)
     see rod[n] + nl
     sleep(0.25)
     system("cls")
next


def spinning_rod
  begin
    printf("\033[?25l") # Hide cursor
    %w[| / - \\].cycle do |rod|
      print rod
      sleep 0.25
      print "\b"
    end
  ensure
    printf("\033[?25h") # Restore cursor
  end
end

puts "Ctrl-c to stop."
spinning_rod


fn main() {
    let characters = ['|', '/', '-', '\\'];
    let mut current = 0;

    println!("{}[2J", 27 as char); // Clear screen.

    loop {
        println!("{}[;H{}", 27 as char, characters[current]); // Move cursor to 1,1 and output the next character.
        current += 1; // Advance current character.
        if current == 4 {current = 0;} // If we reached the end of the array, start from the beginning.
        std::thread::sleep(std::time::Duration::from_millis(250)); // Sleep 250 ms.
    }
}


object SpinningRod extends App {
  val start = System.currentTimeMillis

  def a = "|/-\\"

  print("\033[2J") // hide the cursor

  while (System.currentTimeMillis - start < 20000) {
    for (i <- 0 until 4) {
      print("\033[2J\033[0;0H") // clear terminal, place cursor at top left corner
      for (j <- 0 until 80) print(a(i)) // 80 character terminal width, say
      Thread.sleep(250)
    }
  }
  print("\033[?25h") // restore the cursor

}


print "|"
delay 0.25
clear
print "/"
delay 0.25
clear
print "-"
delay 0.25
clear
print "\"
delay 0.25


dtxt
|
wait
0.25
ctxt
reset
dtxt
/
wait
0.25
ctxt
reset
dtxt
-
wait
0.25
ctxt
reset
dtxt
\
wait
0.25


let loop=1
sub delay:
for i=1 to 10000
next
cls 1
return
while loop=1
print 1 "l"
gosub delay:
print 1 "/"
gosub delay:
print 1 "-"
gosub delay:
print 1 "\"
gosub delay:
wend
end


import "io" for Stdout
import "timer" for Timer

var ESC = "\u001b"

var a = "|/-\\"
System.write("%(ESC)[?25l")          // hide the cursor
var start = System.clock
var asleep = 0
while (true) {
    for (i in 0..3) {
        System.write("%(ESC)[2J")    // clear terminal
        System.write("%(ESC)[0;0H")  // place cursor at top left corner
        for (j in 0..79) {           // 80 character terminal width, say
            System.write(a[i])
        }
        Stdout.flush()
        Timer.sleep(250)             // suspends both current fiber & System.clock
        asleep = asleep + 250
    }
    var now = System.clock
    // stop after 20 seconds, say
    if (now * 1000 + asleep - start * 1000 >= 20000) break
}
System.print("%(ESC)[?25h")          // restore the cursor


char I, Rod;
[Rod:= "|/-\ ";
loop for I:= 0 to 3 do
    [ChOut(0, Rod(I));
    DelayUS(250_000);
    ChOut(0, $08\BS\);
    if KeyHit then quit;
    ];
]


10 LET A$="|/-\"
20 FOR C=1 TO 4
30 PRINT AT 0,0;A$(C)
40 PAUSE 4
50 NEXT C
60 GOTO 20


text$=TRANSLATE$("This is an example of speech synthesis.")
SAY text$


say "This is an example of speech synthesis"


talk := ComObjCreate("sapi.spvoice")
talk.Speak("This is an example of speech synthesis.")


$voice = ObjCreate("SAPI.SpVoice")
$voice.Speak("This is an example of speech synthesis.")


say "Goodbye, World for the " + 123456 + "th time."
say "This is an example of speech synthesis."


@set @dummy=0 /*
	::Batch File section
	@echo off
	cscript //e:jscript //nologo "%~f0" "%~1"
	exit /b
::*/
//The JScript section
var objVoice = new ActiveXObject("SAPI.SpVoice");
objVoice.speak(WScript.Arguments(0));


      SPF_ASYNC = 1
      ON ERROR SYS `CoUninitialize` : PRINT 'REPORT$ : END
      ON CLOSE SYS `CoUninitialize` : QUIT

      SYS "LoadLibrary","OLE32.DLL" TO O%
      SYS "GetProcAddress",O%,"CoInitialize" TO `CoInitialize`
      SYS "GetProcAddress",O%,"CoUninitialize" TO `CoUninitialize`
      SYS "GetProcAddress",O%,"CoCreateInstance" TO `CoCreateInstance`

      SYS `CoInitialize`,0
      voice% = FN_voice_create
      PROC_voice_speak(voice%, "This is an example of speech synthesis")
      PROC_voice_wait(voice%)
      PROC_voice_free(voice%)
      SYS `CoUninitialize`
      END

      DEF FN_voice_create
      LOCAL C%, D%, F%, I%, M%, P%, V%
      DIM C% LOCAL 15, I% LOCAL 15
      C%!0 = &96749377 : C%!4 = &11D23391 : C%!8 = &C000E39E : C%!12 = &9673794F
      I%!0 = &6C44DF74 : I%!4 = &499272B9 : I%!8 = &99EFECA1 : I%!12 = &D422046E
      SYS `CoCreateInstance`, C%, 0, 5, I%, ^V%
      IF V%=0 ERROR 100, "SAPI5 not available"
      = V%

      DEF PROC_voice_speak(V%, M$)
      DIM M% LOCAL 2*LENM$+1
      SYS "MultiByteToWideChar", 0, 0, M$, -1, M%, LENM$+1
      SYS !(!V%+80), V%, M%, SPF_ASYNC, 0
      ENDPROC

      DEF PROC_voice_wait(V%)
      SYS !(!V%+128), V%
      ENDPROC

      DEF PROC_voice_free(V%)
      SYS !(!V%+8), V%
      ENDPROC


#include <sys/wait.h>
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>

void talk(const char *s)
{
	pid_t pid;
	int status;

	pid = fork();
	if (pid < 0) {
		perror("fork");
		exit(1);
	}

	if (pid == 0) {
		execlp("espeak", "espeak", s, (void*)0);
		perror("espeak");
		_exit(1);
	}

	waitpid(pid, &status, 0);
	if (!WIFEXITED(status) || WEXITSTATUS(status) != 0)
		exit(1);
}

int main()
{
	talk("This is an example of speech synthesis.");
	return 0;
}


using SpeechLib;

namespace Speaking_Computer
{
  public class Program
  {
    private static void Main()
    {
      var voice = new SpVoice();
      voice.Speak("This is an example of speech synthesis.");
    }
  }
}


(use 'speech-synthesis.say)
(say "This is an example of speech synthesis.")


''This works on Windows. Does anyone know how it would be done in Linux?

Sub speak(texto As String)
    Dim As String frase
    frase ="mshta vbscript:Execute(""CreateObject(""""SAPI.SpVoice"""").Speak("""""+texto+""""")(window.close)"")"
    Print texto
    Shell frase
End Sub

speak "Vamos a contar " + str(123456)
speak "This is an example of speech synthesis."
Sleep


if var.number=0 then
var.number=1
say("This is an example of speech synthesis.")
endif


package main

import (
    "go/build"
    "log"
    "path/filepath"

    "github.com/unixpickle/gospeech"
    "github.com/unixpickle/wav"
)

const pkgPath = "github.com/unixpickle/gospeech"
const input = "This is an example of speech synthesis."

func main() {
    p, err := build.Import(pkgPath, ".", build.FindOnly)
    if err != nil {
        log.Fatal(err)
    }
    d := filepath.Join(p.Dir, "dict/cmudict-IPA.txt")
    dict, err := gospeech.LoadDictionary(d)
    if err != nil {
        log.Fatal(err)
    }
    phonetics := dict.TranslateToIPA(input)
    synthesized := gospeech.DefaultVoice.Synthesize(phonetics)
    wav.WriteFile(synthesized, "output.wav")
}


'say "This is an example of speech synthesis."'.execute()


import System.Process (callProcess) -- From “process” library

say text = callProcess "espeak" ["--", text]

main = say "This is an example of speech synthesis."


var utterance = new SpeechSynthesisUtterance("This is an example of speech synthesis.");
window.speechSynthesis.speak(utterance);


julia> a = "hello world"
"hello world"

julia> run(`espeak $a`)


// Kotlin Native v0.6.2

import kotlinx.cinterop.*
import platform.posix.*

fun talk(s: String) {
    val pid = fork()
    if (pid < 0) {
       perror("fork")
       exit(1)
    }
    if (pid == 0) {
       execlp("espeak", "espeak", s, null)
       perror("espeak")
       _exit(1)
    }
    memScoped {
        val status = alloc<IntVar>()
        waitpid(pid, status.ptr, 0)
        if (status.value > 0) println("Exit status was ${status.value}")
    }
}

fun main(args: Array<String>) {
    talk("This is an example of speech synthesis.")
}


nomainwin
run "C:\Program Files\eSpeak\command_line\espeak  "; chr$( 34); "This is an example of speech synthesis."; chr$( 34)
end


|say,"This is an example of speech synthesis."


Module UsingStatementSpeech {
      Volume 100
      Speech "This is an example of speech synthesis."
}
UsingStatementSpeech


Speak["This is an example of speech synthesis."]


import osproc

discard execCmd("espeak 'Hello world!'")


use Speech::Synthesis;

($engine) = Speech::Synthesis->InstalledEngines();
($voice) = Speech::Synthesis->InstalledVoices(engine => $engine);

Speech::Synthesis
  ->new(engine => $engine, voice => $voice->{id})
  ->speak("This is an example of speech synthesis.");


--
-- demo\rosetta\Speak.exw
-- ======================
--
with javascript_semantics
requires(6) -- WINDOWS or JS, not LINUX
requires(32) -- Windows 32 bit only, for now...
-- (^ runs fine on a 64-bit OS, but needs a 32-bit p.exe)
requires("1.0.2")
include builtins\speak.e -- (new in 1.0.2)
constant text = "This is an example of speech synthesis"

include pGUI.e

function button_cb(Ihandle /*ih*/)
    speak(text)
    return IUP_CONTINUE
end function

IupOpen()
Ihandle btn = IupButton("Speak",Icallback("button_cb")),
        dlg = IupDialog(IupHbox({btn},"MARGIN=180x80"))
IupSetAttribute(dlg,"TITLE",text)
IupShow(dlg)
if platform()!=JS then
    IupMainLoop()
    IupClose()
end if


<?php
<?php

/*
  _      _____ _   _ _    ___   __
 | |    |_   _| \ | | |  | \ \ / /
 | |      | | |  \| | |  | |\ V /
 | |      | | | . ` | |  | | > <
 | |____ _| |_| |\  | |__| |/ . \
 |______|_____|_| \_|\____//_/ \_\
*/
// Install eSpeak - Run this command in a terminal
/*
 sudo apt-get install eSpeak
*/

/*
  __  __          _____
 |  \/  |   /\   / ____|
 | \  / |  /  \ | |
 | |\/| | / /\ \| |
 | |  | |/ ____ \ |____
 |_|  |_/_/    \_\_____|
*/
// Mac has it's own Speech Synthesis system
// accessible via the "say" command.
// To use eSpeak on a Mac, change this variable to true.
$mac_use_espeak = false;

// To use eSpeak on a Mac you need to install
// Homebrew Package Manager & eSpeak
// Run these commands in a terminal:
/*

/usr/bin/ruby -e "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/master/install)"

brew install espeak

*/

$voice = "espeak";
$statement = 'Hello World!';
$save_file_args = '-w HelloWorld.wav'; // eSpeak args

// Ask PHP what OS it was compiled for,
// CAPITALIZE it and truncate to the first 3 chars.
$OS = strtoupper(substr(PHP_OS, 0, 3));

// If this is Darwin (MacOS) AND we don't want eSpeak
elseif($OS === 'DAR' && $mac_use_espeak == false) {
    $voice = "say -v 'Victoria'";
    $save_file_args = '-o HelloWorld.wav'; // say args
}

// Say It
exec("$voice '$statement'");

// Save it to a File
exec("$voice '$statement' $save_file_args");


(call 'espeak "This is an example of speech synthesis.")


Add-Type -AssemblyName System.Speech

$anna = New-Object System.Speech.Synthesis.SpeechSynthesizer

$anna.Speak("I'm sorry Dave, I'm afraid I can't do that.")
$anna.Dispose()


import pyttsx

engine = pyttsx.init()
engine.say("It was all a dream.")
engine.runAndWait()


#lang racket
(require racket/lazy-require)
(lazy-require [ffi/com (com-create-instance com-release com-invoke)])
(define (speak text)
  (cond [(eq? 'windows (system-type))
         (define c (com-create-instance "SAPI.SpVoice"))
         (com-invoke c "Speak" text)
         (com-release c)]
        [(ormap find-executable-path '("say" "espeak"))
         => (λ(exe) (void (system* exe text)))]
        [else (error 'speak "I'm speechless!")]))
(speak "This is an example of speech synthesis.")


run 'espeak', 'This is an example of speech synthesis.';


/*REXX program uses a command line interface to invoke Windows SAM for speech synthesis.*/
parse arg t                                      /*get the (optional) text from the C.L.*/
if t=''  then exit                               /*Nothing to say?    Then exit program.*/
dquote= '"'
rate= 1                                          /*talk:   -10 (slow)   to   10 (fast). */
                                                 /* [↓]  where the rubber meets the road*/
'NIRCMD'  "speak text"  dquote  t  dquote   rate /*NIRCMD  invokes Microsoft's Sam voice*/
                                                 /*stick a fork in it,  we're all done. */


load "guilib.ring"

myApp = New qApp
{
   Text = "Hello. This is an example of speech synthesis"
   voice = new QTextToSpeech(null)
   voice.Say(Text)

   exec()
}


load "guilib.ring"
load "stdlib.ring"

MyApp = New qApp {

        win1 = new qWidget() {

                setwindowtitle("Hello World")
                setGeometry(100,100,370,250)

                Text = "This is an example of speech synthesis"
                Text = split(Text," ")

                label1 = new qLabel(win1) {
                        settext("What is your name ?")
                        setGeometry(10,20,350,30)
                        setalignment(Qt_AlignHCenter)
                }

                btn1 = new qpushbutton(win1) {
                        setGeometry(10,200,100,30)
                        settext("Say Hello")
                        setclickevent("pHello()")
                }

                btn2 = new qpushbutton(win1) {
                        setGeometry(150,200,100,30)
                        settext("Close")
                        setclickevent("pClose()")
                }

                lineedit1 = new qlineedit(win1) {
                        setGeometry(10,100,350,30)
                }

                voice = new QTextToSpeech(win1) {
                }
                show()
        }
        exec()
}

Func pHello
        lineedit1.settext( "Hello " + lineedit1.text())
        for n = 1 to len(Text)
            voice.Say(Text[n])
            see Text[n] + nl
        next

Func pClose
        MyApp.quit()


module OperatingSystem
  require 'rbconfig'
  module_function
  def operating_system
    case RbConfig::CONFIG["host_os"]
    when /linux/i
      :linux
    when /cygwin|mswin|mingw|windows/i
      :windows
    when /darwin/i
      :mac
    when /solaris/i
      :solaris
    else
      nil
    end
  end
  def linux?;   operating_system == :linux;   end
  def windows?; operating_system == :windows; end
  def mac?;     operating_system == :mac;     end
end


import javax.speech.Central
import javax.speech.synthesis.{Synthesizer, SynthesizerModeDesc}

object ScalaSpeaker extends App {

  def speech(text: String) = {
    if (!text.trim.isEmpty) {
      val VOICENAME = "kevin16"

      System.setProperty("freetts.voices", "com.sun.speech.freetts.en.us.cmu_us_kal.KevinVoiceDirectory")
      Central.registerEngineCentral("com.sun.speech.freetts.jsapi.FreeTTSEngineCentral")

      val synth = Central.createSynthesizer(null)
      synth.allocate()

      val desc = synth.getEngineModeDesc match {case g2: SynthesizerModeDesc => g2}

      synth.getSynthesizerProperties.setVoice(desc.getVoices.find(_.toString == VOICENAME).get)
      synth.speakPlainText(text, null)

      synth.waitEngineState(Synthesizer.QUEUE_EMPTY)
      synth.deallocate()
    }
  }

  speech( """Thinking of Holland
            |I see broad rivers
            |slowly chuntering
            |through endless lowlands,
            |rows of implausibly
            |airy poplars
            |standing like tall plumes
            |against the horizon;
            |and sunk in the unbounded
            |vastness of space
            |homesteads and boweries
            |dotted across the land,
            |copses, villages,
            |couchant towers,
            |churches and elm-trees,
            |bound in one great unity.
            |There the sky hangs low,
            |and steadily the sun
            |is smothered in a greyly
            |iridescent smirr,
            |and in every province
            |the voice of water
            |with its lapping disasters
            |is feared and hearkened.""".stripMargin)
}


func text2speech(text, lang='en') {
    Sys.run("espeak -v #{lang} -w /dev/stdout #{text.escape} | aplay");
}
text2speech("This is an example of speech synthesis.");


import Foundation

let task = NSTask()
task.launchPath = "/usr/bin/say"
task.arguments = ["This is an example of speech synthesis."]
task.launch()


exec festival --tts << "This is an example of speech synthesis."


#!/bin/sh
espeak "This is an example of speech synthesis."


Dim message, sapi
message = "This is an example of speech synthesis."
Set sapi = CreateObject("sapi.spvoice")
sapi.Speak message


/* speech_synthesis.wren */

class C {
    foreign static getInput(maxSize)

    foreign static espeak(s)
}

System.write("Enter something to say (up to 100 characters) : ")
var s = C.getInput(100)
C.espeak(s)


speak "This is an example of speech synthesis."


10 LET s$="(th)is is an exampul of sp(ee)(ch) sin(th)esis":PAUSE 1


[Int] stack

L(i) 1..10
   stack.append(i)

L 10
   print(stack.pop())


LEA userStack,A0                        ;initialize the user stack, points to a memory address in user RAM. Only do this once!
MOVEM.L D0-D3,-(A0)   ;moves the full 32 bits of registers D0,D1,D2,D3 into the address pointed by A0, with pre-decrement


push ax ;push ax onto the stack
pop ax  ; pop the top two bytes of the stack into ax


OrdinalNumber(n){
	OrdinalNumber := {"one":"first", "two":"second", "three":"third", "five":"fifth", "eight":"eighth", "nine":"ninth", "twelve": "twelfth"}
	RegExMatch(n, "\w+$", m)
	return (OrdinalNumber[m] ? RegExReplace(n, "\w+$", OrdinalNumber[m]) : n "th")
}

Spell(n) { ; recursive function to spell out the name of a max 36 digit integer, after leading 0s removed
    Static p1=" thousand ",p2=" million ",p3=" billion ",p4=" trillion ",p5=" quadrillion ",p6=" quintillion "
         , p7=" sextillion ",p8=" septillion ",p9=" octillion ",p10=" nonillion ",p11=" decillion "
         , t2="twenty",t3="thirty",t4="forty",t5="fifty",t6="sixty",t7="seventy",t8="eighty",t9="ninety"
         , o0="zero",o1="one",o2="two",o3="three",o4="four",o5="five",o6="six",o7="seven",o8="eight"
         , o9="nine",o10="ten",o11="eleven",o12="twelve",o13="thirteen",o14="fourteen",o15="fifteen"
         , o16="sixteen",o17="seventeen",o18="eighteen",o19="nineteen"

    n :=RegExReplace(n,"^0+(\d)","$1") ; remove leading 0s from n
    If  (11 < d := (StrLen(n)-1)//3)   ; #of digit groups of 3
        Return "Number too big"
    If (d)                             ; more than 3 digits 1000+
        Return Spell(SubStr(n,1,-3*d)) p%d% ((s:=SubStr(n,1-3*d)) ? ", " Spell(s) : "")
    i := SubStr(n,1,1)
    If (n > 99)                        ; 3 digits 100..999
        Return o%i% " hundred" ((s:=SubStr(n,2)) ? " and " Spell(s) : "")
    If (n > 19)                        ; n = 20..99
        Return t%i% ((o:=SubStr(n,2)) ? "-" o%o% : "")
    Return o%n%                        ; n = 0..19
}

PrettyNumber(n) { ; inserts thousands separators into a number string
    Return RegExReplace( RegExReplace(n,"^0+(\d)","$1"), "\G\d+?(?=(\d{3})+(?:\D|$))", "$0,")
}


report z_stack.

interface stack.
  methods:
    push
      importing
        new_element      type any
      returning
        value(new_stack) type ref to stack,

    pop
      exporting
        top_element      type any
      returning
        value(new_stack) type ref to stack,

    empty
      returning
        value(is_empty) type abap_bool,

    peek
      exporting
        top_element type any,

    get_size
      returning
        value(size) type int4,

    stringify
      returning
        value(stringified_stack) type string.
endinterface.

class character_stack definition.
  public section.
    interfaces:
      stack.

    methods:
      constructor
        importing
          characters type string optional.

  private section.
    data:
      characters type string.
endclass.

class character_stack implementation.
  method stack~push.
    characters = |{ new_element }{ characters }|.

    new_stack = me.
  endmethod.

  method stack~pop.
    if not me->stack~empty( ).
      top_element = me->characters(1).

      me->characters = me->characters+1.
    endif.

    new_stack = me.
  endmethod.

  method stack~empty.
    is_empty = xsdbool( strlen( me->characters ) eq 0 ).
  endmethod.

  method stack~peek.
    check not me->stack~empty( ).

    top_element = me->characters(1).
  endmethod.

  method stack~get_size.
    size = strlen( me->characters ).
  endmethod.

  method stack~stringify.
    stringified_stack = cond string(
      when me->stack~empty( )
      then `empty`
      else me->characters ).
  endmethod.

  method constructor.
    check characters is not initial.

    me->characters = characters.
  endmethod.
endclass.

class integer_stack definition.
  public section.
    interfaces:
      stack.

    methods:
      constructor
        importing
          integers type int4_table optional.

  private section.
    data:
      integers type int4_table.
endclass.

class integer_stack implementation.
  method stack~push.
    append new_element to me->integers.

    new_stack = me.
  endmethod.

  method stack~pop.
    if not me->stack~empty( ).
      top_element = me->integers[ me->stack~get_size( ) ].

      delete me->integers index me->stack~get_size( ).
    endif.

    new_stack = me.
  endmethod.

  method stack~empty.
    is_empty = xsdbool( lines( me->integers ) eq 0 ).
  endmethod.

  method stack~peek.
    check not me->stack~empty( ).

    top_element = me->integers[ lines( me->integers ) ].
  endmethod.

  method stack~get_size.
    size = lines( me->integers ).
  endmethod.

  method stack~stringify.
    stringified_stack = cond string(
      when me->stack~empty( )
      then `empty`
      else reduce string(
        init stack = ``
        for integer in me->integers
        next stack = |{ integer }{ stack }| ) ).
  endmethod.

  method constructor.
    check integers is not initial.

    me->integers = integers.
  endmethod.
endclass.

start-of-selection.
  data:
    stack1        type ref to stack,
    stack2        type ref to stack,
    stack3        type ref to stack,

    top_character type char1,
    top_integer   type int4.

  stack1 = new character_stack( ).
  stack2 = new integer_stack( ).
  stack3 = new integer_stack( ).

  write: |Stack1 = { stack1->stringify( ) }|, /.
  stack1->push( 'a' )->push( 'b' )->push( 'c' )->push( 'd' ).
  write: |push a, push b, push c, push d -> Stack1 = { stack1->stringify( ) }|, /.
  stack1->pop( )->pop( importing top_element = top_character ).
  write: |pop, pop and return element -> { top_character }, Stack1 = { stack1->stringify( ) }|, /, /.

  write: |Stack2 = { stack2->stringify( ) }|, /.
  stack2->push( 1 )->push( 2 )->push( 3 )->push( 4 ).
  write: |push 1, push 2, push 3, push 4 -> Stack2 = { stack2->stringify( ) }|, /.
  stack2->pop( )->pop( importing top_element = top_integer ).
  write: |pop, pop and return element -> { top_integer }, Stack2 = { stack2->stringify( ) }|, /, /.

  write: |Stack3 = { stack3->stringify( ) }|, /.
  stack3->pop( ).
  write: |pop -> Stack3 = { stack3->stringify( ) }|, /, /.


#include <stdbool.h>
#include <stdio.h>
#include <stdint.h>
#include <glib.h>

typedef uint64_t integer;

typedef struct number_names_tag {
    const char* cardinal;
    const char* ordinal;
} number_names;

const number_names small[] = {
    { "zero", "zeroth" }, { "one", "first" }, { "two", "second" },
    { "three", "third" }, { "four", "fourth" }, { "five", "fifth" },
    { "six", "sixth" }, { "seven", "seventh" }, { "eight", "eighth" },
    { "nine", "ninth" }, { "ten", "tenth" }, { "eleven", "eleventh" },
    { "twelve", "twelfth" }, { "thirteen", "thirteenth" },
    { "fourteen", "fourteenth" }, { "fifteen", "fifteenth" },
    { "sixteen", "sixteenth" }, { "seventeen", "seventeenth" },
    { "eighteen", "eighteenth" }, { "nineteen", "nineteenth" }
};

const number_names tens[] = {
    { "twenty", "twentieth" }, { "thirty", "thirtieth" },
    { "forty", "fortieth" }, { "fifty", "fiftieth" },
    { "sixty", "sixtieth" }, { "seventy", "seventieth" },
    { "eighty", "eightieth" }, { "ninety", "ninetieth" }
};

typedef struct named_number_tag {
    const char* cardinal;
    const char* ordinal;
    integer number;
} named_number;

const named_number named_numbers[] = {
    { "hundred", "hundredth", 100 },
    { "thousand", "thousandth", 1000 },
    { "million", "millionth", 1000000 },
    { "billion", "billionth", 1000000000 },
    { "trillion", "trillionth", 1000000000000 },
    { "quadrillion", "quadrillionth", 1000000000000000ULL },
    { "quintillion", "quintillionth", 1000000000000000000ULL }
};

const char* get_small_name(const number_names* n, bool ordinal) {
    return ordinal ? n->ordinal : n->cardinal;
}

const char* get_big_name(const named_number* n, bool ordinal) {
    return ordinal ? n->ordinal : n->cardinal;
}

const named_number* get_named_number(integer n) {
    const size_t names_len = sizeof(named_numbers)/sizeof(named_numbers[0]);
    for (size_t i = 0; i + 1 < names_len; ++i) {
        if (n < named_numbers[i + 1].number)
            return &named_numbers[i];
    }
    return &named_numbers[names_len - 1];
}

void append_number_name(GString* gstr, integer n, bool ordinal) {
    if (n < 20)
        g_string_append(gstr, get_small_name(&small[n], ordinal));
    else if (n < 100) {
        if (n % 10 == 0) {
            g_string_append(gstr, get_small_name(&tens[n/10 - 2], ordinal));
        } else {
            g_string_append(gstr, get_small_name(&tens[n/10 - 2], false));
            g_string_append_c(gstr, '-');
            g_string_append(gstr, get_small_name(&small[n % 10], ordinal));
        }
    } else {
        const named_number* num = get_named_number(n);
        integer p = num->number;
        append_number_name(gstr, n/p, false);
        g_string_append_c(gstr, ' ');
        if (n % p == 0) {
            g_string_append(gstr, get_big_name(num, ordinal));
        } else {
            g_string_append(gstr, get_big_name(num, false));
            g_string_append_c(gstr, ' ');
            append_number_name(gstr, n % p, ordinal);
        }
    }
}

GString* number_name(integer n, bool ordinal) {
    GString* result = g_string_sized_new(8);
    append_number_name(result, n, ordinal);
    return result;
}

void test_ordinal(integer n) {
    GString* name = number_name(n, true);
    printf("%llu: %s\n", n, name->str);
    g_string_free(name, TRUE);
}

int main() {
    test_ordinal(1);
    test_ordinal(2);
    test_ordinal(3);
    test_ordinal(4);
    test_ordinal(5);
    test_ordinal(11);
    test_ordinal(15);
    test_ordinal(21);
    test_ordinal(42);
    test_ordinal(65);
    test_ordinal(98);
    test_ordinal(100);
    test_ordinal(101);
    test_ordinal(272);
    test_ordinal(300);
    test_ordinal(750);
    test_ordinal(23456);
    test_ordinal(7891233);
    test_ordinal(8007006005004003LL);
    return 0;
}


DEFINE MAXSIZE="200"
BYTE ARRAY stack(MAXSIZE)
BYTE stacksize=[0]

BYTE FUNC IsEmpty()
  IF stacksize=0 THEN
    RETURN (1)
  FI
RETURN (0)

PROC Push(BYTE v)
  IF stacksize=maxsize THEN
    PrintE("Error: stack is full!")
    Break()
  FI
  stack(stacksize)=v
  stacksize==+1
RETURN

BYTE FUNC Pop()
  IF IsEmpty() THEN
    PrintE("Error: stack is empty!")
    Break()
  FI
  stacksize==-1
RETURN (stack(stacksize))

PROC TestIsEmpty()
  IF IsEmpty() THEN
    PrintE("Stack is empty")
  ELSE
    PrintE("Stack is not empty")
  FI
RETURN

PROC TestPush(BYTE v)
  PrintF("Push: %B%E",v)
  Push(v)
RETURN

PROC TestPop()
  BYTE v

  Print("Pop: ")
  v=Pop()
  PrintBE(v)
RETURN

PROC Main()
  TestIsEmpty()
  TestPush(10)
  TestIsEmpty()
  TestPush(31)
  TestPop()
  TestIsEmpty()
  TestPush(5)
  TestPop()
  TestPop()
  TestPop()
RETURN


var stack:Array = new Array();
stack.push(1);
stack.push(2);
trace(stack.pop()); // outputs "2"
trace(stack.pop()); // outputs "1"


#include <iostream>
#include <string>
#include <cstdint>

typedef std::uint64_t integer;

struct number_names {
    const char* cardinal;
    const char* ordinal;
};

const number_names small[] = {
    { "zero", "zeroth" }, { "one", "first" }, { "two", "second" },
    { "three", "third" }, { "four", "fourth" }, { "five", "fifth" },
    { "six", "sixth" }, { "seven", "seventh" }, { "eight", "eighth" },
    { "nine", "ninth" }, { "ten", "tenth" }, { "eleven", "eleventh" },
    { "twelve", "twelfth" }, { "thirteen", "thirteenth" },
    { "fourteen", "fourteenth" }, { "fifteen", "fifteenth" },
    { "sixteen", "sixteenth" }, { "seventeen", "seventeenth" },
    { "eighteen", "eighteenth" }, { "nineteen", "nineteenth" }
};

const number_names tens[] = {
    { "twenty", "twentieth" }, { "thirty", "thirtieth" },
    { "forty", "fortieth" }, { "fifty", "fiftieth" },
    { "sixty", "sixtieth" }, { "seventy", "seventieth" },
    { "eighty", "eightieth" }, { "ninety", "ninetieth" }
};

struct named_number {
    const char* cardinal;
    const char* ordinal;
    integer number;
};

const named_number named_numbers[] = {
    { "hundred", "hundredth", 100 },
    { "thousand", "thousandth", 1000 },
    { "million", "millionth", 1000000 },
    { "billion", "billionth", 1000000000 },
    { "trillion", "trillionth", 1000000000000 },
    { "quadrillion", "quadrillionth", 1000000000000000ULL },
    { "quintillion", "quintillionth", 1000000000000000000ULL }
};

const char* get_name(const number_names& n, bool ordinal) {
    return ordinal ? n.ordinal : n.cardinal;
}

const char* get_name(const named_number& n, bool ordinal) {
    return ordinal ? n.ordinal : n.cardinal;
}

const named_number& get_named_number(integer n) {
    constexpr size_t names_len = std::size(named_numbers);
    for (size_t i = 0; i + 1 < names_len; ++i) {
        if (n < named_numbers[i + 1].number)
            return named_numbers[i];
    }
    return named_numbers[names_len - 1];
}

std::string number_name(integer n, bool ordinal) {
    std::string result;
    if (n < 20)
        result = get_name(small[n], ordinal);
    else if (n < 100) {
        if (n % 10 == 0) {
            result = get_name(tens[n/10 - 2], ordinal);
        } else {
            result = get_name(tens[n/10 - 2], false);
            result += "-";
            result += get_name(small[n % 10], ordinal);
        }
    } else {
        const named_number& num = get_named_number(n);
        integer p = num.number;
        result = number_name(n/p, false);
        result += " ";
        if (n % p == 0) {
            result += get_name(num, ordinal);
        } else {
            result += get_name(num, false);
            result += " ";
            result += number_name(n % p, ordinal);
        }
    }
    return result;
}

void test_ordinal(integer n) {
    std::cout << n << ": " << number_name(n, true) << '\n';
}

int main() {
    test_ordinal(1);
    test_ordinal(2);
    test_ordinal(3);
    test_ordinal(4);
    test_ordinal(5);
    test_ordinal(11);
    test_ordinal(15);
    test_ordinal(21);
    test_ordinal(42);
    test_ordinal(65);
    test_ordinal(98);
    test_ordinal(100);
    test_ordinal(101);
    test_ordinal(272);
    test_ordinal(300);
    test_ordinal(750);
    test_ordinal(23456);
    test_ordinal(7891233);
    test_ordinal(8007006005004003LL);
    return 0;
}


generic
   type Element_Type is private;
package Generic_Stack is
   type Stack is private;
   procedure Push (Item : Element_Type; Onto : in out Stack);
   procedure Pop (Item : out Element_Type; From : in out Stack);
   function Create return Stack;
   Stack_Empty_Error : exception;
private
   type Node;
   type Stack is access Node;
   type Node is record
      Element : Element_Type;
      Next    : Stack        := null;
   end record;
end Generic_Stack;


# -*- coding: utf-8 -*- #
CO REQUIRES:
  MODE OBJVALUE = ~ # Mode/type of actual obj to be stacked #
END CO

MODE OBJNEXTLINK = STRUCT(
  REF OBJNEXTLINK next,
  OBJVALUE value # ... etc. required #
);

PROC obj nextlink new = REF OBJNEXTLINK:
  HEAP OBJNEXTLINK;

PROC obj nextlink free = (REF OBJNEXTLINK free)VOID:
  next OF free := obj stack empty # give the garbage collector a BIG hint #


(def test-cases [1 2 3 4 5 11 65 100 101 272 23456 8007006005004003])
(pprint
  (sort (zipmap test-cases (map #(clojure.pprint/cl-format nil "~:R" %) test-cases))))


(defun ordinal-number (n)
  (format nil "~:R" n))

#|
CL-USER> (loop for i in '(1 2 3 4 5 11 65 100 101 272 23456 8007006005004003)
               do (format t "~a: ~a~%" i (ordinal-number i)))
1: first
2: second
3: third
4: fourth
5: fifth
11: eleventh
65: sixty-fifth
100: one hundredth
101: one hundred first
272: two hundred seventy-second
23456: twenty-three thousand four hundred fifty-sixth
8007006005004003: eight quadrillion seven trillion six billion five million four thousand third
NIL
|#


USING: assocs formatting grouping kernel literals locals math
math.parser math.text.english qw regexp sequences
splitting.extras ;
IN: rosetta-code.spelling-ordinal-numbers

<PRIVATE

! Factor supports the arbitrary use of commas in integer
! literals, as some number systems (e.g. Indian) don't solely
! break numbers up into triplets.

CONSTANT: test-cases qw{
    1 2 3 4 5 11 65 100 101 272 23456 8007006005004003 123
    00123.0 1.23e2 1,2,3 0b1111011 0o173 0x7B 2706/22
}

CONSTANT: replacements $[
    qw{
        one    first
        two    second
        three  third
        five   fifth
        eight  eighth
        nine   ninth
        twelve twelfth
    } 2 group
]

: regular-ordinal ( n -- str )
    [ number>text ] [ ordinal-suffix ] bi append ;

! Since Factor's number>text word contains commas and "and",
! strip them out with a regular expression.

: text>ordinal-text ( str -- str' ) R/ \sand|,/ "" re-replace ;

PRIVATE>

:: number>ordinal-text ( n! -- str )
    n >integer n!
    n number>text " ,-" split* dup last replacements at
    [ [ but-last ] dip suffix "" join ]
    [ drop n regular-ordinal          ] if* text>ordinal-text ;

<PRIVATE

: print-ordinal-pair ( str x -- )
    number>ordinal-text "%16s => %s\n" printf ;

PRIVATE>

: ordinal-text-demo ( -- )
    test-cases [ dup string>number print-ordinal-pair ] each
    "C{ 123 0 }" C{ 123 0 } print-ordinal-pair ;

MAIN: ordinal-text-demo


import (
	"fmt"
	"strings"
)

func main() {
	for _, n := range []int64{
		1, 2, 3, 4, 5, 11, 65, 100, 101, 272, 23456, 8007006005004003,
	} {
		fmt.Println(sayOrdinal(n))
	}
}

var irregularOrdinals = map[string]string{
	"one":    "first",
	"two":    "second",
	"three":  "third",
	"five":   "fifth",
	"eight":  "eighth",
	"nine":   "ninth",
	"twelve": "twelfth",
}

func sayOrdinal(n int64) string {
	s := say(n)
	i := strings.LastIndexAny(s, " -")
	i++
	// Now s[:i] is everything upto and including the space or hyphen
	// and s[i:] is the last word; we modify s[i:] as required.
	// Since LastIndex returns -1 if there was no space/hyphen,
	// `i` will be zero and this will still be fine.
	if x, ok := irregularOrdinals[s[i:]]; ok {
		s = s[:i] + x
	} else if s[len(s)-1] == 'y' {
		s = s[:i] + s[i:len(s)-1] + "ieth"
	} else {
		s = s[:i] + s[i:] + "th"
	}
	return s
}

// Below is a copy of https://rosettacode.org/wiki/Number_names#Go

var small = [...]string{"zero", "one", "two", "three", "four", "five", "six",
	"seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen",
	"fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen"}
var tens = [...]string{"", "", "twenty", "thirty", "forty",
	"fifty", "sixty", "seventy", "eighty", "ninety"}
var illions = [...]string{"", " thousand", " million", " billion",
	" trillion", " quadrillion", " quintillion"}

func say(n int64) string {
	var t string
	if n < 0 {
		t = "negative "
		// Note, for math.MinInt64 this leaves n negative.
		n = -n
	}
	switch {
	case n < 20:
		t += small[n]
	case n < 100:
		t += tens[n/10]
		s := n % 10
		if s > 0 {
			t += "-" + small[s]
		}
	case n < 1000:
		t += small[n/100] + " hundred"
		s := n % 100
		if s > 0 {
			t += " " + say(s)
		}
	default:
		// work right-to-left
		sx := ""
		for i := 0; n > 0; i++ {
			p := n % 1000
			n /= 1000
			if p > 0 {
				ix := say(p) + illions[i]
				if sx != "" {
					ix += " " + sx
				}
				sx = ix
			}
		}
		t += sx
	}
	return t
}


begin
    % define a Stack type that will hold StringStackElements     %
    % and the StringStackElement type                            %
    % we would need separate types for other element types       %
    record StringStack ( reference(StringStackElement) top );
    record StringStackElement ( string(8)                     element
                              ; reference(StringStackElement) next
                              );
    % adds e to the end of the StringStack s                     %
    procedure pushString ( reference(StringStack) value s
                         ; string(8)              value e
                         ) ;
        top(s) := StringStackElement( e, top(s) );
    % removes and returns the top element from the StringStack s %
    % asserts the Stack is not empty, which will stop the        %
    % program if it is                                           %
    string(8) procedure popString ( reference(StringStack) value s ) ;
    begin
        string(8) v;
        assert( not isEmptyStringStack( s ) );
        v     := element(top(s));
        top(s):= next(top(s));
        v
    end popStringStack ;
    % returns the top element of the StringStack s               %
    % asserts the Stack is not empty, which will stop the        %
    % program if it is                                           %
    string(8) procedure peekStringStack ( reference(StringStack) value s ) ;
    begin
        assert( not isEmptyStringStack( s ) );
        element(top(s))
    end popStringStack ;
    % returns true if the StringStack s is empty, false otherwise %
    logical procedure isEmptyStringStack ( reference(StringStack) value s ) ; top(s) = null;

    begin % test the StringStack operations %
        reference(StringStack) s;
        s := StringStack( null );
        pushString( s, "up"      );
        pushString( s, "down"    );
        pushString( s, "strange" );
        pushString( s, "charm"   );
        while not isEmptyStringStack( s ) do write( popString( s )
                                                  , if isEmptyStringStack( s ) then "(empty)"
                                                                               else peekStringStack( s )
                                                  )
    end
end.


100  DIM STACK$(1000)
110  DATA "(2*A)","PI","","TO BE OR","NOT TO BE"
120  FOR I = 1 TO 5
130  READ ELEMENT$
140  GOSUB 500_PUSH
150  NEXT
200  GOSUB 400 POP  AND  PRINT
210  GOSUB 300_EMPTY AND  PRINT
220  FOR I = 1 TO 4
230  GOSUB 400 POP  AND  PRINT
240  NEXT
250  GOSUB 300_EMPTY AND  PRINT
260  END
300  GOSUB 700_EMPTY
310  PRINT "STACK IS ";
320  IF  NOT EMPTY THEN  PRINT "NOT ";
330  PRINT "EMPTY"
340  RETURN
400  GOSUB 600 POP
410  PRINT ELEMENT$
420  RETURN
500  REM
510  REM PUSH
520  REM
530  LET STACK$(SP) = ELEMENT$
540  LET SP = SP + 1
550  RETURN
600  REM
610  REM POP
620  REM
630  IF SP THEN SP = SP - 1
640  LET ELEMENT$ = STACK$(SP)
650  LET STACK$(SP) = ""
660  RETURN
700  REM
710  REM EMPTY
720  REM
730  LET EMPTY = SP = 0
740  RETURN


spellOrdinal :: Integer -> String
spellOrdinal n
 | n <=   0  = "not ordinal"
 | n <   20  = small n
 | n < 100   = case divMod n 10 of
     (k, 0) -> spellInteger (10*k) ++ "th"
     (k, m) -> spellInteger (10*k) ++ "-" ++ spellOrdinal m
 | n < 1000 = case divMod n 100 of
     (k, 0) -> spellInteger (100*k) ++ "th"
     (k, m) -> spellInteger (100*k) ++ " and " ++ spellOrdinal m
 | otherwise = case divMod n 1000 of
     (k, 0) -> spellInteger (1000*k) ++ "th"
     (k, m) -> spellInteger (k*1000) ++ s ++ spellOrdinal m
       where s = if m < 100 then " and " else ", "
  where
   small = ([ undefined, "first", "second", "third", "fourth", "fifth"
            , "sixth", "seventh", "eighth", "nineth", "tenth", "eleventh"
            , "twelveth", "thirteenth", "fourteenth", "fifteenth", "sixteenth"
            , "seventeenth", "eighteenth", "nineteenth"] !!) . fromEnum


ord=: {{
  ((us,suf)1+y) rplc ;:{{)n onest first twond second
    threerd third fiveth fifth eightth eighth
}}-.LF
}}


import java.util.HashMap;
import java.util.Map;

public class SpellingOfOrdinalNumbers {

    public static void main(String[] args) {
        for ( long test : new long[] {1,  2,  3,  4,  5,  11,  65,  100,  101,  272,  23456,  8007006005004003L} ) {
            System.out.printf("%d = %s%n", test, toOrdinal(test));
        }
    }

    private static Map<String,String> ordinalMap = new HashMap<>();
    static {
        ordinalMap.put("one", "first");
        ordinalMap.put("two", "second");
        ordinalMap.put("three", "third");
        ordinalMap.put("five", "fifth");
        ordinalMap.put("eight", "eighth");
        ordinalMap.put("nine", "ninth");
        ordinalMap.put("twelve", "twelfth");
    }

    private static String toOrdinal(long n) {
        String spelling = numToString(n);
        String[] split = spelling.split(" ");
        String last = split[split.length - 1];
        String replace = "";
        if ( last.contains("-") ) {
            String[] lastSplit = last.split("-");
            String lastWithDash = lastSplit[1];
            String lastReplace = "";
            if ( ordinalMap.containsKey(lastWithDash) ) {
                lastReplace = ordinalMap.get(lastWithDash);
            }
            else if ( lastWithDash.endsWith("y") ) {
                lastReplace = lastWithDash.substring(0, lastWithDash.length() - 1) + "ieth";
            }
            else {
                lastReplace = lastWithDash + "th";
            }
            replace = lastSplit[0] + "-" + lastReplace;
        }
        else {
            if ( ordinalMap.containsKey(last) ) {
                replace = ordinalMap.get(last);
            }
            else if ( last.endsWith("y") ) {
                replace = last.substring(0, last.length() - 1) + "ieth";
            }
            else {
                replace = last + "th";
            }
        }
        split[split.length - 1] = replace;
        return String.join(" ", split);
    }

    private static final String[] nums = new String[] {
            "zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine",
            "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen"
    };

    private static final String[] tens = new String[] {"zero", "ten", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety"};

    private static final String numToString(long n) {
        return numToStringHelper(n);
    }

    private static final String numToStringHelper(long n) {
        if ( n < 0 ) {
            return "negative " + numToStringHelper(-n);
        }
        int index = (int) n;
        if ( n <= 19 ) {
            return nums[index];
        }
        if ( n <= 99 ) {
            return tens[index/10] + (n % 10 > 0 ? "-" + numToStringHelper(n % 10) : "");
        }
        String label = null;
        long factor = 0;
        if ( n <= 999 ) {
            label = "hundred";
            factor = 100;
        }
        else if ( n <= 999999) {
            label = "thousand";
            factor = 1000;
        }
        else if ( n <= 999999999) {
            label = "million";
            factor = 1000000;
        }
        else if ( n <= 999999999999L) {
            label = "billion";
            factor = 1000000000;
        }
        else if ( n <= 999999999999999L) {
            label = "trillion";
            factor = 1000000000000L;
        }
        else if ( n <= 999999999999999999L) {
            label = "quadrillion";
            factor = 1000000000000000L;
        }
        else {
            label = "quintillion";
            factor = 1000000000000000000L;
        }
        return numToStringHelper(n / factor) + " " + label + (n % factor > 0 ? " " + numToStringHelper(n % factor ) : "");
    }

}


STMFD sp!,{r0-r12,lr} ;push r0 thru r12 and the link register
LDMFD sp!,{r0-r12,pc} ;pop r0 thru r12, and the value that was in the link register is put into the program counter.
                      ;This acts as a pop and return command all-in-one. (Most programs use bx lr to return.)


Stack: $[]-> []

pushTo:     function [st val]-> 'st ++ val
popStack:   function [st]     [
    result: last st
    remove 'st .index (size st)-1
    return result
]
emptyStack: function [st]-> empty 'st
printStack: function [st]-> print st

st: new Stack

pushTo st "one"
pushTo st "two"
pushTo st "three"
printStack st

print popStack st
printStack st

emptyStack st
print ["finally:" st]


const irregular = Dict("one" => "first", "two" => "second", "three" => "third", "five" => "fifth",
                                "eight" => "eighth", "nine" => "ninth", "twelve" => "twelfth")
const suffix = "th"
const ysuffix = "ieth"

function numtext2ordinal(s)
    lastword = split(s)[end]
    redolast = split(lastword, "-")[end]
    if redolast != lastword
        lastsplit = "-"
        word = redolast
    else
        lastsplit = " "
        word = lastword
    end
    firstpart = reverse(split(reverse(s), lastsplit, limit=2)[end])
    firstpart = (firstpart == word) ? "": firstpart * lastsplit
    if haskey(irregular, word)
        word = irregular[word]
    elseif word[end] == 'y'
        word = word[1:end-1] * ysuffix
    else
        word = word * suffix
    end
    firstpart * word
end

const testcases =  [1  2  3  4  5  11  65  100  101  272  23456  8007006005004003]
for n in testcases
    println("$n => $(numtext2ordinal(num2text(n)))")
end


// version 1.1.4-3

typealias IAE = IllegalArgumentException

val names = mapOf(
    1 to "one",
    2 to "two",
    3 to "three",
    4 to "four",
    5 to "five",
    6 to "six",
    7 to "seven",
    8 to "eight",
    9 to "nine",
    10 to "ten",
    11 to "eleven",
    12 to "twelve",
    13 to "thirteen",
    14 to "fourteen",
    15 to "fifteen",
    16 to "sixteen",
    17 to "seventeen",
    18 to "eighteen",
    19 to "nineteen",
    20 to "twenty",
    30 to "thirty",
    40 to "forty",
    50 to "fifty",
    60 to "sixty",
    70 to "seventy",
    80 to "eighty",
    90 to "ninety"
)
val bigNames = mapOf(
    1_000L to "thousand",
    1_000_000L to "million",
    1_000_000_000L to "billion",
    1_000_000_000_000L to "trillion",
    1_000_000_000_000_000L to "quadrillion",
    1_000_000_000_000_000_000L to "quintillion"
)

val irregOrdinals = mapOf(
    "one" to "first",
    "two" to "second",
    "three" to "third",
    "five" to "fifth",
    "eight" to "eighth",
    "nine" to "ninth",
    "twelve" to "twelfth"
)

fun String.toOrdinal(): String {
    val splits = this.split(' ', '-')
    var last = splits[splits.lastIndex]
    return if (irregOrdinals.containsKey(last)) this.dropLast(last.length) + irregOrdinals[last]!!
           else if (last.endsWith("y")) this.dropLast(1) + "ieth"
           else this + "th"
}

fun numToOrdinalText(n: Long, uk: Boolean = false): String {
    if (n == 0L) return "zeroth"  // or alternatively 'zeroeth'
    val neg = n < 0L
    val maxNeg = n == Long.MIN_VALUE
    var nn = if (maxNeg) -(n + 1) else if (neg) -n else n
    val digits3 = IntArray(7)
    for (i in 0..6) {  // split number into groups of 3 digits from the right
        digits3[i] = (nn % 1000).toInt()
        nn /= 1000
    }

    fun threeDigitsToText(number: Int) : String {
        val sb = StringBuilder()
        if (number == 0) return ""
        val hundreds = number / 100
        val remainder = number % 100
        if (hundreds > 0) {
            sb.append(names[hundreds], " hundred")
            if (remainder > 0) sb.append(if (uk) " and " else " ")
        }
        if (remainder > 0) {
            val tens = remainder / 10
            val units = remainder % 10
            if (tens > 1) {
                sb.append(names[tens * 10])
                if (units > 0) sb.append("-", names[units])
            }
            else sb.append(names[remainder])
        }
        return sb.toString()
    }

    val strings = Array<String>(7) { threeDigitsToText(digits3[it]) }
    var text = strings[0]
    var andNeeded = uk && digits3[0] in 1..99
    var big = 1000L
    for (i in 1..6) {
        if (digits3[i] > 0) {
            var text2 = strings[i] + " " + bigNames[big]
            if (text.length > 0) {
                text2 += if (andNeeded) " and " else ", "
                andNeeded = false
            }
            else andNeeded = uk && digits3[i] in 1..99
            text = text2 + text
        }
        big *= 1000
    }
    if (maxNeg) text = text.dropLast(5) + "eight"
    if (neg) text = "minus " + text
    return text.toOrdinal()
}

fun numToOrdinalText(s: String, uk: Boolean = false): String {
    val d = s.toDoubleOrNull() ?: throw IAE("String is not numeric")
    if (d !in Long.MIN_VALUE.toDouble() .. Long.MAX_VALUE.toDouble())
        throw IAE("Double is outside the range of a Long Integer")
    val n = d.toLong()
    if (n.toDouble() != d) throw IAE("String does not represent a Long Integer")
    return numToOrdinalText(n, uk)
}

fun main(args: Array<String>) {
    val la = longArrayOf(1, 2, 3, 4, 5, 11, 65, 100, 101, 272, 23456, 8007006005004003)
    println("Using US representation:")
    for (i in la) println("${"%16d".format(i)} = ${numToOrdinalText(i)}")
    val sa = arrayOf("123", "00123.0", "1.23e2")
    for (s in sa) println("${"%16s".format(s)} = ${numToOrdinalText(s)}")
}


(* Stacks implemented as linked lists. *)

(* A nonlinear stack type of size n, which is good for when you are
   using a garbage collector or can let the memory leak. *)
typedef stack_t (t : [email protected]+, n : int) = list (t, n)
typedef stack_t (t : [email protected]+) = [n : int] stack_t (t, n)

(* A linear stack type of size n, which requires (and will enforce)
   explicit freeing. (Note that a "peek" function for a linear stack
   is a complicated topic. But the task avoids this issue.) *)
viewtypedef stack_vt (vt : [email protected]+, n : int) = list_vt (vt, n)
viewtypedef stack_vt (vt : [email protected]+) = [n : int] stack_vt (vt, n)

(* Proof that a given nonlinear stack does not have a nonnegative
   size. *)
prfn
lemma_stack_t_param {n : int} {t : [email protected]}
                    (stack : stack_t (t, n)) :<prf>
    [0 <= n] void =
  lemma_list_param stack

(* Proof that a given linear stack does not have a nonnegative
   size. *)
prfn
lemma_stack_vt_param {n : int} {vt : [email protected]}
                     (stack : !stack_vt (vt, n)) :<prf>
    [0 <= n] void =
  lemma_list_vt_param stack

(* Create an empty nonlinear stack. *)
fn {}
stack_t_nil {t : [email protected]} () :<> stack_t (t, 0) =
  list_nil ()

(* Create an empty linear stack. *)
fn {}
stack_vt_nil {vt : [email protected]} () :<> stack_vt (vt, 0) =
  list_vt_nil ()

(* Is a nonlinear stack empty? *)
fn {}
stack_t_is_empty {n : int} {t : [email protected]}
                 (stack : stack_t (t, n)) :<>
    [empty : bool | empty == (n == 0)]
    bool empty =
  case+ stack of
  | list_nil _ => true
  | list_cons _ => false

(* Is a linear stack empty? *)
fn {}
stack_vt_is_empty {n : int} {vt : [email protected]}
                  (* ! = pass by value; stack is preserved. *)
                  (stack : !stack_vt (vt, n)) :<>
    [empty : bool | empty == (n == 0)]
    bool empty =
  case+ stack of
  | list_vt_nil _ => true
  | list_vt_cons _ => false

(* Push to a nonlinear stack that is stored in a variable. *)
fn {t : [email protected]}
stack_t_push {n : int}
             (stack : &stack_t (t, n) >> stack_t (t, m),
              x     : t) :<!wrt>
    (* It is proved that the stack is raised one higher. *)
    #[m : int | 1 <= m; m == n + 1]
    void =
  let
    prval _ = lemma_stack_t_param stack
    prval _ = prop_verify {0 <= n} ()
  in
    stack := list_cons (x, stack)
  end

(* Push to a linear stack that is stored in a variable. Beware: if x
   is linear, it is consumed. *)
fn {vt : [email protected]}
stack_vt_push {n : int}
              (stack : &stack_vt (vt, n) >> stack_vt (vt, m),
               x     : vt) :<!wrt>
    (* It is proved that the stack is raised one higher. *)
    #[m : int | 1 <= m; m == n + 1]
    void =
  let
    prval _ = lemma_stack_vt_param stack
    prval _ = prop_verify {0 <= n} ()
  in
    stack := list_vt_cons (x, stack)
  end

(* Pop from a nonlinear stack that is stored in a variable. It is
   impossible (unless you cheat the typechecker) to pop from an empty
   stack. *)
fn {t : [email protected]}
stack_t_pop {n : int | 1 <= n}
            (stack : &stack_t (t, n) >> stack_t (t, m)) :<!wrt>
    (* It is proved that the stack is lowered by one. *)
    #[m : int | m == n - 1]
    t =
  case+ stack of
  | list_cons (x, tail) =>
    begin
      stack := tail;
      x
    end

(* Pop from a linear stack that is stored in a variable. It is
   impossible (unless you cheat the typechecker) to pop from an empty
   stack. *)
fn {vt : [email protected]}
stack_vt_pop {n : int | 1 <= n}
             (stack : &stack_vt (vt, n) >> stack_vt (vt, m)) :<!wrt>
    (* It is proved that the stack is lowered by one. *)
    #[m : int | m == n - 1]
    vt =
  case+ stack of
  | ~ list_vt_cons (x, tail) => (* ~ = the top node is consumed. *)
    begin
      stack := tail;
      x
    end

(* A linear stack has to be consumed. *)
extern fun {vt : [email protected]}
stack_vt_free$element_free (x : vt) :<> void
fn {vt : [email protected]}
stack_vt_free {n : int}
              (stack : stack_vt (vt, n)) :<> void =
  let
    fun
    loop {m : int | 0 <= m}
         .<m>. (* <-- proof of loop termination *)
         (stk : stack_vt (vt, m)) :<> void =
      case+ stk of
      | ~ list_vt_nil () => begin end
      | ~ list_vt_cons (x, tail) =>
        begin
          stack_vt_free$element_free x;
          loop tail
        end

    prval _ = lemma_stack_vt_param stack
  in
    loop stack
  end

implement
main0 () =
  let
    var nonlinear_stack : stack_t (int) = stack_t_nil ()
    var linear_stack : stack_vt (int) = stack_vt_nil ()
    implement stack_vt_free$element_free<int> x = begin end

    overload is_empty with stack_t_is_empty
    overload is_empty with stack_vt_is_empty

    overload push with stack_t_push
    overload push with stack_vt_push

    overload pop with stack_t_pop
    overload pop with stack_vt_pop
  in
    println! ("nonlinear_stack is empty? ", is_empty nonlinear_stack);
    println! ("linear_stack is empty? ", is_empty linear_stack);

    println! ("pushing 3, 2, 1...");
    push (nonlinear_stack, 3);
    push (nonlinear_stack, 2);
    push (nonlinear_stack, 1);
    push (linear_stack, 3);
    push (linear_stack, 2);
    push (linear_stack, 1);

    println! ("nonlinear_stack is empty? ", is_empty nonlinear_stack);
    println! ("linear_stack is empty? ", is_empty linear_stack);

    println! ("popping nonlinear_stack: ", (pop nonlinear_stack) : int);
    println! ("popping nonlinear_stack: ", (pop nonlinear_stack) : int);
    println! ("popping nonlinear_stack: ", (pop nonlinear_stack) : int);

    println! ("popping linear_stack: ", (pop linear_stack) : int);
    println! ("popping linear_stack: ", (pop linear_stack) : int);
    println! ("popping linear_stack: ", (pop linear_stack) : int);

    println! ("nonlinear_stack is empty? ", is_empty nonlinear_stack);
    println! ("linear_stack is empty? ", is_empty linear_stack);

    stack_vt_free<int> linear_stack
  end


msgbox % stack("push", 4)
msgbox % stack("push", 5)
msgbox % stack("peek")
msgbox % stack("pop")
msgbox % stack("peek")
msgbox % stack("empty")
msgbox % stack("pop")
msgbox % stack("empty")
return

stack(command, value = 0)
{
  static
if !pointer
pointer = 10000
  if (command = "push")
  {
  _p%pointer% := value
  pointer -= 1
  return value
  }
  if (command = "pop")
  {
    pointer += 1
    return _p%pointer%
  }
  if (command = "peek")
{
next := pointer + 1
return _p%next%
}
  if (command = "empty")
  {
   if (pointer == 10000)
    return "empty"
else
return 0
  }
}


import strutils, algorithm, tables

const irregularOrdinals = {"one":    "first",
                           "two":    "second",
                           "three":  "third",
                           "five":   "fifth",
                           "eight":  "eighth",
                           "nine":   "ninth",
                           "twelve": "twelfth"}.toTable

const
  tens = ["", "", "twenty", "thirty", "forty", "fifty", "sixty", "seventy",
          "eighty", "ninety"]
  small = ["zero", "one", "two", "three", "four", "five", "six", "seven",
           "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen",
           "fifteen", "sixteen", "seventeen", "eighteen", "nineteen"]
  huge = ["", "", "million", "billion", "trillion", "quadrillion",
          "quintillion", "sextillion", "septillion", "octillion", "nonillion",
          "decillion"]

# Forward reference.
proc spellInteger(n: int64): string

proc nonzero(c: string; n: int64; connect = ""): string =
  if n == 0: "" else: connect & c & spellInteger(n)

proc lastAnd(num: string): string =
  if ',' in num:
    let pos =  num.rfind(',')
    var (pre, last) = if pos >= 0: (num[0 ..< pos], num[pos+1 .. num.high])
                      else: ("", num)
    if " and " notin last: last = " and" & last
    result = [pre, ",", last].join()
  else:
    result = num

proc big(e, n: int64): string =
  if e == 0:
    spellInteger(n)
  elif e == 1:
    spellInteger(n) & " thousand"
  else:
    spellInteger(n) & " " & huge[e]

iterator base1000Rev(n: int64): int64 =
  var n = n
  while n != 0:
    let r = n mod 1000
    n = n div 1000
    yield r

proc spellInteger(n: int64): string =
  if n < 0:
    "minus " & spellInteger(-n)
  elif n < 20:
    small[int(n)]
  elif n < 100:
    let a = n div 10
    let b = n mod 10
    tens[int(a)] & nonzero("-", b)
  elif n < 1000:
    let a = n div 100
    let b = n mod 100
    small[int(a)] & " hundred" & nonzero(" ", b, " and")
  else:
    var sq = newSeq[string]()
    var e = 0
    for x in base1000Rev(n):
      if x > 0: sq.add big(e, x)
      inc e
    reverse sq
    lastAnd(sq.join(", "))

proc num2ordinal(n: SomeInteger|SomeFloat): string =

  let n = n.int64

  var num = spellInteger(n)
  let hyphen = num.rsplit('-', 1)
  var number = num.rsplit(' ', 1)
  var delim = ' '
  if number[^1].len > hyphen[^1].len:
    number = hyphen
    delim = '-'

  if number[^1] in irregularOrdinals:
    number[^1] = delim & irregularOrdinals[number[^1]]
  elif number[^1].endswith('y'):
    number[^1] = delim & number[^1][0..^2] & "ieth"
  else:
    number[^1] = delim & number[^1] & "th"

  result = number.join()

when isMainModule:

  const
    tests1 = [int64 1, 2, 3, 4, 5, 11, 65, 100, 101, 272, 23456, 8007006005004003, 123]
    tests2 = [0123.0, 1.23e2]

  for num in tests1:
    echo "$1 => $2".format(num, num2ordinal(num))
  for num in tests2:
    echo  "$1 => $2".format(num, num2ordinal(num))


test_ordinal(Number):-
    number_name(Number, ordinal, Name),
    writef('%w: %w\n', [Number, Name]).

main:-
    test_ordinal(1),
    test_ordinal(2),
    test_ordinal(3),
    test_ordinal(4),
    test_ordinal(5),
    test_ordinal(11),
    test_ordinal(15),
    test_ordinal(21),
    test_ordinal(42),
    test_ordinal(65),
    test_ordinal(98),
    test_ordinal(100),
    test_ordinal(101),
    test_ordinal(272),
    test_ordinal(300),
    test_ordinal(750),
    test_ordinal(23456),
    test_ordinal(7891233),
    test_ordinal(8007006005004003).


function deque(arr) {
    arr["start"] = 0
    arr["end"] = 0
}

function dequelen(arr) {
    return arr["end"] - arr["start"]
}

function empty(arr) {
    return dequelen(arr) == 0
}

function push(arr, elem) {
    arr[++arr["end"]] = elem
}

function pop(arr) {
    if (empty(arr)) {
        return
    }
    return arr[arr["end"]--]
}

function unshift(arr, elem) {
    arr[arr["start"]--] = elem
}

function shift(arr) {
    if (empty(arr)) {
        return
    }
    return arr[++arr["start"]]
}

function peek(arr) {
    if (empty(arr)) {
        return
    }
    return arr[arr["end"]]
}

function printdeque(arr,    i, sep) {
    printf("[")
    for (i = arr["start"] + 1; i <= arr["end"]; i++) {
        printf("%s%s", sep, arr[i])
        sep = ", "
    }
    printf("]\n")
}

BEGIN {
    deque(q)
    for (i = 1; i <= 10; i++) {
        push(q, i)
    }
    printdeque(q)
    for (i = 1; i <= 10; i++) {
        print pop(q)
    }
    printdeque(q)
}


irregularOrdinals = {
	"one":    "first",
	"two":    "second",
	"three":  "third",
	"five":   "fifth",
	"eight":  "eighth",
	"nine":   "ninth",
	"twelve": "twelfth",
}

def num2ordinal(n):
    conversion = int(float(n))
    num = spell_integer(conversion)
    hyphen = num.rsplit("-", 1)
    num = num.rsplit(" ", 1)
    delim = " "
    if len(num[-1]) > len(hyphen[-1]):
        num = hyphen
        delim = "-"

    if num[-1] in irregularOrdinals:
        num[-1] = delim + irregularOrdinals[num[-1]]
    elif num[-1].endswith("y"):
        num[-1] = delim + num[-1][:-1] + "ieth"
    else:
        num[-1] = delim + num[-1] + "th"
    return "".join(num)

if __name__ == "__main__":
    tests = "1  2  3  4  5  11  65  100  101  272  23456  8007006005004003 123   00123.0   1.23e2".split()
    for num in tests:
        print("{} => {}".format(num, num2ordinal(num)))

#This is a copy of the code from https://rosettacode.org/wiki/Number_names#Python

TENS = [None, None, "twenty", "thirty", "forty",
        "fifty", "sixty", "seventy", "eighty", "ninety"]
SMALL = ["zero", "one", "two", "three", "four", "five",
         "six", "seven", "eight", "nine", "ten", "eleven",
         "twelve", "thirteen", "fourteen", "fifteen",
         "sixteen", "seventeen", "eighteen", "nineteen"]
HUGE = [None, None] + [h + "illion"
                       for h in ("m", "b", "tr", "quadr", "quint", "sext",
                                  "sept", "oct", "non", "dec")]

def nonzero(c, n, connect=''):
    return "" if n == 0 else connect + c + spell_integer(n)

def last_and(num):
    if ',' in num:
        pre, last = num.rsplit(',', 1)
        if ' and ' not in last:
            last = ' and' + last
        num = ''.join([pre, ',', last])
    return num

def big(e, n):
    if e == 0:
        return spell_integer(n)
    elif e == 1:
        return spell_integer(n) + " thousand"
    else:
        return spell_integer(n) + " " + HUGE[e]

def base1000_rev(n):
    # generates the value of the digits of n in base 1000
    # (i.e. 3-digit chunks), in reverse.
    while n != 0:
        n, r = divmod(n, 1000)
        yield r

def spell_integer(n):
    if n < 0:
        return "minus " + spell_integer(-n)
    elif n < 20:
        return SMALL[n]
    elif n < 100:
        a, b = divmod(n, 10)
        return TENS[a] + nonzero("-", b)
    elif n < 1000:
        a, b = divmod(n, 100)
        return SMALL[a] + " hundred" + nonzero(" ", b, ' and')
    else:
        num = ", ".join([big(e, x) for e, x in
                         enumerate(base1000_rev(n)) if x][::-1])
        return last_and(num)


F spiral_matrix(n)
   V m = [[0] * n] *n
   V d = [(0, 1), (1, 0), (0, -1), (-1, 0)]
   V xy = (0, -1)
   V c = 0
   L(i) 0 .< n + n - 1
      L 0 .< (n + n - i) I/ 2
         xy += d[i % 4]
         m[xy.x][xy.y] = c
         c++
   R m

F printspiral(myarray)
   L(y) 0 .< myarray.len
      L(x) 0 .< myarray.len
         print(‘#2’.format(myarray[y][x]), end' ‘ ’)
      print()

printspiral(spiral_matrix(5))


0→S
Lbl PUSH
r₁→{L₁+S}ʳ
S+2→S
Return

Lbl POP
S-2→S
{L₁+S}ʳ
Return

Lbl EMPTY
S≤≤0
Return


main :
    { (1 2 3) foo set     -- foo = (1 2 3)
    4 foo push            -- foo = (1 2 3 4)
    0 foo unshift         -- foo = (0 1 2 3 4)
    foo pop               -- foo = (0 1 2 3)
    foo shift             -- foo = (1 2 3)
    check_foo
    { foo pop } 4 times   -- Pops too many times, but this is OK and Babel won't complain
    check_foo }

empty? : nil?   -- just aliases 'empty?' to the built-in operator 'nil?'

check_foo! :
    { "foo is "
    {foo empty?) {nil} {"not " .} ifte
    "empty" .
    cr << }


use Lingua::EN::Numbers;

# The task
+$_ ?? printf( "Type: \%-14s %16s : %s\n", .^name, $_, .&ordinal ) !! say "\n$_:" for

# Testing
'Required tests',
1, 2, 3, 4, 5, 11, 65, 100, 101, 272, 23456, 8007006005004003,

'Optional tests - different forms of 123',
'Numerics',
123, 00123.0, 1.23e2, 123+0i,

'Allomorphs',
|<123 1_2_3 00123.0 1.23e2 123+0i 0b1111011 0o173 0x7B 861/7>,

'Numeric Strings',
|'1_2_3 00123.0 1.23e2 123+0i 0b1111011 0o173 0x7B 861/7'.words,

'Unicode Numeric Strings',
# (Only using groups of digits from the same Unicode block. Technically,
# digits from any block could be combined with digits from any other block.)
|(^0x1FFFF).grep( { .chr ~~ /<:Nd>/ and .unival == 1|2|3 }).rotor(3)».chr».join,

'Role Mixin',
'17' but 123;


/*REXX programs spells out  ordinal numbers  (in English, using the American system).   */
numeric digits 3000                              /*just in case the user uses gihugic #s*/
parse arg n                                      /*obtain optional arguments from the CL*/

if n='' | n=","  then n= 1  2  3  4  5  11  65  100  101  272  23456  8007006005004003

pgmOpts= 'ordinal  quiet'                        /*define options needed for $SPELL#.REX*/

     do j=1  for words(n)                        /*process each of the specified numbers*/
     x=word(n, j)                                /*obtain a number from the input list. */
     os=$spell#(x  pgmOpts)                      /*invoke REXX routine to spell ordinal#*/
     say right(x, max(20, length(x) ) )      ' spelled ordinal number ───► '      os
     end   /*j*/


struct NumberNames {
    cardinal: &'static str,
    ordinal: &'static str,
}

impl NumberNames {
    fn get_name(&self, ordinal: bool) -> &'static str {
        if ordinal {
            return self.ordinal;
        }
        self.cardinal
    }
}

const SMALL_NAMES: [NumberNames; 20] = [
    NumberNames {
        cardinal: "zero",
        ordinal: "zeroth",
    },
    NumberNames {
        cardinal: "one",
        ordinal: "first",
    },
    NumberNames {
        cardinal: "two",
        ordinal: "second",
    },
    NumberNames {
        cardinal: "three",
        ordinal: "third",
    },
    NumberNames {
        cardinal: "four",
        ordinal: "fourth",
    },
    NumberNames {
        cardinal: "five",
        ordinal: "fifth",
    },
    NumberNames {
        cardinal: "six",
        ordinal: "sixth",
    },
    NumberNames {
        cardinal: "seven",
        ordinal: "seventh",
    },
    NumberNames {
        cardinal: "eight",
        ordinal: "eighth",
    },
    NumberNames {
        cardinal: "nine",
        ordinal: "ninth",
    },
    NumberNames {
        cardinal: "ten",
        ordinal: "tenth",
    },
    NumberNames {
        cardinal: "eleven",
        ordinal: "eleventh",
    },
    NumberNames {
        cardinal: "twelve",
        ordinal: "twelfth",
    },
    NumberNames {
        cardinal: "thirteen",
        ordinal: "thirteenth",
    },
    NumberNames {
        cardinal: "fourteen",
        ordinal: "fourteenth",
    },
    NumberNames {
        cardinal: "fifteen",
        ordinal: "fifteenth",
    },
    NumberNames {
        cardinal: "sixteen",
        ordinal: "sixteenth",
    },
    NumberNames {
        cardinal: "seventeen",
        ordinal: "seventeenth",
    },
    NumberNames {
        cardinal: "eighteen",
        ordinal: "eighteenth",
    },
    NumberNames {
        cardinal: "nineteen",
        ordinal: "nineteenth",
    },
];

const TENS: [NumberNames; 8] = [
    NumberNames {
        cardinal: "twenty",
        ordinal: "twentieth",
    },
    NumberNames {
        cardinal: "thirty",
        ordinal: "thirtieth",
    },
    NumberNames {
        cardinal: "forty",
        ordinal: "fortieth",
    },
    NumberNames {
        cardinal: "fifty",
        ordinal: "fiftieth",
    },
    NumberNames {
        cardinal: "sixty",
        ordinal: "sixtieth",
    },
    NumberNames {
        cardinal: "seventy",
        ordinal: "seventieth",
    },
    NumberNames {
        cardinal: "eighty",
        ordinal: "eightieth",
    },
    NumberNames {
        cardinal: "ninety",
        ordinal: "ninetieth",
    },
];

struct NamedNumber {
    cardinal: &'static str,
    ordinal: &'static str,
    number: usize,
}

impl NamedNumber {
    fn get_name(&self, ordinal: bool) -> &'static str {
        if ordinal {
            return self.ordinal;
        }
        self.cardinal
    }
}

const N: usize = 7;
const NAMED_NUMBERS: [NamedNumber; N] = [
    NamedNumber {
        cardinal: "hundred",
        ordinal: "hundredth",
        number: 100,
    },
    NamedNumber {
        cardinal: "thousand",
        ordinal: "thousandth",
        number: 1000,
    },
    NamedNumber {
        cardinal: "million",
        ordinal: "millionth",
        number: 1000000,
    },
    NamedNumber {
        cardinal: "billion",
        ordinal: "billionth",
        number: 1000000000,
    },
    NamedNumber {
        cardinal: "trillion",
        ordinal: "trillionth",
        number: 1000000000000,
    },
    NamedNumber {
        cardinal: "quadrillion",
        ordinal: "quadrillionth",
        number: 1000000000000000,
    },
    NamedNumber {
        cardinal: "quintillion",
        ordinal: "quintillionth",
        number: 1000000000000000000,
    },
];

fn big_name(n: usize) -> &'static NamedNumber {
    for i in 1..N {
        if n < NAMED_NUMBERS[i].number {
            return &NAMED_NUMBERS[i - 1];
        }
    }
    &NAMED_NUMBERS[N - 1]
}

fn number_name(n: usize, ordinal: bool) -> String {
    if n < 20 {
        return String::from(SMALL_NAMES[n].get_name(ordinal));
    } else if n < 100 {
        if n % 10 == 0 {
            return String::from(TENS[n / 10 - 2].get_name(ordinal));
        }
        let s1 = TENS[n / 10 - 2].get_name(false);
        let s2 = SMALL_NAMES[n % 10].get_name(ordinal);
        return format!("{}-{}", s1, s2);
    }
    let big = big_name(n);
    let mut result = number_name(n / big.number, false);
    result.push(' ');
    if n % big.number == 0 {
        result.push_str(big.get_name(ordinal));
    } else {
        result.push_str(big.get_name(false));
        result.push(' ');
        result.push_str(&number_name(n % big.number, ordinal));
    }
    result
}

fn test_ordinal(n: usize) {
    println!("{}: {}", n, number_name(n, true));
}

fn main() {
    test_ordinal(1);
    test_ordinal(2);
    test_ordinal(3);
    test_ordinal(4);
    test_ordinal(5);
    test_ordinal(11);
    test_ordinal(15);
    test_ordinal(21);
    test_ordinal(42);
    test_ordinal(65);
    test_ordinal(98);
    test_ordinal(100);
    test_ordinal(101);
    test_ordinal(272);
    test_ordinal(300);
    test_ordinal(750);
    test_ordinal(23456);
    test_ordinal(7891233);
    test_ordinal(8007006005004003);
}


SPIRALM  CSECT
         USING  SPIRALM,R13
SAVEAREA B      STM-SAVEAREA(R15)
         DC     17F'0'
         DC     CL8'SPIRALM'
STM      STM    R14,R12,12(R13)
         ST     R13,4(R15)
         ST     R15,8(R13)
         LR     R13,R15
*        ----   CODE
         LA     R0,0
         LA     R1,1
         LH     R12,N           n
         LR     R4,R1           Row=1
         LR     R5,R1           Col=1
         LR     R6,R1           BotRow=1
         LR     R7,R1           BotCol=1
         LR     R8,R12          TopRow=n
         LR     R9,R12          TopCol=n
         LR     R10,R0          Dir=0
         LR     R15,R12         n
         MR     R14,R12         R15=n*n
         LA     R11,1           k=1
LOOP     CR     R11,R15
         BH     ENDLOOP
         LR     R1,R4
         BCTR   R1,0
         MH     R1,N
         AR     R1,R5
         LR     R2,R11          k
         BCTR   R2,0
         BCTR   R1,0
         SLA    R1,1
         STH    R2,MATRIX(R1)   Matrix(Row,Col)=k-1
         CH     R10,=H'0'
         BE     DIR0
         CH     R10,=H'1'
         BE     DIR1
         CH     R10,=H'2'
         BE     DIR2
         CH     R10,=H'3'
         BE     DIR3
         B      DIRX
DIR0     CR     R5,R9           if Col<TopCol
         BNL    DIR0S
         LA     R5,1(R5)        Col=Col+1
         B      DIRX
DIR0S    LA     R10,1           Dir=1
         LA     R4,1(R4)        Row=Row+1
         LA     R6,1(R6)        BotRow=BotRow+1
         B      DIRX
DIR1     CR     R4,R8           if Row<TopRow
         BNL    DIR1S
         LA     R4,1(R4)        Row=Row+1
         B      DIRX
DIR1S    LA     R10,2           Dir=2
         BCTR   R5,0            Col=Col-1
         BCTR   R9,0            TopCol=TopCol-1
         B      DIRX
DIR2     CR     R5,R7           if Col>BotCol
         BNH    DIR2S
         BCTR   R5,0            Col=Col-1
         B      DIRX
DIR2S    LA     R10,3           Dir=3
         BCTR   R4,0            Row=Row-1
         BCTR   R8,0            TopRow=TopRow-1
         B      DIRX
DIR3     CR     R4,R6           if Row>BotRow
         BNH    DIR3S
         BCTR   R4,0            Row=Row-1
         B      DIRX
DIR3S    LA     R10,0           Dir=0
         LA     R5,1(R5)        Col=Col+1
         LA     R7,1(R7)        BotCol=BotCol+1
DIRX     EQU    *
         LA     R11,1(R11)      k=k+1
         B      LOOP
ENDLOOP  EQU    *
         LA     R4,1            i
LOOPI    CR     R4,R12
         BH     ENDLOOPI
         XR     R10,R10
         LA     R5,1            j
LOOPJ    CR     R5,R12
         BH     ENDLOOPJ
         LR     R1,R4
         BCTR   R1,0
         MH     R1,N
         AR     R1,R5
         BCTR   R1,0
         SLA    R1,1
         LH     R2,MATRIX(R1)   Matrix(i,j)
         LA     R3,BUF
         AR     R3,R10
         CVD    R2,P8
         MVC    0(4,R3),=X'40202120'
         ED     0(4,R3),P8+6
         LA     R10,4(R10)
         LA     R5,1(R5)
         B      LOOPJ
ENDLOOPJ EQU    *
         WTO    MF=(E,WTOMSG)
         LA     R4,1(R4)
         B      LOOPI
ENDLOOPI EQU    *
*        ----   END CODE
         L      R13,4(0,R13)
         LM     R14,R12,12(R13)
         XR     R15,R15
         BR     R14
*        ----   DATA
N        DC     H'5'            max=20 (20*4=80)
         LTORG
P8       DS     PL8
WTOMSG   DS     0F
         DC     H'80',XL2'0000'
BUF      DC     CL80' '
MATRIX   DS     H               Matrix(n,n)
         YREGS
         END    SPIRALM


REPORT zspiral_matrix.

CLASS lcl_spiral_matrix DEFINITION FINAL.
  PUBLIC SECTION.

    TYPES:
      BEGIN OF ty_coordinates,
        dy    TYPE i,
        dx    TYPE i,
        value TYPE i,
      END OF ty_coordinates,
      ty_t_coordinates TYPE STANDARD TABLE OF ty_coordinates WITH EMPTY KEY.

    DATA mv_dimention TYPE i.
    DATA mv_initial_value TYPE i.

    METHODS:
      constructor IMPORTING iv_dimention     TYPE i
                            iv_initial_value TYPE i,

      get_coordinates RETURNING VALUE(rv_result) TYPE ty_t_coordinates,

      print.

  PRIVATE SECTION.
    DATA lt_coordinates TYPE ty_t_coordinates.

    METHODS create RETURNING VALUE(ro_result) TYPE REF TO lcl_spiral_matrix.

ENDCLASS.

CLASS lcl_spiral_matrix IMPLEMENTATION.
  METHOD constructor.

    mv_dimention = iv_dimention.
    mv_initial_value = iv_initial_value.

    create( ).

  ENDMETHOD.

  METHOD create.

    DATA dy TYPE i.
    DATA dx TYPE i.
    DATA value TYPE i.
    DATA seq_number TYPE i.
    DATA seq_dimention TYPE i.
    DATA sign_coef TYPE i VALUE -1.

    value = mv_initial_value.

    " Fill in the first row (index 0)
    DO mv_dimention TIMES.
      APPEND VALUE #( dy = dy dx = dx value = value ) TO lt_coordinates.
      value = value + 1.
      dx = dx + 1.
    ENDDO.

    seq_dimention = mv_dimention.

    " Find the row and column numbers and set the values.
    DO ( 2 * mv_dimention - 2 ) / 2 TIMES.
      sign_coef = - sign_coef.
      seq_dimention = seq_dimention - 1.

      DO 2 TIMES.
        seq_number = seq_number + 1.

        DO seq_dimention TIMES.

          IF seq_number MOD 2 <> 0.
            dy = dy + 1 * sign_coef.
          ELSE.
            dx = dx - 1 * sign_coef.
          ENDIF.

          APPEND VALUE #( dy = dy dx = dx value = value ) TO lt_coordinates.
          value = value + 1.
        ENDDO.

      ENDDO.

    ENDDO.

    ro_result = me.

  ENDMETHOD.

  METHOD get_coordinates.
    rv_result = lt_coordinates.
  ENDMETHOD.

  METHOD print.

    DATA cnt TYPE i.
    DATA line TYPE string.

    SORT lt_coordinates BY dy dx ASCENDING.

    LOOP AT lt_coordinates ASSIGNING FIELD-SYMBOL(<ls_coordinates>).

      cnt = cnt + 1.
      line = |{ line } { <ls_coordinates>-value }|.

      IF cnt MOD mv_dimention = 0.
        WRITE / line.
        CLEAR line.
      ENDIF.

    ENDLOOP.

  ENDMETHOD.

ENDCLASS.

START-OF-SELECTION.

  DATA(go_spiral_matrix) = NEW lcl_spiral_matrix( iv_dimention     = 5
                                                  iv_initial_value = 0 ).
  go_spiral_matrix->print( ).


@echo off
setlocal enableDelayedExpansion

:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: LIFO stack usage

:: Define the stack
call :newStack myStack

:: Push some values onto the stack
for %%A in (value1 value2 value3) do call :pushStack myStack %%A

:: Test if stack is empty by examining the top "attribute"
if myStack.top==0 (echo myStack is empty) else (echo myStack is NOT empty)

:: Peek at the top stack value
call:peekStack myStack val && echo a peek at the top of myStack shows !val!

:: Pop the top stack value
call :popStack myStack val && echo popped myStack value=!val!

:: Push some more values onto the stack
for %%A in (value4 value5 value6) do call :pushStack myStack %%A

:: Process the remainder of the stack
:processStack
call :popStack myStack val || goto :stackEmpty
echo popped myStack value=!val!
goto :processStack
:stackEmpty

:: Test if stack is empty using the empty "method"/"macro". Use of the
:: second IF statement serves to demonstrate the negation of the empty
:: "method". A single IF could have been used with an ELSE clause instead.
if %myStack.empty% echo myStack is empty
if not %myStack.empty% echo myStack is NOT empty
exit /b

:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: LIFO stack definition

:newStack stackName
set /a %~1.top=0
:: Define an empty "method" for this stack as a sort of macro
set "%~1.empty=^!%~1.top^! == 0"
exit /b

:pushStack stackName value
set /a %~1.top+=1
set %~1.!%~1.top!=%2
exit /b

:popStack stackName returnVar
:: Sets errorlevel to 0 if success
:: Sets errorlevel to 1 if failure because stack was empty
if !%~1.top! equ 0 exit /b 1
for %%N in (!%~1.top!) do (
  set %~2=!%~1.%%N!
  set %~1.%%N=
)
set /a %~1.top-=1
exit /b 0

:peekStack stackName returnVar
:: Sets errorlevel to 0 if success
:: Sets errorlevel to 1 if failure because stack was empty
if !%~1.top! equ 0 exit /b 1
for %%N in (!%~1.top!) do set %~2=!%~1.%%N!
exit /b 0