V phrase = ‘rosetta code phrase reversal’
print(reversed(phrase))
print(phrase.split(‘ ’).map(word -> reversed(word)).join(‘ ’))
print(reversed(phrase.split(‘ ’)).join(‘ ’))


PROC ReversePart(CHAR ARRAY src,dst BYTE start,len)
  BYTE i

  FOR i=0 TO len-1
  DO
    dst(start+len-i-1)=src(start+i)
  OD
RETURN

PROC ReverseString(CHAR ARRAY src,dst)
  BYTE i

  dst(0)=src(0)
  ReversePart(src,dst,1,src(0))
RETURN

PROC ReverseInWords(CHAR ARRAY src,dst)
  BYTE i,start

  dst(0)=src(0)
  i=1
  WHILE i<=src(0)
  DO
    IF src(i)=32 THEN
      dst(i)=32 i==+1
    ELSE
      start=i
      WHILE i<=src(0) AND src(i)#32
      DO i==+1 OD
      ReversePart(src,dst,start,i-start)
    FI
  OD
RETURN

PROC ReverseWords(CHAR ARRAY src,dst)
  CHAR ARRAY tmp(100)

  ReverseString(src,tmp)
  ReverseInWords(tmp,dst)
RETURN

PROC Main()
  CHAR ARRAY s="rosetta code phrase reversal",rev(100)

  PrintE(s)
  ReverseString(s,rev)
  PrintE(rev)
  ReverseInWords(s,rev)
  PrintE(rev)
  ReverseWords(s,rev)
  PrintE(rev)
RETURN


<with Ada.Text_IO, Simple_Parse;

procedure Phrase_Reversal is

   function Reverse_String (Item : String) return String is
      Result : String (Item'Range);
   begin
      for I in Item'range loop
         Result (Result'Last - I + Item'First) := Item (I);
      end loop;
      return Result;
   end Reverse_String;

   function Reverse_Words(S: String) return String is
      Cursor: Positive := S'First;
      Word: String := Simple_Parse.Next_Word(S, Cursor);
   begin
      if Cursor > S'Last then -- Word holds the last word
	 return Reverse_String(Word);
      else
	 return Reverse_String(Word) & " " & Reverse_Words(S(Cursor .. S'Last));
      end if;
   end Reverse_Words;

   function Reverse_Order(S: String) return String is
      Cursor: Positive := S'First;
      Word: String := Simple_Parse.Next_Word(S, Cursor);
   begin
      if Cursor > S'Last then -- Word holds the last word
	 return Word;
      else
	 return Reverse_Order(S(Cursor .. S'Last)) & " " & Word;
      end if;
   end Reverse_Order;

   Phrase: String := "rosetta code phrase reversal";
   use Ada.Text_IO;
begin
   Put_Line("0. The original phrase:       """ & Phrase & """");
   Put_Line("1. Reverse the entire phrase: """ & Reverse_String(Phrase) & """");
   Put_Line("2. Reverse words, same order: """ & Reverse_Words(Phrase) & """");
   Put_Line("2. Reverse order, same words: """ & Reverse_Order(Phrase) & """");
end Phrase_Reversal;


# reverses the characters in str from start pos to end pos                   #
PROC in place reverse = ( REF STRING str, INT start pos, INT end pos )VOID:
    BEGIN
        INT fpos := start pos, epos := end pos;
        WHILE fpos < epos
        DO
            CHAR c      := str[ fpos ];
            str[ fpos ] := str[ epos ];
            str[ epos ] := c;
            fpos       +:= 1;
            epos       -:= 1
        OD
    END; # in place reverse #

STRING original phrase := "rosetta code phrase reversal";

STRING whole reversed  := original phrase;
in place reverse( whole reversed, LWB whole reversed, UPB whole reversed );

# reverse the individual words #
STRING words reversed := original phrase;
INT start pos         := LWB words reversed;

WHILE
    # skip leading spaces #
    WHILE IF start pos <= UPB words reversed
          THEN words reversed[ start pos ] = " "
          ELSE FALSE
          FI
    DO start pos +:= 1
    OD;
    start pos <= UPB words reversed
DO
    # have another word, find it #
    INT end pos := start pos;
    WHILE IF end pos <= UPB words reversed
          THEN words reversed[ end pos ] /= " "
          ELSE FALSE
          FI
    DO end pos +:= 1
    OD;
    in place reverse( words reversed, start pos, end pos - 1 );
    start pos := end pos + 1
OD;

# reversing the reversed words in the same order as the original will        #
# reverse the order of the words                                             #
STRING order reversed := words reversed;
in place reverse( order reversed, LWB order reversed, UPB order reversed );

print( ( original phrase, ": whole reversed -> ", whole reversed, newline
       , original phrase, ": words reversed -> ", words reversed, newline
       , original phrase, ": order reversed -> ", order reversed, newline
       )
 )


-- REVERSED PHRASES, COMPONENT WORDS, AND WORD ORDER ---------------------

-- reverseString, reverseEachWord, reverseWordOrder :: String -> String
on stringReverse(s)
    |reverse|(s)
end stringReverse

on reverseEachWord(s)
    wordLevel(curry(my map)'s |λ|(my |reverse|))'s |λ|(s)
end reverseEachWord

on reverseWordOrder(s)
    wordLevel(my |reverse|)'s |λ|(s)
end reverseWordOrder

-- wordLevel :: ([String] -> [String]) -> String -> String
on wordLevel(f)
    script
        on |λ|(x)
            unwords(mReturn(f)'s |λ|(|words|(x)))
        end |λ|
    end script
end wordLevel

-- TEST ----------------------------------------------------------------------
on run
    unlines(|<*>|({stringReverse, reverseEachWord, reverseWordOrder}, ¬
        {"rosetta code phrase reversal"}))

    -->

    --     "lasrever esarhp edoc attesor
    --      attesor edoc esarhp lasrever
    --      reversal phrase code rosetta"
end run

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

-- A list of functions applied to a list of arguments
-- (<*> | ap) :: [(a -> b)] -> [a] -> [b]
on |<*>|(fs, xs)
    set {nf, nx} to {length of fs, length of xs}
    set acc to {}
    repeat with i from 1 to nf
        tell mReturn(item i of fs)
            repeat with j from 1 to nx
                set end of acc to |λ|(contents of (item j of xs))
            end repeat
        end tell
    end repeat
    return acc
end |<*>|

-- curry :: (Script|Handler) -> Script
on curry(f)
    script
        on |λ|(a)
            script
                on |λ|(b)
                    |λ|(a, b) of mReturn(f)
                end |λ|
            end script
        end |λ|
    end script
end curry

-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
    set {dlm, my text item delimiters} to {my text item delimiters, strText}
    set strJoined to lstText as text
    set my text item delimiters to dlm
    return strJoined
end intercalate

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

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

-- reverse :: [a] -> [a]
on |reverse|(xs)
    if class of xs is text then
        (reverse of characters of xs) as text
    else
        reverse of xs
    end if
end |reverse|

-- words :: String -> [String]
on |words|(s)
    words of s
end |words|

-- unlines :: [String] -> String
on unlines(lstLines)
    intercalate(linefeed, lstLines)
end unlines

-- unwords :: [String] -> String
on unwords(lstWords)
    intercalate(space, lstWords)
end unwords


phr: "rosetta code phrase reversal"

print ["(0)" phr]
print ["(1)" reverse phr]
print ["(2)" join.with:" " map split.words phr => reverse]
print ["(3)" join.with:" " reverse split.words phr]


var =
(
Rosetta Code Phrase Reversal
)

array := strsplit(var, " ")

loop, % array.maxindex()
	string .= array[array.maxindex() - A_index + 1] . " "

loop, % array.maxindex()
{
	m := array[A_index]
	array2 := strsplit(m, "")
	Loop, % array2.maxindex()
		string2 .= array2[array2.maxindex() - A_index + 1]
	string2 .= " "
}

array := strsplit(string, " " )

loop, % array.maxindex()
{
	m := array[A_index]
	array3 := strsplit(m, "")
	Loop, % array3.maxindex()
		string3 .= array3[array3.maxindex() - A_index + 1]
	string3 .= " "
}

MsgBox % var . "`n" . string3 . "`n" . String . "`n" . string2
ExitApp

esc::ExitApp


# Usage:  awk -f phrase_revers.awk
function rev(s, del,   n,i,a,r) {
   n = split(s, a, del)
   r = a[1]
   for(i=2; i <= n; i++) {r = a[i] del r }
   return r
}

BEGIN {
  p0 = "Rosetta Code Phrase Reversal"

  fmt = "%-20s: %s\n"
  printf( fmt, "input",               p0 )
  printf( fmt, "string reversed",     rev(p0, "") )
  wr = rev(p0, " ")
  printf( fmt, "word-order reversed", wr )
  printf( fmt, "each word reversed",  rev(wr) )
}


phrase$ = "rosetta code phrase reversal"

PRINT REVERSE$(phrase$)

PRINT REV$(REVERSE$(phrase$))

PRINT REV$(phrase$)


@echo off
setlocal enabledelayedexpansion
	%=== The Main Thing... ===%
set "inp=Rosetta Code phrase reversal"
call :reverse_string "!inp!" rev1
call :reverse_order "!inp!" rev2
call :reverse_words "!inp!" rev3
cls
echo.Original:       !inp!
echo.Reversed:       !rev1!
echo.Reversed Order: !rev2!
echo.Reversed Words: !rev3!
pause>nul
exit /b 0
	%=== /The Main Thing... ===%

	%=== Reverse the Order Function ===%
:reverse_order
set var1=%2
set %var1%=&set word=&set str1=%1
:process1
for /f "tokens=1,*" %%A in (%str1%) do (set str1=%%B&set word=%%A)
set %var1%=!word! !%var1%!&set str1="!str1!"
if not !str1!=="" goto process1
goto :EOF
	%=== /Reverse the Order Function ===%

	%=== Reverse the Whole String Function ===%
:reverse_string
set var2=%2
set %var2%=&set cnt=0&set str2=%~1
:process2
set char=!str2:~%cnt%,1!&set %var2%=!char!!%var2%!
if not "!char!"=="" set /a cnt+=1&goto process2
goto :EOF
	%=== /Reverse the Whole String Function ===%

	%=== Reverse each Words Function ===%
:reverse_words
set var3=%2
set %var3%=&set word=&set str3=%1
:process3
for /f "tokens=1,*" %%A in (%str3%) do (set str3=%%B&set word=%%A)
call :reverse_string "%word%" revs
set %var3%=!%var3%! !revs!&set str3="!str3!"
if not !str3!=="" goto process3
set %var3%=!%var3%:~1,1000000!
goto :EOF
	%=== /Reverse each Words Function ===%


( "rosetta code phrase reversal":?text
& rev$!text:?output1
& get$(!text,MEM):?words
& :?output2:?output3
&   whl
  ' ( !words:%?word %?words
    & !output2 rev$!word " ":?output2
    & " " !word !output3:?output3
    )
& str$(!output2 rev$!words):?output2
& str$(!words !output3):?output3
&   out
  $ ( str
    $ ("0:\"" !text "\"\n1:\"" !output1 "\"\n2:\"" !output2 "\"\n3:\"" !output3 \"\n)
    )
);


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

/* The functions used are destructive, so after each call the string needs
 * to be copied over again. One could easily allocate new strings as
 * required, but this way allows the caller to manage memory themselves */

char* reverse_section(char *s, size_t length)
{
    if (length == 0) return s;

    size_t i; char temp;
    for (i = 0; i < length / 2 + 1; ++i)
        temp = s[i], s[i] = s[length - i], s[length - i] = temp;
    return s;
}

char* reverse_words_in_order(char *s, char delim)
{
    if (!strlen(s)) return s;

    size_t i, j;
    for (i = 0; i < strlen(s) - 1; ++i) {
        for (j = 0; s[i + j] != 0 && s[i + j] != delim; ++j)
            ;
        reverse_section(s + i, j - 1);
        s += j;
    }
    return s;
}

char* reverse_string(char *s)
{
    return strlen(s) ? reverse_section(s, strlen(s) - 1) : s;
}

char* reverse_order_of_words(char *s, char delim)
{
    reverse_string(s);
    reverse_words_in_order(s, delim);
    return s;
}

int main(void)
{
    char str[]    = "rosetta code phrase reversal";
    size_t lenstr = sizeof(str) / sizeof(str[0]);
    char scopy[lenstr];
    char delim = ' ';

    /* Original String */
    printf("Original:       \"%s\"\n", str);

    /* Reversed string */
    strncpy(scopy, str, lenstr);
    reverse_string(scopy);
    printf("Reversed:       \"%s\"\n", scopy);

    /* Reversed words in string */
    strncpy(scopy, str, lenstr);
    reverse_words_in_order(scopy, delim);
    printf("Reversed words: \"%s\"\n", scopy);

    /* Reversed order of words in string */
    strncpy(scopy, str, lenstr);
    reverse_order_of_words(scopy, delim);
    printf("Reversed order: \"%s\"\n", scopy);

    return 0;
}


using System;
using System.Linq;
namespace ConsoleApplication
{
    class Program
    {
        static void Main(string[] args)
        {
            //Reverse() is an extension method on IEnumerable<char>.
            //The constructor takes a char[], so we have to call ToArray()
            Func<string, string> reverse = s => new string(s.Reverse().ToArray());

            string phrase = "rosetta code phrase reversal";
            //Reverse the string
            Console.WriteLine(reverse(phrase));
            //Reverse each individual word in the string, maintaining original string order.
            Console.WriteLine(string.Join(" ", phrase.Split(' ').Select(word => reverse(word))));
            //Reverse the order of each word of the phrase, maintaining the order of characters in each word.
            Console.WriteLine(string.Join(" ", phrase.Split(' ').Reverse()));
        }
    }
}


#include <iostream>
#include <vector>
#include <algorithm>
#include <string>
#include <iterator>
#include <sstream>

int main() {
   std::string s = "rosetta code phrase reversal";
   std::cout << "Input : " << s << '\n'
             << "Input reversed : " << std::string(s.rbegin(), s.rend()) << '\n' ;
   std::istringstream is(s);
   std::vector<std::string> words(std::istream_iterator<std::string>(is), {});
   std::cout << "Each word reversed : " ;
   for(auto w : words)
      std::cout << std::string(w.rbegin(), w.rend()) << ' ';
   std::cout << '\n'
             << "Original word order reversed : " ;
   reverse_copy(words.begin(), words.end(), std::ostream_iterator<std::string>(std::cout, " "));
   std::cout << '\n' ;
}


(use '[clojure.string :only (join split)])
(def phrase "rosetta code phrase reversal")
(defn str-reverse [s] (apply str (reverse s)))

; Reverse string
(str-reverse phrase)
; Words reversed
(join " " (map str-reverse (split phrase #" ")))
; Word order reversed
(apply str (interpose " " (reverse (split phrase #" "))))


       program-id. phra-rev.
       data division.
       working-storage section.
       1 phrase pic x(28) value "rosetta code phrase reversal".
       1 wk-str pic x(16).
       1 binary.
        2 phrase-len pic 9(4).
        2 pos pic 9(4).
        2 cnt pic 9(4).
       procedure division.
           compute phrase-len = function length (phrase)
           display phrase
           display function reverse (phrase)
           perform display-words
           move function reverse (phrase) to phrase
           perform display-words
           stop run
           .

       display-words.
           move 1 to pos
           perform until pos > phrase-len
               unstring phrase delimited space
               into wk-str count in cnt
               with pointer pos
               end-unstring
               display function reverse (wk-str (1:cnt))
                   with no advancing
               if pos < phrase-len
                   display space with no advancing
               end-if
           end-perform
           display space
           .
       end program phra-rev.


(defun split-string (str)
 "Split a string into space separated words including spaces"
  (do* ((lst nil)
        (i (position-if #'alphanumericp str) (position-if #'alphanumericp str :start j))
        (j (when i (position #\Space str :start i)) (when i (position #\Space str :start i))) )
       ((null j) (nreverse (push (subseq str i nil) lst)))
    (push (subseq str i j) lst)
    (push " " lst) ))

(defun task (str)
  (print (reverse str))
  (let ((lst (split-string str)))
    (print (apply #'concatenate 'string (mapcar #'reverse lst)))
    (print (apply #'concatenate 'string (reverse lst))) )
  nil )


void main() @safe {
    import std.stdio, std.range, std.algorithm;

    immutable phrase = "rosetta code phrase reversal";
    phrase.retro.writeln;                          // Reversed string.
    phrase.splitter.map!retro.joiner(" ").writeln; // Words reversed.
    phrase.split.retro.joiner(" ").writeln;        // Word order reversed.
}


let str = "rosetta code phrase reversal"

//or you can use a built-in method String.reverse
func reverse(str) {
    let xs = []
    for i in (str.Length()-1)^-1..0 {
        xs.Add(str[i])
    }
    String.Concat(values: xs)
}

func reverseByWord(str) {
    let words = str.Split(" ")
    let xs = []
    for w in words {
        xs.Add(reverse(w))
        xs.Add(" ")
    }
    String.Concat(values: xs)
}

func reverseWords(str) {
    let words = str.Split(" ")
    let xs = []
    for i in (words.Length()-1)^-1..0 {
        xs.Add(words[i])
        xs.Add(" ")
    }
    String.Concat(values: xs)
}

print("1. \(reverse(str))")
print("2. \(reverseByWord(str))")
print("3. \(reverseWords(str))")


(define (string-reverse string)
    (list->string (reverse (string->list string))))

(define (task str)
    (for-each writeln (list
      (string-reverse str)
      (string-join (map string-reverse (string-split str )))
      (string-join (reverse (string-split str ))))))

(task "rosetta code phrase reversal")
    "lasrever esarhp edoc attesor"
    "attesor edoc esarhp lasrever"
    "reversal phrase code rosetta"


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

public program()
{
    var reverse := (s => s.toArray().sequenceReverse().summarize(new StringWriter()));

    var phrase := "rosetta code phrase reversal";
    console.printLine(phrase);

    //Reverse the string
    console.printLine(reverse(phrase));
    //Reverse each individual word in the string, maintaining original string order.
    console.printLine(phrase.splitBy:" ".selectBy:(s => reverse(s).add(" ")).summarize(new StringWriter()));
    //Reverse the order of each word of the phrase, maintaining the order of characters in each word.
    console.printLine(reverse(phrase.splitBy:" ".selectBy:(s => s + " ")))
}


str = "rosetta code phrase reversal"

IO.puts String.reverse(str)
IO.puts String.split(str) |> Enum.map(&String.reverse(&1)) |> Enum.join(" ")
IO.puts String.split(str) |> Enum.reverse |> Enum.join(" ")


(defun reverse-sep (words sep)
  (mapconcat 'identity (reverse (split-string words sep)) sep))

(defun reverse-chars (line)
  (reverse-sep line ""))

(defun reverse-words (line)
  (reverse-sep line " "))

(defvar line "rosetta code phrase reversal")

(with-output-to-temp-buffer "*reversals*"
  (princ (reverse-chars line))
  (terpri)
  (princ (mapconcat 'identity (mapcar #'reverse-chars
                                      (split-string line)) " "))
  (terpri)
  (princ (reverse-words line))
  (terpri))


USE: splitting

: splitp         ( str -- seq ) " " split ;
: printp         ( seq -- )     " " join print ;
: reverse-string ( str -- )     reverse print ;
: reverse-words  ( str -- )     splitp [ reverse ] map printp ;
: reverse-phrase ( str -- )     splitp reverse printp ;

"rosetta code phrase reversal" [ reverse-string ] [ reverse-words ] [ reverse-phrase ] tri


      DO WHILE (L1.LE.L .AND. ATXT(L1).LE." ")
        L1 = L1 + 1
      END DO


' FB 1.05.0 Win64

Sub split (s As Const String, sepList As Const String, result() As String)
  If s = "" OrElse sepList = "" Then
     Redim result(0)
     result(0) = s
     Return
  End If
  Dim As Integer i, j, count = 0, empty = 0, length
  Dim As Integer position(Len(s) + 1)
  position(0) = 0

  For i = 0 To len(s) - 1
    For j = 0 to Len(sepList) - 1
      If s[i] = sepList[j] Then
        count += 1
        position(count) = i + 1
      End If
    Next j
  Next i

  Redim result(count)
  If count  = 0 Then
    result(0) = s
    Return
  End If

  position(count + 1) = len(s) + 1

  For i = 1 To count + 1
    length = position(i) - position(i - 1) - 1
    result(i - 1) = Mid(s, position(i - 1) + 1, length)
  Next
End Sub

Function reverse(s As Const String) As String
  If s = "" Then Return ""
  Dim t As String = s
  Dim length As Integer = Len(t)
  For i As Integer = 0 to length\2 - 1
    Swap t[i], t[length - 1 - i]
  Next
  Return t
End Function

Dim s As String = "rosetta code phrase reversal"
Dim a() As String
Dim sepList As String = " "

Print "Original string => "; s
Print "Reversed string => "; reverse(s)
Print "Reversed words  => ";
split s, sepList, a()
For i As Integer = LBound(a) To UBound(a)
  Print reverse(a(i)); " ";
Next
Print
Print "Reversed order  => ";
For i As Integer = UBound(a) To LBound(a) Step -1
  Print a(i); " ";
Next
Print : Print
Print "Press any key to quit"
Sleep


a = "rosetta code phrase reversal"
println[reverse[a]]
println[join["", map["reverse", wordList[a]]]]
println[reverseWords[a]]  // Built-in function
// Alternately, the above could be
//   join["", reverse[wordList[a]]]


Public Sub Main()
Dim sString As String = "rosetta code phrase reversal"  'The string
Dim sNewString, sTemp As String                         'String variables
Dim siCount As Short                                    'Counter
Dim sWord As New String[]                               'Word store

For siCount = Len(sString) DownTo 1                     'Loop backwards through the string
  sNewString &= Mid(sString, sicount, 1)                'Add each character to the new string
Next

Print "Original string = \t" & sString & "\n" &         'Print the original string
  "Reversed string = \t" & sNewString                   'Print the reversed string

sNewString = ""                                         'Reset sNewString

For Each sTemp In Split(sString, " ")                   'Split the original string by the spaces
  sWord.Add(sTemp)                                      'Add each word to sWord array
Next

For siCount = sWord.max DownTo 0                        'Loop backward through each word in sWord
  sNewString &= sWord[siCount] & " "                    'Add each word to to sNewString
Next

Print "Reversed word order = \t" & sNewString           'Print reversed word order

sNewString = ""                                         'Reset sNewString
For Each sTemp In sWord                                 'For each word in sWord
  For siCount = Len(sTemp) DownTo 1                     'Loop backward through the word
    sNewString &= Mid(sTemp, siCount, 1)                'Add the characters to sNewString
  Next
  sNewString &= " "                                     'Add a space at the end of each word
Next

Print "Words reversed = \t" & sNewString                'Print words reversed

End


package main

import (
	"fmt"
	"strings"
)

const phrase = "rosetta code phrase reversal"

func revStr(s string) string {
	rs := make([]rune, len(s))
	i := len(s)
	for _, r := range s {
		i--
		rs[i] = r
	}
	return string(rs[i:])
}

func main() {
	fmt.Println("Reversed:           ", revStr(phrase))

	ws := strings.Fields(phrase)
	for i, w := range ws {
		ws[i] = revStr(w)
	}
	fmt.Println("Words reversed:     ", strings.Join(ws, " "))

	ws = strings.Fields(phrase)
	last := len(ws) - 1
	for i, w := range ws[:len(ws)/2] {
		ws[i], ws[last-i] = ws[last-i], w
	}
	fmt.Println("Word order reversed:", strings.Join(ws, " "))
}


def phaseReverse = { text, closure -> closure(text.split(/ /)).join(' ')}

def text = 'rosetta code phrase reversal'
println "Original:       $text"
println "Reversed:       ${phaseReverse(text) { it.reverse().collect { it.reverse() } } }"
println "Reversed Words: ${phaseReverse(text) { it.collect { it.reverse() } } }"
println "Reversed Order: ${phaseReverse(text) { it.reverse() } }"


reverseString, reverseEachWord, reverseWordOrder :: String -> String
reverseString = reverse

reverseEachWord = wordLevel (fmap reverse)

reverseWordOrder = wordLevel reverse

wordLevel :: ([String] -> [String]) -> String -> String
wordLevel f = unwords . f . words

main :: IO ()
main =
  (putStrLn . unlines) $
  [reverseString, reverseEachWord, reverseWordOrder] <*>
  ["rosetta code phrase reversal"]


100 PROGRAM "ReverseS.bas"
110 LET S$="Rosetta Code Pharse Reversal"
120 PRINT S$
130 PRINT REVERSE$(S$)
140 PRINT REVERSEW$(S$)
150 PRINT REVERSEC$(S$)
160 DEF REVERSE$(S$)
170   LET T$=""
180   FOR I=LEN(S$) TO 1 STEP-1
190     LET T$=T$&S$(I)
200   NEXT
210   LET REVERSE$=T$
220 END DEF
230 DEF REVERSEW$(S$)
240   LET T$="":LET PE=LEN(S$)
250   FOR PS=PE TO 1 STEP-1
260     IF PS=1 OR S$(PS)=" " THEN LET T$=T$&" ":LET T$=T$&LTRIM$(S$(PS:PE)):LET PE=PS-1
270   NEXT
280   LET REVERSEW$=LTRIM$(T$)
290 END DEF
300 DEF REVERSEC$(S$)
310   LET T$="":LET PS=1
320   FOR PE=1 TO LEN(S$)
330     IF PE=LEN(S$) OR S$(PE)=" " THEN LET T$=T$&" ":LET T$=T$&REVERSE$(RTRIM$(S$(PS:PE))):LET PS=PE+1
340   NEXT
350   LET REVERSEC$=LTRIM$(T$)
360 END DEF


   getWords=: (' '&splitstring) :. (' '&joinstring)
   reverseString=: |.
   reverseWords=: |.&.>&.getWords
   reverseWordOrder=: |.&.getWords


import java.util.Arrays;

public class PhraseRev{
	private static String reverse(String x){
		return new StringBuilder(x).reverse().toString();
	}

	private static <T> T[] reverse(T[] x){
		T[] rev = Arrays.copyOf(x, x.length);
		for(int i = x.length - 1; i >= 0; i--){
			rev[x.length - 1 - i] = x[i];
		}
		return rev;
	}

	private static String join(String[] arr, String joinStr){
		StringBuilder joined = new StringBuilder();
		for(int i = 0; i < arr.length; i++){
			joined.append(arr[i]);
			if(i < arr.length - 1) joined.append(joinStr);
		}
		return joined.toString();
	}

	public static void main(String[] args){
		String str = "rosetta code phrase reversal";

		System.out.println("Straight-up reversed: " + reverse(str));
		String[] words = str.split(" ");
		for(int i = 0; i < words.length; i++){
			words[i] = reverse(words[i]);
		}
		System.out.println("Reversed words: " + join(words, " "));
		System.out.println("Reversed word order: " + join(reverse(str.split(" ")), " "));
	}
}


(function (p) {
  return [
    p.split('').reverse().join(''),

    p.split(' ').map(function (x) {
        return x.split('').reverse().join('');
    }).join(' '),

    p.split(' ').reverse().join(' ')

  ].join('\n');

})('rosetta code phrase reversal');


def reverse_string: explode | reverse | implode;

"rosetta code phrase reversal"
| split(" ") as $words
| "0. input:               \(.)",
  "1. string reversed:     \(reverse_string)",
  "2. each word reversed:  \($words | map(reverse_string) | join(" "))",
  "3. word-order reversed: \($words | reverse | join(" "))"


s = "rosetta code phrase reversal"

println("The original phrase.")
println("   ", s)

println("Reverse the string.")
t = reverse(s)
println("   ", t)

println("Reverse each individual word in the string.")
t = join(map(reverse, split(s, " ")), " ")
println("   ", t)

println("Reverse the order of each word of the phrase.")
t = join(reverse(split(s, " ")), " ")
println("   ", t)


/ Rosetta code phrase reversal
/ phraserev.k

reversestr: {|x}
getnxtwd: {c:(&" "~'x); if[c~!0;w::x;:""];w::c[0]#x; x: ((1+c[0]) _ x)}
revwords: {rw:""; while[~(x~""); x: getnxtwd x;rw,:|w;rw,:" "];:-1 _ rw}
revwordorder: {rw:""; while[~(x~""); x: getnxtwd x;rw:" ",rw;rw:w,rw];:-1 _ rw}


include ..\Utilitys.tlhy

"Rosetta Code Phrase Reversal" dup ?
dup reverse ?
split dup reverse len [drop pop swap print " " print] for drop nl
len [drop pop swap reverse print " " print] for drop nl nl

"End " input


// version 1.0.6

fun reverseEachWord(s: String) = s.split(" ").map { it.reversed() }.joinToString(" ")

fun main(args: Array<String>) {
    val original = "rosetta code phrase reversal"
    val reversed = original.reversed()
    println("Original string => $original")
    println("Reversed string => $reversed")
    println("Reversed words  => ${reverseEachWord(original)}")
    println("Reversed order  => ${reverseEachWord(reversed)}")
}


{W.reverse word} reverses characters in a word
{S.reverse words} reverses a sequence of words
{S.map function words} applies a function to a sequence of words

{def S rosetta code phrase reversal} = rosetta code phrase reversal

{W.reverse {S}}       -> lasrever esarhp edoc attesor
{S.map W.reverse {S}} -> attesor edoc esarhp lasrever
{S.reverse {S}}       -> reversal phrase code rosetta


-- Return a copy of table t in which each string is reversed
function reverseEach (t)
    local rev = {}
    for k, v in pairs(t) do rev[k] = v:reverse() end
    return rev
end

-- Return a reversed copy of table t
function tabReverse (t)
    local revTab = {}
    for i, v in ipairs(t) do revTab[#t - i + 1] = v end
    return revTab
end

-- Split string str into a table on space characters
function wordSplit (str)
    local t = {}
    for word in str:gmatch("%S+") do table.insert(t, word) end
    return t
end

-- Main procedure
local str = "rosetta code phrase reversal"
local tab = wordSplit(str)
print("1. " .. str:reverse())
print("2. " .. table.concat(reverseEach(tab), " "))
print("3. " .. table.concat(tabReverse(tab), " "))


#reverse the string
str := "rosetta code phrase reversal":
print(StringTools:-Reverse(str)):
#reverse each word
lst := convert(StringTools:-Split(str, " "), Array):
for i to numelems(lst) do
	lst[i] := StringTools:-Reverse(lst[i]):
end do:
print(StringTools:-Join(convert(lst,list)," ")):
#reverse word order
print(StringTools:-Join(ListTools:-Reverse(StringTools:-Split(str," ")), " ")):


phrase = "Rosetta Code Phrase Reversal";

reverseWords[phrase_String] :=
 StringJoin @@ Riffle[[email protected]@phrase, " "]

reverseLetters[phrase_String] :=

 StringJoin @@
  Riffle[Map[StringJoin @@ Reverse[[email protected]#] &,
    [email protected]], " "]

{phrase, [email protected], [email protected],
  [email protected]@phrase} // TableForm


function r=revstr(s,d)
slist=strsplit(s,d);
for k=1:length(slist)
        rlist{k}=slist{k}(end:-1:1);
end;
fprintf(1,'%s\n',s)
fprintf(1,'%s %c',slist{end:-1:1},d)
fprintf(1,'\n');
fprintf(1,'%s %c',rlist{:},d)
fprintf(1,'\n');
fprintf(1,'%s\n',s(end:-1:1))
end

revstr('Rosetta Code Phrase Reversal', ' ')


phrase = "rosetta code phrase reversal"

// general sequence reversal function
reverse = function(seq)
    out = []
    for i in range(seq.len-1, 0)
        out.push seq[i]
    end for
    if seq isa string then return out.join("")
    return out
end function

// 1. Reverse the characters of the string.
print reverse(phrase)

// 2. Reverse the characters of each individual word in the string, maintaining original word order within the string.
words = phrase.split
for i in words.indexes
    words[i] = reverse(words[i])
end for
print words.join

// 3. Reverse the order of each word of the string, maintaining the order of characters in each word.
print reverse(phrase.split).join


set string="Rosetta Code Phrase Reversal"
set str="",len=$length(string," ")
for i=1:1:len set $piece(str," ",i)=$piece(string," ",len-i+1)
write string,!
write $reverse(string),!
write str,!
write $reverse(str),!


import algorithm, sequtils, strutils

const Phrase = "rosetta code phrase reversal"

echo "Phrase:              ", Phrase
echo "Reversed phrase:     ", reversed(Phrase).join()
echo "Reversed words:      ", Phrase.split().mapIt(reversed(it).join()).join(" ")
echo "Reversed word order: ", reversed(Phrase.split()).join(" ")


"rosetta code phrase reversal" reverse println
"rosetta code phrase reversal" words map(#reverse) unwords println
"rosetta code phrase reversal" words reverse unwords println


use feature 'say';
my $s = "rosetta code phrase reversal";

say "0. Input               : ", $s;
say "1. String reversed     : ", scalar reverse $s;
say "2. Each word reversed  : ", join " ", reverse split / /, reverse $s;
say "3. Word-order reversed : ", join " ", reverse split / /,$s;

# Or, using a regex:
say "2. Each word reversed  : ", $s =~ s/[^ ]+/reverse $&/gre;


with javascript_semantics
constant test = "rosetta code phrase reversal",
         fmt = """
The original phrase as given:  %s
1. Reverse the entire phrase:  %s
2. Reverse words, same order:  %s
3. Reverse order, same words:  %s
"""
printf(1,fmt,{test,
              reverse(test),
              join(apply(split(test),reverse)),
              join(reverse(split(test)))})


include ..\Utilitys.pmt

"Rosetta Code Phrase Reversal" dup print nl
dup reverse print nl
split dup reverse len for . pop swap print " " print endfor . nl
len for . pop swap reverse print " " print endfor .


<?php
// Initialize a variable with the input desired
$strin = "rosetta code phrase reversal";

// Show user what original input was
echo "Input: ".$strin."\n";

// Show the full input reversed
echo "Reversed: ".strrev($strin)."\n";

// reverse the word letters in place
$str_words_reversed = "";
$temp = explode(" ", $strin);
foreach($temp as $word)
	$str_words_reversed .= strrev($word)." ";

// Show the reversed words in place
echo "Words reversed: ".$str_words_reversed."\n";

// reverse the word order while leaving the words in order
$str_word_order_reversed = "";
$temp = explode(" ", $strin);
for($i=(count($temp)-1); $i>=0; $i--)
	$str_word_order_reversed .= $temp[$i]." ";

// Show the reversal of the word order while leaving the words in order
echo "Word order reversed: ".$str_word_order_reversed."\n";


import util.

go =>
  S = "rosetta code phrase reversal",
  println(S),
  println(reverse(S)),
  println([reverse(W) : W in S.split()].join(' ')),
  println(reverse(S.split()).join(' ')),
  nl.


(let (S (chop "rosetta code phrase reversal")  L (split S " "))
   (prinl (reverse S))
   (prinl (glue " " (mapcar reverse L)))
   (prinl (glue " " (reverse L))) )


reverser: procedure options (main);          /* 19 August 2015 */
   declare (phrase, r, word) character (100) varying;
   declare (start, end) fixed binary;

   phrase = 'rosetta code phrase reversal';
   put ('The original phrase is: ' || phrase);

   put skip list ( '1. ' || reverse(phrase) );

   start = 1; r = ''; put skip edit ('2. ') (a);
   do until ( end > length(phrase) );
      end = index(phrase, ' ', start);          /* Find end of the next word.*/
      if end = 0 then end = length(phrase) + 1; /* We're at the last word.   */
      word = substr(phrase, start, end-start);
      put edit ( reverse(word), ' ' ) (a);      /* Append reversed word.     */
      r = word || ' ' || r;                     /* Prepend normal word.      */
      start = end+1;
   end;
   put skip list ('3. ' || r);

end reverser;


\def\afterfi#1#2\fi{#2\fi#1}
\def\RevSingleWord#1{\RevSingleWordi{}#1\RSWA\RSWB\RSWB\RSWB\RSWB\RSWB\RSWB\RSWB\RSWB\RSWA}
\def\RevSingleWordi#1#2#3#4#5#6#7#8#9{\RSWgobtoB#9\RSWend\RSWB\RevSingleWordi{#9#8#7#6#5#4#3#2#1}}
\def\RSWend\RSWB\RevSingleWordi#1#2\RSWA{\RSWgobtoA#1}
\def\RSWgobtoA#1\RSWA{}
\def\RSWgobtoB#1\RSWB{}
%---
\def\firstchartonil#1#2\nil{#1}
\def\RevOrderSameWords#1{\RevOrderSameWordsi{}#1 \. \* \* \* \* \* \* \* \* \.}
\def\RevOrderSameWordsi#1#2 #3 #4 #5 #6 #7 #8 #9 {%
    \expandafter\ifx\expandafter\*\firstchartonil#9\nil
    \expandafter\ROSWend\else\expandafter\RevOrderSameWordsi\fi{#9 #8 #7 #6 #5 #4 #3 #2#1}%
}
\def\ROSWend#1#2\.{\ROSWendi#1}
\def\ROSWendi#1\.{\romannumeral-`\-}
%---
\def\ROWquark{\ROWquark}
\def\RevOnlyWords#1{\edef\ROWtemp{\noexpand\RevOnlyWordsi{}#1 \noexpand\ROWquark\space}\ROWtemp}
\def\RevOnlyWordsi#1#2 {%
    \ifx\ROWquark#2\afterfi{\ROWgoblastspace#1\nil}%
    \else\afterfi{\RevOnlyWordsi{#1\RevSingleWord{#2} }}%
    \fi
}
\def\ROWgoblastspace#1 \nil{#1}
%---
\def\RevAll#1{\RevAlli{}#1 \. \* \* \* \* \* \* \* \* \.\:}
\def\RevAlli#1#2 #3 #4 #5 #6 #7 #8 #9 {%
    \expandafter\ifx\expandafter\*\firstchartonil#9\nil
    \expandafter\RAWend\else\expandafter\RevAlli\fi{#9 #8 #7 #6 #5 #4 #3 #2#1}%
}
\def\RAWend#1#2\.{\RAWendi#1}
\def\RAWendi#1\.{\expandafter\RAWendii\romannumeral-`\-}
\def\RAWendii#1\:{\RevOnlyWords{#1}}
%--
\halign{#\hfil: &#\cr
Initial&rosetta code phrase reversal\cr
Reverse all&\RevAll{rosetta code phrase reversal}\cr
Reverse order, same words&\RevOrderSameWords{rosetta code phrase reversal}\cr
Reverse only words&\RevOnlyWords{rosetta code phrase reversal}\cr\crcr}
\bye


function reverse($a, $sep = "") {
    if($a.Length -gt 0) {
        $a = $a[($a.Length -1)..0] -join $sep
    }
    $a
}
$line = "rosetta code phrase reversal"
$task1 = reverse $line
$task2 = ($line -split " " | foreach{ reverse $_  }) -join " "
$task3 = reverse ($line -split " ") " "
$task1
$task2
$task3


#TEXT="rosetta code phrase reversal"

If OpenConsole("rosetta code phrase reversal")
  Define idx.i=1, txt.s=""

  Print(~"Original:\t\t")
  PrintN(#TEXT)

  Print(~"Reversed:\t\t")
  PrintN(ReverseString(#TEXT))

  Print(~"Reversed words:\t\t")
  txt=StringField(#TEXT,idx," ")
  While Len(txt)
    Print(ReverseString(txt)+" ")
    idx+1
    txt=StringField(#TEXT,idx," ")
  Wend
  PrintN("")

  Print(~"Reversed order:\t\t")
  idx-1
  txt=StringField(#TEXT,idx," ")
  While Len(txt)
    Print(txt+" ")
    If idx>1 : idx-1 : Else : Break : EndIf
    txt=StringField(#TEXT,idx," ")
  Wend

  Input()
EndIf


>>> phrase = "rosetta code phrase reversal"
>>> phrase[::-1]					  # Reversed.
'lasrever esarhp edoc attesor'
>>> ' '.join(word[::-1] for word in phrase.split())	  # Words reversed.
'attesor edoc esarhp lasrever'
>>> ' '.join(phrase.split()[::-1])	                  # Word order reversed.
'reversal phrase code rosetta'
>>>


  $ "rosetta code phrase reversal"

  3 times dup

  say "0. " echo$ cr
  say "1. " reverse echo$ cr
  say "2. " nest$ witheach [ reverse echo$ sp ] cr
  say "3. " nest$ reverse witheach [ echo$ sp ] cr


#lang racket/base
(require
  (only-in srfi/13 string-reverse)
  (only-in racket/string string-split string-join))

(define (phrase-reversal s)
  (list
   (string-reverse s)
   (string-join (map string-reverse (string-split s)))
   (string-join (reverse (string-split s)))))

(for-each displayln (phrase-reversal "rosetta code phrase reversal"))


my $s = 'rosetta code phrase reversal';

put 'Input               : ', $s;
put 'String reversed     : ', $s.flip;
put 'Each word reversed  : ', $s.words».flip;
put 'Word-order reversed : ', $s.words.reverse;


s='rosetta code phrase reversal'
r1=reverse(s)
r2=''
Do i=1 To words(s)
  r2=r2 reverse(word(s,i))
  End
r2=strip(r2)
r3=''
Do i=words(s) To 1 By -1
  r3=r3 word(s,i)
  End
r3=strip(r3)
Say "input               : " s
say "string reversed     : " r1
say "each word reversed  : " r2
say "word-order reversed : " r3


aString = "Welcome to the Ring Language"
bString = ""
see reverseString(aString)

func reverseString cString
     for i= len(cString) to 1 step -1
         bString = bString + cString[i]
     next
     return bString


str = "rosetta code phrase reversal"

puts str.reverse                          # Reversed string.
puts str.split.map(&:reverse).join(" ")   # Words reversed.
puts str.split.reverse.join(" ")          # Word order reversed.


fn reverse_string(string: &str) -> String {
    string.chars().rev().collect::<String>()
}

fn reverse_words(string: &str) -> String {
    string
        .split_whitespace()
        .map(|x| x.chars().rev().collect::<String>())
        .collect::<Vec<String>>()
        .join(" ")
}

fn reverse_word_order(string: &str) -> String {
    string
        .split_whitespace()
        .rev()
        .collect::<Vec<&str>>()
        .join(" ")
}

#[cfg(test)]
mod tests {
    use super::*;

    #[test]
    fn test_reverse_string() {
        let string = "rosetta code phrase reversal";
        assert_eq!(
            reverse_string(string.clone()),
            "lasrever esarhp edoc attesor"
        );
    }

    #[test]
    fn test_reverse_words() {
        let string = "rosetta code phrase reversal";
        assert_eq!(
            reverse_words(string.clone()),
            "attesor edoc esarhp lasrever"
        );
    }

    #[test]
    fn test_reverse_word_order() {
        let string = "rosetta code phrase reversal";
        assert_eq!(
            reverse_word_order(string.clone()),
            "reversal phrase code rosetta"
        );
    }
}


object PhraseReversals extends App {
    val phrase = scala.io.StdIn.readLine
    println(phrase.reverse)
    println(phrase.split(' ').map(_.reverse).mkString(" "))
    println(phrase.split(' ').reverse.mkString(" "))
}


$ include "seed7_05.s7i";

const proc: main is func
  local
    var string: phrase is "rosetta code phrase reversal";
    var string: word is "";
    var array string: wordList is 0 times "";
  begin
    writeln("The original phrase:" rpad 27 <& phrase);
    writeln("Reverse the entire phrase:" rpad 27 <& reverse(phrase));
    for word range split(phrase, ' ') do
      wordList &:= reverse(word);
    end for;
    writeln("Reverse words, same order:" rpad 27 <& join(wordList, ' '));
    wordList := 0 times "";
    for word range split(phrase, ' ') do
      wordList := [] (word) & wordList;
    end for;
    writeln("Reverse order, same words:" rpad 27 <& join(wordList, ' '));
  end func;


set phrase to "rosetta code phrase reversal"
put phrase reversed
put (the reverse of each word of phrase) joined by space
put (each word of phrase) reversed joined by space


var str    = "rosetta code phrase reversal";

say str.reverse;                            # reversed string
say str.words.map{.reverse}.join(' ');      # words reversed
say str.words.reverse.join(' ');            # word order reversed


|str|
str := 'rosetta code phrase reversal'.

Transcript showCR:(str reversed).
Transcript showCR:(((str splitBy:$ ) collect:#reversed) join:$ ).
Transcript showCR:(((str splitBy:$ ) reversed) join:$ ).


func reverseString(s:String)->String{
    var temp = [Character]()
    for i in s.characters{
        temp.append(i)
    }
    var j=s.characters.count-1
    for i in s.characters{
        temp[j]=i
        j-=1
    }
    return String(temp)
}

func reverseWord(s:String)->String{
    var temp = [Character]()
    var result:String=""
    for i in s.characters{
        if i==" "{
            result += "\(reverseString(s:String(temp))) "
            temp=[Character]()
        }
        else {
            temp.append(i)
        }
        if i==s[s.index(before: s.endIndex)]{
            result += (reverseString(s:String(temp)))
        }
    }
    return result
}

func flipString(s:String)->String{
    return reverseWord(s:reverseString(s:s))
}
print(str)
print(reverseString(s:str))
print(reverseWord(s:str))
print(flipString(s:str))


set s "rosetta code phrase reversal"
# Reverse all characters
puts [string reverse $s]
# Reverse characters in each word
puts [lmap word $s {string reverse $word}]
# Reverse the words but not the characters
puts [lreverse $s]


s1="rosetta code phrase reversal"
echo "Original string ----------------------> "$s1

echo -n "1.) Reverse the string ---------------> "
echo $s1|rev

echo -n "2.) Reverse characters of each word --> "
echo $s1|tr " " "\n"|rev|tr "\n" " ";echo

echo -n "3.) Reverse word order ---------------> "
word_num=$(echo $s1|wc -w)
while [ $word_num != 0 ];do
echo -n $(echo $s1|cut -d " " -f $word_num);echo -n " "
word_num=$(expr $word_num - 1);done;echo


Option Explicit

Sub Main_Phrase_Reversals()
Const PHRASE As String = "rosetta code phrase reversal"
    Debug.Print "Original String              : " & PHRASE
    Debug.Print "Reverse String               : " & Reverse_String(PHRASE)
    Debug.Print "Reverse each individual word : " & Reverse_each_individual_word(PHRASE)
    Debug.Print "Reverse order of each word   : " & Reverse_the_order_of_each_word(PHRASE)
End Sub

Function Reverse_String(strPhrase As String) As String
    Reverse_String = StrReverse(strPhrase)
End Function

Function Reverse_each_individual_word(strPhrase As String) As String
Dim Words, i&, strTemp$
    Words = Split(strPhrase, " ")
    For i = 0 To UBound(Words)
        Words(i) = Reverse_String(CStr(Words(i)))
    Next i
    Reverse_each_individual_word = Join(Words, " ")
End Function

Function Reverse_the_order_of_each_word(strPhrase As String) As String
Dim Words, i&, strTemp$

    Words = Split(strPhrase, " ")
    For i = UBound(Words) To 0 Step -1
        strTemp = strTemp & " " & Words(i)
    Next i
    Reverse_the_order_of_each_word = Trim(strTemp)
End Function


Phrase = "rosetta code phrase reversal"

WScript.StdOut.Write "Original String          : " & Phrase
WScript.StdOut.WriteLine
WScript.StdOut.Write "Reverse String           : " & RevString(Phrase)
WScript.StdOut.WriteLine
WScript.StdOut.Write "Reverse String Each Word : " & RevStringEachWord(Phrase)
WScript.StdOut.WriteLine
WScript.StdOut.Write "Reverse Phrase           : " & RevPhrase(Phrase)
WScript.StdOut.WriteLine

Function RevString(s)
	x = Len(s)
	For i = 1 To Len(s)
		RevString = RevString & Mid(s,x,1)
		x = x - 1
	Next
End Function

Function RevStringEachWord(s)
	arr = Split(s," ")
	For i = 0 To UBound(arr)
		RevStringEachWord = RevStringEachWord & RevString(arr(i))
		If i < UBound(arr) Then
			RevStringEachWord = RevStringEachWord & " "
		End If
	Next
End Function

Function RevPhrase(s)
	arr = Split(s," ")
	For i = UBound(arr) To LBound(arr) Step -1
		RevPhrase = RevPhrase & arr(i)
		If i > LBound(arr) Then
			RevPhrase = RevPhrase & " "
		End If
	Next
End Function


fn main() {
	str := 'rosetta code phrase reversal'
    words := str.fields()
    println('Original:          $str')
    println('Reverse:           ${str.reverse()}')
    println('Char-Word Reverse: ${words.map(it.reverse()).join(' ')}')
    println('Word Reverse:      ${words.reverse().join(' ')}')
}


var s = "rosetta code phrase reversal"
System.print("Input               : %(s)")
System.print("String reversed     : %(s[-1..0])")
System.print("Each word reversed  : %(s.split(" ").map { |w| w[-1..0] }.join(" "))")
System.print("Word order reversed : %(s.split(" ")[-1..0].join(" "))")


phrase$ = "Rosetta Code Phrase Reversal"

dim word$(1)

n = token(phrase$, word$())

print phrase$

for i = n to 1 step -1
    print reverse$(word$(i)), " ";
next

print

for i = n to 1 step -1
    print word$(i), " ";
next

print

for i = 1 to n
    print reverse$(word$(i)), " ";
next

print

sub reverse$(w$)
    local i, rw$

    for i = len(w$) to 1 step -1
        rw$ = rw$ + mid$(w$, i, 1)
    next

    return rw$
end sub


zkl: var str="rosetta code phrase reversal"
rosetta code phrase reversal

zkl: str.reverse() #1
lasrever esarhp edoc attesor

zkl: str.split().apply("reverse").concat(" ") #2 string to list to string
attesor edoc esarhp lasrever

zkl: str.split().reverse().concat(" ") #3
reversal phrase code rosetta


V ndigits = 0
V q = BigInt(1)
V r = BigInt(0)
V t = q
V k = q
V n = BigInt(3)
V l = n

V first = 1B
L ndigits < 1'000
   I 4 * q + r - t < n * t
      print(n, end' ‘’)
      ndigits++
      I ndigits % 70 == 0
         print()
      I first
         first = 0B
         print(‘.’, end' ‘’)
      V nr = 10 * (r - n * t)
      n = ((10 * (3 * q + r)) I/ t) - 10 * n
      q *= 10
      r = nr
   E
      V nr = (2 * q + r) * l
      V nn = (q * (7 * k + 2) + r * l) I/ (t * l)
      q *= k
      t *= l
      l += 2
      k++
      n = nn
      r = nr


*        Spigot algorithm do the digits of PI  02/07/2016
PISPIG   CSECT
         USING  PISPIG,R13         base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         "
         ST     R15,8(R13)         "
         LR     R13,R15            "
         SR     R0,R0              0
         ST     R0,MORE            more=0
         LA     R6,1               i=1
LOOPI1   C      R6,=A(NBUF)        do i=1 to hbound(buf)
         BH     ELOOPI1            "
         SR     R9,R9                karray=0
         L      R7,=A(NVECT)         j=hbound(vect)
         LR     R1,R7                  j
         SLA    R1,2                   .
         LA     R10,VECT-4(R1)       [email protected](j)
LOOPJ    EQU    *                    do j=hbound(vect) to 1 by -1
         L      R5,=F'100000'            100000
         M      R4,0(R10)                *vect(j)
         LR     R2,R5                    r2=100000*vect(j)
         LR     R5,R9                    karray
         MR     R4,R7                    karray*j
         AR     R2,R5                    r2+karray*j
         LR     R11,R2                 n=100000*vect(j)+karray*j
         LR     R3,R7                    j
         SLA    R3,1                     2*j
         BCTR   R3,0                     2*j-1)
         LR     R4,R11                   n
         SRDA   R4,32                    .
         DR     R4,R3                    n/(2*j-1)
         LR     R9,R5                  karray=n/(2*j-1)
         LR     R5,R9                    karray
         MR     R4,R3                    karray*(2*j-1)
         LR     R1,R11                   n
         SR     R1,R5                    n-karray*(2*j-1)
         ST     R1,0(R10)              vect(j)=n-karray*(2*j-1)
         SH     R10,=H'4'              [email protected](j)
         BCT    R7,LOOPJ             end do j
         LR     R4,R9                karray
         SRDA   R4,32                .
         D      R4,=F'100000'        karray/100000
         LR     R11,R5               k=karray/100000
         L      R2,MORE              more
         AR     R2,R11               +k
         LR     R1,R6                i
         SLA    R1,2                 .
         ST     R2,BUF-4(R1)         buf(i)=more+k
         LR     R5,R11                 k
         M      R4,=F'100000'          *100000
         LR     R1,R9                  karray
         SR     R1,R5                  -k*100000
         ST     R1,MORE              more=karray-k*100000
         LA     R6,1(R6)             i=i+1
         B      LOOPI1             end do i
ELOOPI1  L      R1,BUF             buf(1)
         CVD    R1,PACKED          convert buf(1) to packed decimal
         OI     PACKED+7,X'0F'     prepare unpack
         UNPK   PG(1),PACKED       packed decimal to zoned printable
         MVI    PG+1,C'.'          output '.'
         XPRNT  PG,80              print buffer
         MVC    PG,=CL80' '        clear buffer
         LA     R3,PG              pgi=0
         LA     R6,2               i=2
LOOPI2   C      R6,=A(NBUF)        do i=2 to hbound(buf)
         BH     ELOOPI2            "
         MVC    0(1,R3),=C' '        output ' '
         LA     R3,1(R3)             pgi=pgi+1
         LR     R1,R6                i
         SLA    R1,2                 .
         L      R2,BUF-4(R1)         buf(i)
         CVD    R2,PACKED            convert v to packed decimal
         OI     PACKED+7,X'0F'       prepare unpack
         UNPK   XDEC,PACKED          packed decimal to zoned printable
         MVC    0(5,R3),XDEC+7       output buf(i) with 5 decimals
         LA     R3,5(R3)             pgi=pgi+5
         LR     R4,R6                i
         BCTR   R4,0                 i-1
         SRDA   R4,32                .
         D      R4,=F'10'            (i-1)/10
         LTR    R4,R4                if (i-1)//10=0
         BNZ    NOSKIP               then
         XPRNT  PG,80                  print buffer
         LA     R3,PG                  pgi=0
         MVC    PG,=CL80' '            clear buffer
NOSKIP   LA     R6,1(R6)             i=i+1
         B      LOOPI2             end do i
ELOOPI2  L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    "
         XR     R15,R15            "
         BR     R14                exit
         LTORG
MORE     DS     F                  more
PACKED   DS     0D,PL8             packed decimal
PG       DC     CL80' '            buffer
XDEC     DS     CL12               temp
BUF      DC     (NBUF)F'0'         buf(nbuf)
VECT     DC     (NVECT)F'2'        vect(nvect) init 2
         YREGS
NBUF     EQU    201                number of 5 decimals
NVECT    EQU    3350               nvect=ceil(nbuf*50/3)
         END    PISPIG


with Ada.Command_Line;
with Ada.Text_IO;
with GNU_Multiple_Precision.Big_Integers;
with GNU_Multiple_Precision.Big_Rationals;
use GNU_Multiple_Precision;

procedure Pi_Digits is
   type Int is mod 2 ** 64;
   package Int_To_Big is new Big_Integers.Modular_Conversions (Int);

   -- constants
   Zero : constant Big_Integer := Int_To_Big.To_Big_Integer (0);
   One : constant Big_Integer := Int_To_Big.To_Big_Integer (1);
   Two : constant Big_Integer := Int_To_Big.To_Big_Integer (2);
   Three : constant Big_Integer := Int_To_Big.To_Big_Integer (3);
   Four : constant Big_Integer := Int_To_Big.To_Big_Integer (4);
   Ten : constant Big_Integer := Int_To_Big.To_Big_Integer (10);

   -- type LFT = (Integer, Integer, Integer, Integer
   type LFT is record
      Q, R, S, T : Big_Integer;
   end record;

   -- extr :: LFT -> Integer -> Rational
   function Extr (T : LFT; X : Big_Integer) return Big_Rational is
      use Big_Integers;
      Result : Big_Rational;
   begin
      -- extr (q,r,s,t) x = ((fromInteger q) * x + (fromInteger r)) /
      --                    ((fromInteger s) * x + (fromInteger t))
      Big_Rationals.Set_Numerator (Item         => Result,
                                   New_Value    => T.Q * X + T.R,
                                   Canonicalize => False);
      Big_Rationals.Set_Denominator (Item      => Result,
                                     New_Value => T.S * X + T.T);
      return Result;
   end Extr;

   -- unit :: LFT
   function Unit return LFT is
   begin
      -- unit = (1,0,0,1)
      return LFT'(Q => One, R => Zero, S => Zero, T => One);
   end Unit;

   -- comp :: LFT -> LFT -> LFT
   function Comp (T1, T2 : LFT) return LFT is
      use Big_Integers;
   begin
      -- comp (q,r,s,t) (u,v,w,x) = (q*u+r*w,q*v+r*x,s*u+t*w,s*v+t*x)
      return LFT'(Q => T1.Q * T2.Q + T1.R * T2.S,
                  R => T1.Q * T2.R + T1.R * T2.T,
                  S => T1.S * T2.Q + T1.T * T2.S,
                  T => T1.S * T2.R + T1.T * T2.T);
   end Comp;

   -- lfts = [(k, 4*k+2, 0, 2*k+1) | k<-[1..]
   K : Big_Integer := Zero;
   function LFTS return LFT is
      use Big_Integers;
   begin
      K := K + One;
      return LFT'(Q => K,
                  R => Four * K + Two,
                  S => Zero,
                  T => Two * K + One);
   end LFTS;

   -- next z = floor (extr z 3)
   function Next (T : LFT) return Big_Integer is
   begin
      return Big_Rationals.To_Big_Integer (Extr (T, Three));
   end Next;

   -- safe z n = (n == floor (extr z 4)
   function Safe (T : LFT; N : Big_Integer) return Boolean is
   begin
      return N = Big_Rationals.To_Big_Integer (Extr (T, Four));
   end Safe;

   -- prod z n = comp (10, -10*n, 0, 1)
   function Prod (T : LFT; N : Big_Integer) return LFT is
      use Big_Integers;
   begin
      return Comp (LFT'(Q => Ten, R => -Ten * N, S => Zero, T => One), T);
   end Prod;

   procedure Print_Pi (Digit_Count : Positive) is
      Z : LFT := Unit;
      Y : Big_Integer;
      Count : Natural := 0;
   begin
      loop
         Y := Next (Z);
         if Safe (Z, Y) then
            Count := Count + 1;
            Ada.Text_IO.Put (Big_Integers.Image (Y));
            exit when Count >= Digit_Count;
            Z := Prod (Z, Y);
         else
            Z := Comp (Z, LFTS);
         end if;
      end loop;
   end Print_Pi;

   N : Positive := 250;
begin
   if Ada.Command_Line.Argument_Count = 1 then
      N := Positive'Value (Ada.Command_Line.Argument (1));
   end if;
   Print_Pi (N);
end Pi_Digits;


#!/usr/local/bin/a68g --script #

INT base := 10;

MODE YIELDINT = PROC(INT)VOID;
PROC gen pi digits = (INT decimal places, YIELDINT yield)VOID:
BEGIN
  INT nine = base - 1;
  INT nines := 0, predigit := 0; # First predigit is a 0 #
  [decimal places*10 OVER 3]#LONG# INT digits; # We need 3 times the digits to calculate #
  FOR place FROM LWB digits TO UPB digits DO digits[place] := 2 OD; # Start with 2s #
  FOR place TO decimal places + 1 DO
    INT digit := 0;
    FOR i FROM UPB digits BY -1 TO LWB digits DO # Work backwards #
        INT x := #SHORTEN#(base*digits[i] + #LENG# digit*i);
        digits[i] := x MOD (2*i-1);
        digit := x OVER (2*i-1)
    OD;
    digits[LWB digits] := digit MOD base; digit OVERAB base;
    nines :=
      IF digit = nine THEN
        nines + 1
      ELSE
        IF digit = base THEN
          yield(predigit+1); predigit := 0 ;
          FOR repeats TO nines DO yield(0) OD # zeros #
        ELSE
          IF place NE 1 THEN yield(predigit) FI; predigit := digit;
          FOR repeats TO nines DO yield(nine) OD
        FI;
        0
      FI
  OD;
  yield(predigit)
END;

main:(
  INT feynman point = 762; # feynman point + 4 is a good test case #
# the 33rd decimal place is a shorter tricky test case #
  INT test decimal places = UPB "3.1415926.......................502"-2;

  INT width = ENTIER log(base*(1+small real*10));

# iterate throught the digits as they are being found #
# FOR INT digit IN # gen pi digits(test decimal places#) DO ( #,
  ## (INT digit)VOID: (
    printf(($n(width)d$,digit))
  )
# OD #);
  print(new line)
)


q: 1
r: 0
t: 1
k: 1
n: 3
l: 3
d: 0

dotWritten: false

while [true][
    if? (n*t) > (4*q)+r-t [
        d: d+1
        prints n
        unless dotWritten [
            prints "."
            dotWritten: true
            d: d+1
        ]

        if 0 = d%80 -> prints "\n"
        nr: 10*(r - n*t)
        n: ((10*(r + 3*q)) / t) - 10*n
        q: q*10
        r: nr
    ]
    else [
        nr: (r + 2*q) * l
        nn: ((q*(2 + 7*k)) + r*l) / (t*l)
        q: q*k
        t: t*l
        l: l+2
        k: k+1
        n: nn
        r: nr
    ]
]


#NoEnv
#SingleInstance, Force
SetBatchLines, -1
#Include mpl.ahk
dot:=".", i:=0
, MP_SET(q, "1")
, MP_SET(r, "0")
, MP_SET(t, "1")
, MP_SET(k, "1")
, MP_SET(n, "3")
, MP_SET(l, "3")
, MP_SET(ONE, "1")
, MP_SET(TWO, "2")
, MP_SET(THREE, "3")
, MP_SET(FOUR, "4")
, MP_SET(SEVEN, "7")
, MP_SET(TEN, "10")

Loop
{
	MP_MUL(q4, q, FOUR)
	, MP_ADD(q4r, q4, r)
	, MP_SUB(q4rt, q4r, t)
	, MP_MUL(tn, t, n)
	If (MP_CMP(q4rt,tn) = -1)
	{
		s := MP_DEC(n) . dot
		OutputDebug %s%
		  dot := ""
		, i++
		, MP_MUL(tn, t, n)
		, MP_SUB(rtn, r, tn)
		, MP_MUL(nr, rtn, TEN)
		, MP_MUL(q3, q, THREE)
		, MP_ADD(q3r, q3, r)
		, MP_DIV(q3rt, remainder, q3r, t)
		, MP_SUB(q3rtn, q3rt, n)
		, MP_MUL(n, q3rtn, TEN)
		, MP_MUL(tmp, q, TEN)
		, MP_CPY(q, tmp)
		, MP_CPY(r, nr)
	}
	Else
	{
		MP_MUL(q2, q, TWO)
		, MP_ADD(q2r, q2, r)
		, MP_MUL(nr, q2r, l)
		, MP_MUL(k7, k, SEVEN)
		, MP_ADD(k72, k7, TWO)
		, MP_MUL(qk, q, k72)
		, MP_MUL(rl, r, l)
		, MP_ADD(qkrl, qk, rl)
		, MP_MUL(tl, t, l)
		, MP_DIV(nn, remainder, qkrl, tl)
		, MP_MUL(tmp, q, k)
		, MP_CPY(q, tmp)
		, MP_MUL(tmp, t, l)
		, MP_CPY(t, tmp)
		, MP_ADD(tmp, l, TWO)
		, MP_CPY(l, tmp)
		, MP_ADD(tmp, k, ONE)
		, MP_CPY(k, tmp)
		, MP_CPY(n, nn)
		, MP_CPY(r, nr)
	}
}


10 REM ADOPTED FROM COMMODORE BASIC
20 N = 100: REM N MAY BE INCREASED, BUT WILL SLOW EXECUTION
30 LN = INT(10*N/3)+16
40 ND = 1
50 DIM A(LN)
60 N9 = 0
70 PD = 0:REM FIRST PRE-DIGIT IS A 0
80 REM
90 FOR J = 1 TO LN
100    A(J-1) = 2:REM START WITH 2S
110 NEXT J
120 REM
130 FOR J = 1 TO N
140     Q = 0
150     FOR I = LN TO 1 STEP -1:REM WORK BACKWARDS
160         X = 10*A(I-1) + Q*I
170         A(I-1) = X - (2*I-1)*INT(X/(2*I-1)):REM X - INT ( X / Y) * Y
180         Q = INT(X/(2*I - 1))
190     NEXT I
200     A(0) = Q-10*INT(Q/10)
210     Q = INT(Q/10)
220     IF Q=9 THEN N9 = N9 + 1: GOTO 450
240     IF Q<>10 THEN GOTO 350
250     REM Q == 10
260        D = PD+1: GOSUB 500
270        IF N9 <= 0 THEN GOTO 320
280           FOR K = 1 TO N9
290              D = 0: GOSUB 500
300           NEXT K
310        REM END IF
320        PD = 0
330        N9 = 0
335        GOTO 450
340     REM Q <> 10
350        D = PD: GOSUB 500
360        PD = Q
370        IF N9 = 0 THEN GOTO 450
380           FOR K = 1 TO N9
390              D = 9: GOSUB 500
400           NEXT K
410           N9 = 0
450 NEXT J
460 PRINT PD
470 END
480 REM
490 REM OUTPUT DIGITS
500 IF ND=0 THEN PRINT D;: RETURN
510 IF D=0 THEN RETURN
520  PRINT D;".";
530 ND = 0
550 RETURN


      WIDTH 80
      M% = (HIMEM-END-1000) / 4
      DIM B%(M%)
      FOR I% = 0 TO M% : B%(I%) = 20 : NEXT
      E% = 0
      L% = 2
      FOR C% = M% TO 14 STEP -7
        D% = 0
        A% = C%*2-1
        FOR P% = C% TO 1 STEP -1
          D% = D%*P% + B%(P%)*&64
          B%(P%) = D% MOD A%
          D% DIV= A%
          A% -= 2
        NEXT
        CASE TRUE OF
          WHEN D% = 99: E% = E% * 100 + D% : L% += 2
          WHEN C% = M%: PRINT ;(D% DIV 100) / 10; : E% = D% MOD 100
          OTHERWISE:
            PRINT RIGHT$(STRING$(L%,"0") + STR$(E% + D% DIV 100),L%);
            E% = D% MOD 100 : L% = 2
        ENDCASE
      NEXT


#!/usr/bin/bc -l

scaleinc= 20

define zeropad ( n ) {
    auto m
    for ( m= scaleinc - 1; m > 0; --m ) {
        if ( n < 10^m ) {
            print "0"
        }
    }
    return ( n )
}

wantscale= scaleinc - 2
scale= wantscale + 2
oldpi= 4*a(1)
scale= wantscale
oldpi= oldpi / 1
oldpi
while( 1 ) {
    wantscale= wantscale + scaleinc
    scale= wantscale + 2
    pi= 4*a(1)
    scale= 0
    digits= ((pi - oldpi) * 10^wantscale) / 1
    zeropad( digits )
    scale= wantscale
    oldpi= pi / 1
}


#include <stdio.h>
#include <stdlib.h>
#include <gmp.h>

mpz_t tmp1, tmp2, t5, t239, pows;
void actan(mpz_t res, unsigned long base, mpz_t pows)
{
	int i, neg = 1;
	mpz_tdiv_q_ui(res, pows, base);
	mpz_set(tmp1, res);
	for (i = 3; ; i += 2) {
		mpz_tdiv_q_ui(tmp1, tmp1, base * base);
		mpz_tdiv_q_ui(tmp2, tmp1, i);
		if (mpz_cmp_ui(tmp2, 0) == 0) break;
		if (neg) mpz_sub(res, res, tmp2);
		else	  mpz_add(res, res, tmp2);
		neg = !neg;
	}
}

char * get_digits(int n, size_t* len)
{
	mpz_ui_pow_ui(pows, 10, n + 20);

	actan(t5, 5, pows);
	mpz_mul_ui(t5, t5, 16);

	actan(t239, 239, pows);
	mpz_mul_ui(t239, t239, 4);

	mpz_sub(t5, t5, t239);
	mpz_ui_pow_ui(pows, 10, 20);
	mpz_tdiv_q(t5, t5, pows);

	*len = mpz_sizeinbase(t5, 10);
	return mpz_get_str(0, 0, t5);
}

int main(int c, char **v)
{
	unsigned long accu = 16384, done = 0;
	size_t got;
	char *s;

	mpz_init(tmp1);
	mpz_init(tmp2);
	mpz_init(t5);
	mpz_init(t239);
	mpz_init(pows);

	while (1) {
		s = get_digits(accu, &got);

		/* write out digits up to the last one not preceding a 0 or 9*/
		got -= 2; /* -2: length estimate may be longer than actual */
		while (s[got] == '0' || s[got] == '9') got--;

		printf("%.*s", (int)(got - done), s + done);
		free(s);

		done = got;

		/* double the desired digits; slows down at least cubically */
		accu *= 2;
	}

	return 0;
}


using System;
using System.Numerics;

namespace PiCalc {
    internal class Program {
        private readonly BigInteger FOUR = new BigInteger(4);
        private readonly BigInteger SEVEN = new BigInteger(7);
        private readonly BigInteger TEN = new BigInteger(10);
        private readonly BigInteger THREE = new BigInteger(3);
        private readonly BigInteger TWO = new BigInteger(2);

        private BigInteger k = BigInteger.One;
        private BigInteger l = new BigInteger(3);
        private BigInteger n = new BigInteger(3);
        private BigInteger q = BigInteger.One;
        private BigInteger r = BigInteger.Zero;
        private BigInteger t = BigInteger.One;

        public void CalcPiDigits() {
            BigInteger nn, nr;
            bool first = true;
            while (true) {
                if ((FOUR*q + r - t).CompareTo(n*t) == -1) {
                    Console.Write(n);
                    if (first) {
                        Console.Write(".");
                        first = false;
                    }
                    nr = TEN*(r - (n*t));
                    n = TEN*(THREE*q + r)/t - (TEN*n);
                    q *= TEN;
                    r = nr;
                } else {
                    nr = (TWO*q + r)*l;
                    nn = (q*(SEVEN*k) + TWO + r*l)/(t*l);
                    q *= k;
                    t *= l;
                    l += TWO;
                    k += BigInteger.One;
                    n = nn;
                    r = nr;
                }
            }
        }

        private static void Main(string[] args) {
            new Program().CalcPiDigits();
        }
    }
}


#include <iostream>
#include <boost/multiprecision/cpp_int.hpp>

using namespace boost::multiprecision;

class Gospers
{
    cpp_int q, r, t, i, n;

public:

    // use Gibbons spigot algorith based on the Gospers series
    Gospers() : q{1}, r{0}, t{1}, i{1}
    {
        ++*this; // move to the first digit
    }

    // the ++ prefix operator will move to the next digit
    Gospers& operator++()
    {
        n = (q*(27*i-12)+5*r) / (5*t);

        while(n != (q*(675*i-216)+125*r)/(125*t))
        {
            r = 3*(3*i+1)*(3*i+2)*((5*i-2)*q+r);
            q = i*(2*i-1)*q;
            t = 3*(3*i+1)*(3*i+2)*t;
            i++;

            n = (q*(27*i-12)+5*r) / (5*t);
        }

        q = 10*q;
        r = 10*r-10*n*t;

        return *this;
    }

    // the dereference operator will give the current digit
    int operator*()
    {
        return (int)n;
    }
};

int main()
{
    Gospers g;

    std::cout << *g << ".";  // print the first digit and the decimal point

    for(;;) // run forever
    {
        std::cout << *++g;  // increment to the next digit and print
    }
}


(ns pidigits
  (:gen-class))

(def calc-pi
        ;  integer division rounding downwards to -infinity
  (let [div (fn [x y] (long (Math/floor (/ x y))))

          ; Computations performed after yield clause in Python code
          update-after-yield (fn [[q r t k n l]]
                         (let [nr (* 10 (- r (* n t)))
                               nn (- (div (* 10 (+ (* 3 q) r)) t) (* 10 n))
                               nq (* 10 q)]
                           [nq nr t k nn l]))

          ; Update of else clause in Python code: if (< (- (+ (* 4 q) r) t) (* n t))
          update-else (fn [[q r t k n l]]
                        (let [nr (* (+ (* 2 q) r) l)
                              nn (div (+ (* q 7 k) 2 (* r l)) (* t l))
                              nq (* k q)
                              nt (* l t)
                              nl (+ 2 l)
                              nk (+ 1 k)]
                          [nq nr nt nk nn nl]))

          ; Compute the lazy sequence of pi digits translating the Python code
          pi-from (fn pi-from [[q r t k n l]]
                    (if (< (- (+ (* 4 q) r) t) (* n t))
                      (lazy-seq (cons n (pi-from (update-after-yield [q r t k n l]))))
                      (recur (update-else [q r t k n l]))))]

      ; Use Clojure big numbers to perform the math (avoid integer overflow)
      (pi-from [1N 0N 1N 1N 3N 3N])))

;; Indefinitely Output digits of pi, with 40 characters per line
(doseq [[i q] (map-indexed vector calc-pi)]
  (when (= (mod i 40) 0)
    (println))
  (print q))


require "big"

def pi
  q, r, t, k, n, l = [1, 0, 1, 1, 3, 3].map { |n| BigInt.new(n) }
  dot_written = false
  loop do
    if 4*q + r - t < n*t
      yield n
      unless dot_written
        yield '.'
        dot_written = true
      end
      nr = 10*(r - n*t)
      n = ((10*(3*q + r)) / t) - 10*n
      q *= 10
      r = nr
    else
      nr = (2*q + r) * l
      nn = (q*(7*k + 2) + r*l) / (t*l)
      q *= k
      t *= l
      l += 2
      k += 1
      n = nn
      r = nr
    end
  end
end

pi { |digit_or_dot| print digit_or_dot; STDOUT.flush }


import std.stdio, std.conv, std.string;

struct PiDigits {
    immutable uint nDigits;

    int opApply(int delegate(ref string /*chunk of pi digit*/) dg){
        // Maximum width for correct output, for type ulong.
        enum size_t width = 9;

        enum ulong scale = 10UL ^^ width;
        enum ulong initDigit = 2UL * 10UL ^^ (width - 1);
        enum string formatString = "%0" ~ text(width) ~ "d";

        immutable size_t len = 10 * nDigits / 3;
        auto arr = new ulong[len];
        arr[] = initDigit;
        ulong carry;

        foreach (i; 0 .. nDigits / width) {
            ulong sum;
            foreach_reverse (j; 0 .. len) {
                auto quo = sum * (j + 1) + scale * arr[j];
                arr[j] = quo % (j*2 + 1);
                sum = quo / (j*2 + 1);
            }
            auto yield = format(formatString, carry + sum/scale);
            if (dg(yield))
                break;
            carry = sum % scale;
        }
        return 0;
    }
}

void main() {
    foreach (d; PiDigits(100))
        writeln(d);
}


unit Pi_BBC_Main;

interface

uses
  Classes, Controls, Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    btnRunSpigotAlgo: TButton;
    memScreen: TMemo;
    procedure btnRunSpigotAlgoClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    fScreenWidth : integer;
    fLineBuffer : string;
    procedure ClearText();
    procedure AddText( const s : string);
    procedure FlushText();
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses SysUtils;

// Button clicked to run algorithm
procedure TForm1.btnRunSpigotAlgoClick(Sender: TObject);
var
  // BBC Basic variables. Delphi longint is 32 bits.
  B : array of longint;
  A, C, D, E, I, L, M, P : longint;
  // Added for Delphi version
  temp : string;
  h, j, t : integer;
begin
  fScreenWidth := 80;
  ClearText();
  M := 5368709; // floor( (2^31 - 1)/400 )

  // DIM B%(M%) in BBC Basic declares an array [0..M%], i.e. M% + 1 elements
  SetLength( B, M + 1);
  for I := 0 to M do B[I] := 20;
  E := 0;
  L := 2;

  // FOR C% = M% TO 14 STEP -7
  // In Delphi (or at least Delphi 7) the step size in a for loop has to be 1.
  // So the BBC Basic FOR loop has been replaced by a repeat loop.
  C := M;
  repeat
    D := 0;
    A := C*2 - 1;
    for P := C downto 1 do begin
      D := D*P + B[P]*$64; // hex notation copied from BBC version
      B[P] := D mod A;
      D := D div A;
      dec( A, 2);
    end;

    // The BBC CASE statement here amounts to a series of if ... else
    if (D = 99) then begin
      E := E*100 + D;
      inc( L, 2);
    end
    else if (C = M) then begin
      AddText( SysUtils.Format( '%2.1f', [1.0*(D div 100) / 10.0] ));
      E := D mod 100;
    end
    else begin
      // PRINT RIGHT$(STRING$(L%,"0") + STR$(E% + D% DIV 100),L%);
      // This can't be done so concisely in Delphi 7
      SetLength( temp, L);
      for j := 1 to L do temp[j] := '0';
      temp := temp + SysUtils.IntToStr( E + D div 100);
      t := Length( temp);
      AddText( Copy( temp, t - L + 1, L));
      E := D mod 100;
      L := 2;
    end;
    dec( C, 7);
  until (C < 14);
  FlushText();

  // Delphi addition: Write screen output to a file for checking
  h := SysUtils.FileCreate( 'C:\Delphi\PiDigits.txt'); // h = file handle
  for j := 0 to memScreen.Lines.Count - 1 do
    SysUtils.FileWrite( h, memScreen.Lines[j][1], Length( memScreen.Lines[j]));
  SysUtils.FileClose( h);
end;

{=========================== Auxiliary routines ===========================}

// Form created
procedure TForm1.FormCreate(Sender: TObject);
begin
  fScreenWidth := 80; // in case not set by the algotithm
  ClearText();
end;

// This Delphi version builds each screen line in a buffer and puts
//   the line into the TMemo when the buffer is full.
// This is faster than writing to the TMemo a few characters at a time,
//   but note that the buffer must be flushed at the end of the program.
procedure TForm1.ClearText();
begin
  memScreen.Lines.Clear();
  fLineBuffer := '';
end;

procedure TForm1.AddText( const s : string);
var
  nrChars, nrLeft : integer;
begin
  nrChars := Length( s);
  nrLeft := fScreenWidth - Length( fLineBuffer); // nr chars left in line
  if (nrChars <= nrLeft) then fLineBuffer := fLineBuffer + s
  else begin
    fLineBuffer := fLineBuffer + Copy( s, 1, nrLeft);
    memScreen.Lines.Add( fLineBuffer);
    fLineBuffer := Copy( s, nrLeft + 1, nrChars - nrLeft);
  end;
end;

procedure TForm1.FlushText();
begin
  if (Length(fLineBuffer) > 0) then begin
    memScreen.Lines.Add( fLineBuffer);
    fLineBuffer := '';
  end;
end;

end.


[EDSAC program, Initial Orders 2.
 Calculates digits of pi by spigot algorithm.
 Easily edited to calculate digits of e (see "if pi" and "if e" in comments).
 Based on http://pi314.net/eng/goutte.php
 See also https://www.cut-the-knot.org/Curriculum/Algorithms/SpigotForPi.shtml

 Uses 17-bit values throughout.
 Array index and counters are stored in the address field,
   i.e. with the least significant bit in bit 1.
 For integer arithmetic, the least significant bit is bit 0.

 Variables don't need to be initialized at load time, so they overwrite
 locations 6..12 of initial orders to save space.]
      [6]   P      F  [index into remainder array]
      [7]   P      F  [carry in the spigot algorithm]
      [8]   P      F  [negative count of digits]
      [9]   P      F  [pending digit, always < 9]
     [10]   P      F  [negative count of pending 9's]
     [11]   P      F  [9 or 0 in top 5 bits, for printing]
     [12]   P      F  [negative count of characters in current line]

[Array corresponding to Remainder row on http://pi314.net/eng/goutte.php]
            T   53 K  [refer to array via B parameter]
            P   13 F  [start array immediately after variables]

 [Subroutine for short (17-bit) integer division.
  Input:  dividend at 4F, divisor at 5F.
  Output: remainder at 4F, quotient at 5F.
  Working locations 0F, 1F.  37 locations.]
            T  987 K
  [email protected]@[email protected]@[email protected]@[email protected]@
  [email protected]@[email protected]@[email protected]@EFPFPD

            T  845 K
            G      K
 [Constants]
 [Enter the editable numbers as addresses, e.g. P 100 F for 100.
  Reducing the maximum array index will make the program take less time.
  A maximum index of 831 (i.e. using all available memory) will give
  252 correct digits of pi, or 2070 correct digits of e.]
      [0]   P  831 F  [maximum array index <-- EDIT HERE, don't exceed 831]
      [1]   P  252 F  [number of digits    <-- EDIT HERE]
      [2]   P   72 F  [digits per line     <-- EDIT HERE]
      [3]   P      D  [short-value 1]
      [4]   P    5 F  [short-value 10]
      [5]   J      F  [10*(2^12)]
      [6]   X      F  [add to T order to make V order]
      [7]   M      F  [used to convert T order to A order]
      [8]   #      F  [figures shift (for printer)]
      [9]   @      F  [carriage return]
     [10]   &      F  [line feed]

 [Main routine. Enter with acc = 0.]
     [11]   O    8 @  [set printer to figures; also used to print '9']
            S    2 @  [load negative characters per line]
            T   12 F  [initialize character count]
            S    1 @  [load negated number of digits]
            T    8 F  [initialize digit count]
            T   10 F  [clear negative count of 9's]
            S    2 F  [load -2 (any value < -1 would do)]
            T    9 F  [initialize digit buffer]
       [Start algorithm: fill the remainder array with 2's (or 1's for e)
        The code is a bit neater if we work backwards.]
            A      @  [maximum index]
     [20]   A   81 @  [make T order for array entry]
            T   23 @  [plant in code]
[if pi]     A    2 F  [acc := 2]
[if e]     [A    3 @] [acc := 1]
     [23]   T      F  [store in array entry]
            A   23 @  [dec address in array]
            S    2 F
            S   81 @  [finished array?]
            E   20 @  [loop back if not

        Outer loop. Here for next digit.]
     [28]   T      F  [clear acc]
        [Multiply remainder array by 10.
         NB To preserve integer scaling, we need product times 2^16.]
            H    5 @  [mult reg := 10*(2^12)]
            A      @  [acc := maximum index]
     [31]   A   81 @  [make T order for array entry]
            U   37 @  [plant in code]
            A    6 @  [convert to V order, same address]
            T   35 @  [plant in code]
     [35]   V      F  [acc := array entry * 10*(2^12)]
            L    4 F  [shift to complete mult by 10*(2^16)]
     [37]   T      F  [store result in array]
            A   37 @  [load T order]
            S    2 F  [dec address]
            S   81 @  [test for done]
            E   31 @  [loop back if not]
            T      F  [clear acc]
            T    7 F  [clear carry]
            A      @  [acc := maximum index]
            T    6 F  [initialize array index]
       [Inner loop to get next digit.
        Work backwards through remainder array.]
     [46]   T      F  [clear acc]
            A    6 F  [load index]
            A   81 @  [make T order for array entry]
            U   61 @  [plant in code]
            A    7 @  [convert to A order]
            T   52 @  [plant in code]
     [52]   A      F  [load array element]
            A    7 F  [add carry from last time round loop]
            T    4 F  [sum to 4F for division routine]
            A    6 F  [acc := index as address = 2*(index as integer)]
[if pi]     A    3 @  [plus 1]
[if e]     [R      D] [shift right, address --> integer]
            T    5 F  [to 5F for division routine (for e, 5F = index/2)]
     [58]   A   58 @  [call routine to divide 4F by 5F]
            G  987 F
            A    4 F  [load remainder]
     [61]   T      F  [update element of remainder array]
[if pi: 4 orders]
            H    5 F  [mult reg := quotient]
            V    6 F  [multiply by index
                         NB need to shift 15 left to preserve integer scaling]
            L      F  [shift 13 left]
            L    1 F  [shift 2 more left (for e, just use quotient)
[if e: 1 order, plus 3 no-ops to keep addresses the same]
           [A    5 F] [load quotient]
           [XF XF XF]
            T    7 F  [update carry for next time round loop]
            A    6 F  [load index]
            S    2 F  [decrement]
            U    6 F  [store back]
       [We want to terminate after doing index = 1]
            S    2 F  [dec again]
            E   46 @  [jump back if index >= 1]
       [Treatment of index = 0 is different]
            T      F  [clear acc]
            A      B  [load rem{0)]
            A    7 F  [add carry]
            T    4 F  [sum to 4F for division routine]
            A    4 @  [load 10]
            T    5 F  [to 5F for division routine]
     [78]   A   78 @  [call division routine]
            G  987 F
            A    4 F  [load remainder]
     [81]   T      B  [store in rem{0}; also used to manufacture orders]
     [82]   A   82 @  [call subroutine to deal with quotient (clears acc)]
            G   93 @
            A    8 F  [load negative digit count]
            A    2 F  [increment]
            U    8 F  [store back]
            G   28 @  [if not yet 0, loop for next digit]
       [Fake a zero digit to flush the last genuine digit(s)]
            T    5 F  [store fake digit 0 in 5F]
     [89]   A   89 @  [call subroutine to deal with digit]
            G   93 @
            O    8 @  [set figures: dummy character to flush print buffer]
            Z      F  [stop]

       [Subroutine to handle buffering and printing of digits.
        Here with quotient from spigot algorithm still in 5F.
        The quotient at 5F is usually the new decimal digit.
        But the quotient can be 10, in which case we must treat it as 0
          and ripple a carry through the previously-computed digits.
        Hence the need for buffering.]
     [93]   A    3 F  [make and plant return link]
            T  130 @
            A    5 F  [load quotient]
            S    4 @  [subtract 10]
            E  105 @  [jump if quotient >= 10]
            A    3 @  [add 1]
            G  109 @  [jump if quotient < 9]
       [Here if quotient = 9. Update count of 9's,
        don't do anything with the buffer.]
            T      F  [clear acc]
            A   10 F  [load negative count of 9's]
            S    2 F  [subtract 1]
            T   10 F  [update count]
            E  130 @  [exit with acc = 0]
       [Here if quotient >= 10. Take digit = quotient - 10,
        and ripple a carry through the buffered digits.]
    [105]   T    5 F  [store (quotient - 10) formed above]
            T   11 F  [store 0 to print '0' not '9']
            A    3 @  [add 1 to buffered digit]
            E  112 @  [join common code]
       [Here if quotient < 9. Flush the stored digits.]
    [109]   T      F  [clear acc]
            A   11 @  [load any O order (code for O is 9)]
            T   11 F  [store to print '9']
    [112]   A    9 F  [load buffered digit, plus 1 if quotient >= 10]
            G  118 @  [skip printing if buffer is empty]
            L 1024 F  [shift digits to top 5 bits]
            T    1 F  [store in 1F for printing]
    [116]   A  116 @  [call print routine]
            G  131 @
    [118]   T      F  [clear acc]
            A    5 F  [load quotient (possibly modified as above)]
            T    9 F  [store in buffer]
    [121]   A   10 F  [load negative count of 9's]
            E  130 @  [if none, exit with acc = 0]
            A    2 F  [inc count]
            T   10 F
            A   11 F  [load 9 (or 0 if there's a carry)]
            T    1 F  [to 1F for printing]
    [127]   A  127 @  [call print routine  (clears acc)]
            G  131 @
            E  121 @  [jump back (always)]
    [130]   E      F  [return to caller]

       [Subroutine to print character at 1F.
        Also prints CR LF if necessary.]
    [131]   A    3 F [make and plant link for return]
            T  141 @
            A   12 F  [load negative character count]
            G  138 @  [jump if not end of line]
            S    2 @  [reset character count]
            O    9 @  [print CR LF]
            O   10 @
    [138]   O    1 F  [print character]
            A    2 F  [add 1]
            T   12 F
    [141]   E      F
            E   11 Z  [define entry point]
            P      F  [acc = 0 on entry]


defmodule Pi do
  def calc, do: calc(1,0,1,1,3,3,0)

  defp calc(q,r,t,k,n,l,c) when c==50 do
    IO.write "\n"
    calc(q,r,t,k,n,l,0)
  end
  defp calc(q,r,t,k,n,l,c) when (4*q + r - t) < n*t do
    IO.write n
    calc(q*10, 10*(r-n*t), t, k, div(10*(3*q+r), t) - 10*n, l, c+1)
  end
  defp calc(q,r,t,k,_n,l,c) do
    calc(q*k, (2*q+r)*l, t*l, k+1, div(q*7*k+2+r*l, t*l), l+2, c)
  end
end

Pi.calc


let rec g q r t k n l = seq {
    if 4I*q+r-t < n*t
    then
        yield n
        yield! (g (10I*q) (10I*(r-n*t)) t k ((10I*(3I*q+r))/t - 10I*n) l)
    else
        yield! (g (q*k) ((2I*q+r)*l) (t*l) (k+1I) ((q*(7I*k+2I)+r*l)/(t*l)) (l+2I))
}

let π = (g 1I 0I 1I 1I 3I 3I)

Seq.take 1 π |> Seq.iter (printf "%A.")
// 6 digits beginning at position 762 of π are '9'
Seq.take 767 (Seq.skip 1 π) |> Seq.iter (printf "%A")


USING: combinators.extras io kernel locals math prettyprint ;
IN: rosetta-code.pi

:: calc-pi-digits ( -- )
    1 0 1 1 3 3 :> ( q! r! t! k! n! l! ) [
        4 q * r + t - n t * < [
            n pprint flush
            r n t * - 10 *
            3 q * r + 10 * t /i n 10 * - n! r!
            q 10 * q!
        ] [
            2 q * r + l *
            7 k * q * 2 + r l * + t l * /i n! r!
            k q * q!
            t l * t!
            l 2 + l!
            k 1 + k!
        ] if
    ] forever ;

MAIN: calc-pi-digits


program pi
  implicit none
  integer,dimension(3350) :: vect
  integer,dimension(201) :: buffer
  integer :: more,karray,num,k,l,n
  more = 0
  vect = 2
  do n = 1,201
    karray = 0
    do l = 3350,1,-1
      num = 100000*vect(l) + karray*l
      karray = num/(2*l - 1)
      vect(l) = num - karray*(2*l - 1)
    end do
    k = karray/100000
    buffer(n) = more + k
    more = karray - k*100000
  end do
  write (*,'(i2,"."/(1x,10i5.5))') buffer
end program pi


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

' unbounded spigot
' Ctrl-c to end program or close console window

#Include "gmp.bi"

Dim As UInteger num, ndigit, fp = Not 0
Dim As mpz_ptr q,r,t,k,n,l,tmp1,tmp2
   q = Allocate(Len(__Mpz_struct)) : Mpz_init_set_ui(q,1)
   r = Allocate(Len(__Mpz_struct)) : Mpz_init(r)
   t = Allocate(Len(__Mpz_struct)) : Mpz_init_set_ui(t,1)
   k = Allocate(Len(__Mpz_struct)) : Mpz_init_set_ui(k,1)
   n = Allocate(Len(__Mpz_struct)) : Mpz_init_set_ui(n,3)
   l = Allocate(Len(__Mpz_struct)) : Mpz_init_set_ui(l,3)
tmp1 = Allocate(Len(__Mpz_struct)) : Mpz_init(tmp1)
tmp2 = Allocate(Len(__Mpz_struct)) : Mpz_init(tmp2)

Do
    mpz_mul_2exp(tmp1, q, 2)
    mpz_add(tmp1,tmp1,r)
    mpz_sub(tmp1,tmp1,t)
    mpz_mul(tmp2, n, t)
    If mpz_cmp(tmp1, tmp2) < 0 Then
        Print mpz_get_ui(n); : ndigit += 1 : If ndigit Mod 50 = 0 Then Print " :";ndigit
        If fp Then Print "."; : fp = Not fp : Print :ndigit = 0
        mpz_sub(tmp1, r, tmp2)
        mpz_mul_ui(tmp1, tmp1, 10)
        mpz_mul_ui(tmp2, q, 3)
        mpz_add(tmp2, tmp2, r)
        mpz_mul_ui(tmp2, tmp2, 10)
        mpz_set(r, tmp1)
        mpz_mul_ui(tmp1, n, 10)
        mpz_tdiv_q(tmp2, tmp2, t)
        mpz_sub(n, tmp2, tmp1)
        mpz_mul_ui(q, q, 10)
    Else
        mpz_mul(tmp2, r, l)
        mpz_mul(tmp1, q, k)
        mpz_mul_ui(tmp1, tmp1, 7)
        mpz_add(tmp1, tmp1, tmp2)
        mpz_mul_2exp(tmp2, q, 1)
        mpz_add(tmp2, tmp2, r)
        mpz_mul(tmp2, tmp2, l)
        mpz_mul(t, t, l)
        mpz_tdiv_q(tmp1, tmp1, t)
        mpz_mul(q, q, k)
        mpz_add_ui(k, k, 1)
        mpz_add_ui(l, l, 2)
        mpz_set(n, tmp1)
        mpz_set(r, tmp2)
    End If
Loop


PROC DrawTile(INT x BYTE y,flip,c1,c2)
  BYTE i

  Color=1
  FOR i=y+2 TO y+11
  DO
    Plot(x+1,i) DrawTo(x+5,i)
  OD
  Color=c1
  IF flip THEN
    Plot(x,y+12) DrawTo(x,y) DrawTo(x+6,y)
  ELSE
    Plot(x,y) DrawTo(x+6,y) DrawTo(x+6,y+12)
  FI
  Plot(x+1,y+1) DrawTo(x+5,y+1)
  Color=c2
  IF flip THEN
    Plot(x,y+13) DrawTo(x+6,y+13) DrawTo(x+6,y+1)
  ELSE
    Plot(x,y+1) DrawTo(x,y+13) DrawTo(x+6,y+13)
  FI
  Plot(x+1,y+12) DrawTo(x+5,y+12)
RETURN

PROC Draw()
  INT x,y,n
  BYTE flip,c1,c2

  FOR y=0 TO 8
  DO
    FOR x=0 TO 15
    DO
      n=(x-y)&15
      IF (n RSH 2)&1 THEN
        flip=1
      ELSE
        flip=0
      FI
      IF (n RSH 3)&1 THEN
        c1=3 c2=2
      ELSE
        c1=2 c2=3
      FI
      DrawTile(x*10,y*20+6,flip,c1,c2)
    OD
  OD
RETURN

PROC Main()
  BYTE CH=$02FC ;Internal hardware value for last key pressed
  BYTE PALNTSC=$D014 ;To check if PAL or NTSC system is used

  Graphics(15+16)
  IF PALNTSC=15 THEN
    SetColor(4,14,10) ;yellow for NTSC
    SetColor(0,8,4)   ;blue for NTSC
  ELSE
    SetColor(4,13,10) ;yellow for PAL
    SetColor(0,7,4)   ;blue for PAL
  FI
  SetColor(1,0,0)
  SetColor(2,0,14)
  Draw()

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


using Gtk, Colors, Cairo

function CodepenApp()
    # left-top, top-right, right-bottom, bottom-left
    LT, TR, RB, BL = 1, 2, 3, 4
    edges = [
        [LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB],
        [LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL],
        [TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL],
        [TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT],
        [RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT],
        [RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR],
        [BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR],
        [BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB],
        [LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB],
        [LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL],
        [TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL],
        [TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT]]
    W, B = colorant"white", colorant"darkgray"
    colors = [
        [W, B, B, W],
        [W, W, B, B],
        [B, W, W, B],
        [B, B, W, W]]
    win = GtkWindow("Peripheral drift illusion", 230, 230) |> (can = GtkCanvas())
    @guarded draw(can) do widget
        ctx = Gtk.getgc(can)
        function line(x1, y1, x2, y2, colr)
            set_source(ctx, colr)
            move_to(ctx, x1, y1)
            line_to(ctx, x2, y2)
            stroke(ctx)
        end
        set_source(ctx, colorant"yellow")
        rectangle(ctx, 0, 0, 250, 250)
        fill(ctx)
        set_line_width(ctx, 2)
        for x in 1:12
            px = 18 + x * 14
            for y in 1:12
                py = 18 + y * 14
                set_source(ctx, colorant"skyblue")
                rectangle(ctx, px, py, 10, 10)
                fill(ctx)
                carray = colors[edges[y][x]]
                line(px, py, px + 9, py, carray[1])
                line(px + 9, py, px + 9, py + 9, carray[2])
                line(px + 9, py + 9, px, py + 9, carray[3])
                line(px, py + 9, px, py, carray[4])
            end
        end
    end
    showall(win)
    draw(can)
    condition = Condition()
    endit(w) = notify(condition)
    signal_connect(endit, win, :destroy)
    showall(win)
    wait(condition)
end

CodepenApp()


import gintro/[glib, gobject, gtk, gio, cairo]

const
  Width = 600
  Height = 460

type
  Color = array[3, float]
  Edge {.pure.} = enum LT, TR, RB, BL

const

  Edges = [[LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB],
           [LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL],
           [TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL],
           [TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT],
           [RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT],
           [RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR, TR],
           [BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB, TR],
           [BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB, RB],
           [LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL, RB],
           [LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL, BL],
           [TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT, BL],
           [TR, TR, LT, LT, BL, BL, RB, RB, TR, TR, LT, LT]]

  Black: Color = [0.0, 0.0, 0.0]
  Blue: Color = [0.2, 0.3, 1.0]
  White: Color = [1.0, 1.0, 1.0]
  Yellow: Color = [0.8, 0.8, 0.0]

  Colors: array[Edge, array[4, Color]] = [[White, Black, Black, White],
                                          [White, White, Black, Black],
                                          [Black, White, White, Black],
                                          [Black, Black, White, White]]

#---------------------------------------------------------------------------------------------------

proc draw(area: DrawingArea; context: Context) =
  ## Draw the pattern in the area.

  func line(x1, y1, x2, y2: float; color: Color) =
    context.setSource(color)
    context.moveTo(x1, y1)
    context.lineTo(x2, y2)
    context.stroke

  context.setSource(Yellow)
  context.rectangle(0, 0, Width, Height)
  context.fill()

  for x in 0..11:
    let px = float(86 + x * 36)
    for y in 0..11:
      let py = float(16 + y * 36)
      context.setSource(Blue)
      context.rectangle(px, py, 24, 24)
      context.fill()
      let carray = Colors[Edges[y][x]]
      context.setLineWidth(2)
      line(px, py, px + 23, py, carray[0])
      line(px + 23, py, px + 23, py + 23, carray[1])
      line(px + 23, py + 23, px, py + 23, carray[2])
      line(px, py + 23, px, py, carray[3])

#---------------------------------------------------------------------------------------------------

proc onDraw(area: DrawingArea; context: Context; data: pointer): bool =
  ## Callback to draw/redraw the drawing area contents.

  area.draw(context)
  result = true

#---------------------------------------------------------------------------------------------------

proc activate(app: Application) =
  ## Activate the application.

  let window = app.newApplicationWindow()
  window.setSizeRequest(Width, Height)
  window.setTitle("Peripheral drift illusion")

  # Create the drawing area.
  let area = newDrawingArea()
  window.add(area)

  # Connect the "draw" event to the callback to draw the pattern.
  discard area.connect("draw", ondraw, pointer(nil))

  window.showAll()

#———————————————————————————————————————————————————————————————————————————————————————————————————

let app = newApplication(Application, "Rosetta.Illusion")
discard app.connect("activate", activate)
discard app.run()


use strict;
use warnings;

my $svg = <<'EOD';
<svg xmlns="http://www.w3.org/2000/svg"
     xmlns:svg="http://www.w3.org/2000/svg"
     xmlns:xlink="http://www.w3.org/1999/xlink" width="1200" height="825">
     <rect width="100%" height="100%" fill="#d3d004" />
     <defs>
        <g id="block">
            <polygon points="-25,-25,-25,25,25,25" fill="white" />
            <polygon points="25,25,25,-25,-25,-25" fill="black" />
            <rect x="-20" y="-20" width="40" height="40" fill="#3250ff" />
        </g>
     </defs>
EOD

for my $X (1..15) {
   for my $Y (1..10) {
    my $r = int(($X + $Y) / 2) % 4 * 90;
    my $x = $X * 75;
    my $y = $Y * 75;
    my $a = $r > 0 ? "rotate($r,$x,$y) " : '';
    $svg .= qq{<use xlink:href="#block" transform="$a translate($x,$y)" />\n}
  }
}
$svg .= '</svg>';

open my $fh, '>', 'peripheral-drift.svg';
print $fh $svg;
close $fh;


def compute_pi =
  def g( q, r, t, k, n, l ) =
    if 4*q + r - t < n*t
      n # g( 10*q, 10*(r - n*t), t, k, (10*(3*q + r))\t - 10*n, l )
    else
      g( q*k, (2*q + r)*l, t*l, k + 1, (q*(7*k + 2) + r*l)\(t*l), l + 2 )

  g( 1, 0, 1, 1, 3, 3 )

if _name_ == '-main-'
  print( compute_pi().head() + '.' )

  if args.isEmpty()
    for d <- compute_pi().tail()
      print( d )
  else
    for d <- compute_pi().tail().take( int(args(0)) )
      print( d )

    println()


include "ConsoleWindow"

dim as long  kf, ks
xref mf(_maxLong - 1) as long
xref ms(_maxLong - 1) as long
dim as long  cnt, n, temp, nd
dim as long  col, col1
dim as long  lloc, stor(50)

end globals

local mode
local fn FmtStr( nn as long, s as Str255 ) as Str255
dim l as long
dim as Str255 f
l = s[0]
select case
   case ( nn => l )
      f = string$( nn-l, 32 ) + s
   case ( -nn > l)
      f = s + string$( -nn-l, 32 )
   case else
      f = s
   end select
end fn = f

local mode
local fn FmtInt( nn as long, s as Str255 ) as Str255
if ( left$( s, 1 ) = " " ) then s = mid$( s, 2 )
end fn = fn FmtStr( nn, s )

local fn yprint( m as long )
if ( cnt < n )
   col++
   if ( col == 11 )
      col = 1
      col1++
         long if ( col1 == 6 )
            col1 = 0
            print
            print fn FmtInt( 4, str$( m mod 10) );
         else
            print fn FmtInt( 3, str$ (m mod 10) );
         end if
    else
       print mid$( str$( m ), 2 ) ;
    end if
    cnt++
end if
end fn

local fn xprint( m as long)
dim as long ii, wk, wk1

if ( m < 8 )
   ii = 1
      while ( ii <= lloc )
         fn yprint( stor(ii) )
         ii++
      wend
lloc = 0
else
   if ( m > 9 )
       wk = m / 10
       m = m mod 10
       wk1 = lloc
          while ( wk1 >= 1 )
             wk += stor(wk1)
             stor(wk1) = wk mod 10
             wk = wk/10
             wk1--
          wend
    end if
end if
lloc++
stor(lloc) = m
end fn

local mode
local fn shift( l1 as ^long, l2 as ^long, lp as long, lmod as long )
dim as long k

if ( l2.nil& > 0 )
   k = ( l2.nil& ) / lmod
else
   k =  -( -l2.nil&  / lmod ) - 1
end if
l2.nil& = l2.nil& - k*lmod
l1.nil& = l1.nil& + k*lp
end fn

local fn Main( nDig as long )
dim as long i

n = nDig
stor(0) = 0

mf = fn malloc( ( n + 10 ) * sizeof(long) )
if ( 0 == mf ) then stop "Out of memory"

ms = fn malloc( ( n + 10 ) * sizeof(long) )
if ( 0 == ms ) then stop "Out of memory"

print : print "Approximation of π to"; n; " digits"

cnt = 0
kf  = 25
ks  = 57121
mf(1) = 1

i = 2
while ( i <= n )
   mf(i)     = -16
   mf(i + 1) =  16
   i += 2
wend

i = 1
while ( i <= n )
   ms(i)     = -4
   ms(i + 1) =  4
   i += 2
wend

print : print " 3.";

while ( cnt < n )
   i = 0
   i++
   while ( i <= n - cnt )
      mf(i) = mf(i) * 10
      ms(i) = ms(i) * 10
      i++
    wend

   i = ( n - cnt + 1 )
   i--
   while ( i >= 2 )
      temp = 2 * i - 1
      fn shift( @mf(i - 1), @mf(i), temp - 2, temp * kf )
      fn shift( @ms(i - 1), @ms(i), temp - 2, temp * ks )
      i--
    wend

nd = 0

fn shift( @nd, @mf(1), 1, 5 )
fn shift( @nd, @ms(1), 1, 239 )
fn xprint( nd )

wend

print : print "Done"
fn free( ms )
fn free( mf )
end fn

dim as unsigned long   ticks
ticks = fn TickCount()
// Here we specify the number of decimal places
fn Main( 4000 )
ticks = fn TickCount() - ticks
print "Elapsed time:" str$( ticks ) " ticks


package main

import (
    "fmt"
    "math/big"
)

type lft struct {
    q,r,s,t big.Int
}

func (t *lft) extr(x *big.Int) *big.Rat {
    var n, d big.Int
    var r big.Rat
    return r.SetFrac(
        n.Add(n.Mul(&t.q, x), &t.r),
        d.Add(d.Mul(&t.s, x), &t.t))
}

var three = big.NewInt(3)
var four = big.NewInt(4)

func (t *lft) next() *big.Int {
    r := t.extr(three)
    var f big.Int
    return f.Div(r.Num(), r.Denom())
}

func (t *lft) safe(n *big.Int) bool {
    r := t.extr(four)
    var f big.Int
    if n.Cmp(f.Div(r.Num(), r.Denom())) == 0 {
        return true
    }
    return false
}

func (t *lft) comp(u *lft) *lft {
    var r lft
    var a, b big.Int
    r.q.Add(a.Mul(&t.q, &u.q), b.Mul(&t.r, &u.s))
    r.r.Add(a.Mul(&t.q, &u.r), b.Mul(&t.r, &u.t))
    r.s.Add(a.Mul(&t.s, &u.q), b.Mul(&t.t, &u.s))
    r.t.Add(a.Mul(&t.s, &u.r), b.Mul(&t.t, &u.t))
    return &r
}

func (t *lft) prod(n *big.Int) *lft {
    var r lft
    r.q.SetInt64(10)
    r.r.Mul(r.r.SetInt64(-10), n)
    r.t.SetInt64(1)
    return r.comp(t)
}

func main() {
    // init z to unit
    z := new(lft)
    z.q.SetInt64(1)
    z.t.SetInt64(1)

    // lfts generator
    var k int64
    lfts := func() *lft {
        k++
        r := new(lft)
        r.q.SetInt64(k)
        r.r.SetInt64(4*k+2)
        r.t.SetInt64(2*k+1)
        return r
    }

    // stream
    for {
        y := z.next()
        if z.safe(y) {
            fmt.Print(y)
            z = z.prod(y)
        } else {
            z = z.comp(lfts())
        }
    }
}