(* AST *)
datatype expression =
	  Con of int				(* constant *)
	| Add of expression * expression	(* addition *)
	| Mul of expression * expression	(* multiplication *)
	| Sub of expression * expression	(* subtraction *)
	| Div of expression * expression	(* division *)

(* Evaluator *)
fun eval (Con x)      = x
  | eval (Add (x, y)) = (eval x)  +  (eval y)
  | eval (Mul (x, y)) = (eval x)  *  (eval y)
  | eval (Sub (x, y)) = (eval x)  -  (eval y)
  | eval (Div (x, y)) = (eval x) div (eval y)

(* Lexer *)
datatype token =
	  CON of int
	| ADD
	| MUL
	| SUB
	| DIV
	| LPAR
	| RPAR

fun lex nil = nil
  | lex (#"+" :: cs) = ADD :: lex cs
  | lex (#"*" :: cs) = MUL :: lex cs
  | lex (#"-" :: cs) = SUB :: lex cs
  | lex (#"/" :: cs) = DIV :: lex cs
  | lex (#"(" :: cs) = LPAR :: lex cs
  | lex (#")" :: cs) = RPAR :: lex cs
  | lex (#"~" :: cs) = if null cs orelse not (Char.isDigit (hd cs)) then raise Domain
                       else lexDigit (0, cs, ~1)
  | lex (c    :: cs) = if Char.isDigit c then lexDigit (0, c :: cs, 1)
                       else raise Domain

and lexDigit (a, cs, s) = if null cs orelse not (Char.isDigit (hd cs)) then CON (a*s) :: lex cs
                          else lexDigit (a * 10 + (ord (hd cs))- (ord #"0") , tl cs, s)

(* Parser *)
exception Error of string

fun match (a,ts) t = if null ts orelse hd ts <> t
                     then raise Error "match"
		     else (a, tl ts)

fun extend (a,ts) p f = let val (a',tr) = p ts in (f(a,a'), tr) end

fun parseE  ts             = parseE' (parseM ts)
and parseE' (e, ADD :: ts) = parseE' (extend (e, ts) parseM Add)
  | parseE' (e, SUB :: ts) = parseE' (extend (e, ts) parseM Sub)
  | parseE' s = s

and parseM  ts             = parseM' (parseP ts)
and parseM' (e, MUL :: ts) = parseM' (extend (e, ts) parseP Mul)
  | parseM' (e, DIV :: ts) = parseM' (extend (e, ts) parseP Div)
  | parseM' s = s

and parseP (CON c :: ts) = (Con c, ts)
  | parseP (LPAR  :: ts) = match (parseE ts) RPAR
  | parseP _ = raise Error "parseP"

(* Test *)
fun lex_parse_eval (str:string) =
	case parseE (lex (explode str)) of
	   (exp, nil) => eval exp
	 | _          => raise Error "not parseable stuff at the end"


def ops: ['+','-','*','/'];

data binaryExpression <{left: <node>, op: <?($ops <[<=$::raw>]>)>, right: <node>}>
data node <binaryExpression|"1">

composer parseArithmetic
  (<WS>?) <addition|multiplication|term> (<WS>?)
  rule addition: {left:<addition|multiplication|term> (<WS>?) op:<'[+-]'> (<WS>?) right:<multiplication|term>}
  rule multiplication: {left:<multiplication|term> (<WS>?) op:<'[*/]'> (<WS>?) right:<term>}
  rule term: <INT"1"|parentheses>
  rule parentheses: (<'\('> <WS>?) <addition|multiplication|term> (<WS>? <'\)'>)
end parseArithmetic

templates evaluateArithmetic
  <{op: <='+'>}> ($.left -> evaluateArithmetic) + ($.right -> evaluateArithmetic) !
  <{op: <='-'>}> ($.left -> evaluateArithmetic) - ($.right -> evaluateArithmetic) !
  <{op: <='*'>}> ($.left -> evaluateArithmetic) * ($.right -> evaluateArithmetic) !
  <{op: <='/'>}> ($.left -> evaluateArithmetic) ~/ ($.right -> evaluateArithmetic) !
  otherwise $ !
end evaluateArithmetic

def ast: '(100 - 5 * (2+3*4) + 2) / 2' -> parseArithmetic;
'$ast;
' -> !OUT::write
'$ast -> evaluateArithmetic;
' -> !OUT::write


/*REXX program to show anonymous recursion  (of a function or subroutine).              */
numeric digits 1e6                               /*in case the user goes ka-razy with X.*/
parse arg x .                                    /*obtain the optional argument from CL.*/
if x=='' | x==","  then x= 12                    /*Not specified?  Then use the default.*/
w= length(x)                                     /*W:  used for formatting the output.  */
                   do j=0  for x+1               /*use the  argument  as an upper limit.*/
                   say 'fibonacci('right(j, w)") ="   fib(j)
                   end  /*j*/                    /* [↑] show Fibonacci sequence: 0 ──► X*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fib: procedure; parse arg z;  if z>=0  then return .(z)
                              say "***error***  argument can't be negative.";   exit
.:   procedure; parse arg #;  if #<2  then return #;              return .(#-1)  +  .(#-2)


# Project : Anonymous recursion

t=0
for x = -2 to 12
     n = x
     recursion()
     if x > -1
        see t + nl
     ok
next

func recursion()
        nold1=1
        nold2=0
        if n < 0
           see "positive argument required!" + nl
           return
        ok
        if n=0
           t=nold2
           return t
        ok
        if n=1
           t=nold1
           return  t
        ok
        while n
                  t=nold2+nold1
                  if n>2
                     n=n-1
                     nold2=nold1
                     nold1=t
                     loop
                  ok
                  return t
        end
        return t


namespace import tcl::mathop::*

proc ast str {
    # produce abstract syntax tree for an expression
    regsub -all {[-+*/()]} $str { & } str ;# "tokenizer"
    s $str
}
proc s {args} {
    # parse "(a + b) * c + d" to "+ [* [+ a b] c] d"
    if {[llength $args] == 1} {set args [lindex $args 0]}
    if [regexp {[()]} $args] {
        eval s [string map {( "\[s " ) \]} $args]
    } elseif {"*" in $args} {
	s [s_group $args *]
    } elseif {"/" in $args} {
	s [s_group $args /]
    } elseif {"+" in $args} {
        s [s_group $args +]
    } elseif {"-" in $args} {
        s [s_group $args -]
    } else {
        string map {\{ \[ \} \]} [join $args]
    }
}
proc s_group {list op} {
    # turn ".. a op b .." to ".. {op a b} .."
    set pos [lsearch -exact $list $op]
    set p_1 [- $pos 1]
    set p1  [+ $pos 1]
    lreplace $list $p_1 $p1 \
                  [list $op [lindex $list $p_1] [lindex $list $p1]]
}
#-- Test suite
foreach test [split {
    ast 2-2
    ast 1-2-3
    ast (1-2)-3
    ast 1-(2-3)
    ast (1+2)*3
    ast (1+2)/3-4*5
    ast ((1+2)/3-4)*5
} \n] {
    puts "$test ..... [eval $test] ..... [eval [eval $test]]"
}


def fib(n)
  raise RangeError, "fib of negative" if n < 0
  (fib2 = proc { |m| m < 2 ? m : fib2[m - 1] + fib2[m - 2] })[n]
end


fn fib(n: i64) -> Option<i64> {
    // A function declared inside another function does not pollute the outer namespace.
    fn actual_fib(n: i64) -> i64 {
        if n < 2 {
            n
        } else {
            actual_fib(n - 1) + actual_fib(n - 2)
        }
    }

    if n < 0 {
        None
    } else {
        Some(actual_fib(n))
    }
}

fn main() {
    println!("Fib(-1) = {:?}", fib(-1));
    println!("Fib(0) = {:?}", fib(0));
    println!("Fib(1) = {:?}", fib(1));
    println!("Fib(2) = {:?}", fib(2));
    println!("Fib(3) = {:?}", fib(3));
    println!("Fib(4) = {:?}", fib(4));
    println!("Fib(5) = {:?}", fib(5));
    println!("Fib(10) = {:?}", fib(10));
}

#[test]
fn test_fib() {
    assert_eq!(fib(0).unwrap(), 0);
    assert_eq!(fib(1).unwrap(), 1);
    assert_eq!(fib(2).unwrap(), 1);
    assert_eq!(fib(3).unwrap(), 2);
    assert_eq!(fib(4).unwrap(), 3);
    assert_eq!(fib(5).unwrap(), 5);
    assert_eq!(fib(10).unwrap(), 55);
}

#[test]
fn test_invalid_argument() {
    assert_eq!(fib(-1), None);
}


def Y[A, B](f: (A ⇒ B) ⇒ (A ⇒ B)): A ⇒ B = f(Y(f))(_)

def fib(n: Int): Option[Int] =
  if (n < 0) None
  else Some(Y[Int, Int](f ⇒ i ⇒
    if (i < 2) 1
    else f(i - 1) + f(i - 2))(n))

-2 to 5 map (n ⇒ (n, fib(n))) foreach println


@(next :args)
@(define space)@/ */@(end)
@(define mulop (nod))@\
   @(local op)@\
   @(space)@\
   @(cases)@\
     @{op /[*]/}@(bind nod @(intern op *user-package*))@\
   @(or)@\
     @{op /\//}@(bind (nod) @(list 'trunc))@\
   @(end)@\
   @(space)@\
@(end)
@(define addop (nod))@\
   @(local op)@(space)@{op /[+\-]/}@(space)@\
   @(bind nod @(intern op *user-package*))@\
@(end)
@(define number (nod))@\
  @(local n)@(space)@{n /[0-9]+/}@(space)@\
  @(bind nod @(int-str n 10))@\
@(end)
@(define factor (nod))@(cases)(@(expr nod))@(or)@(number nod)@(end)@(end)
@(define term (nod))@\
  @(local op nod1 nod2)@\
  @(cases)@\
    @(factor nod1)@\
    @(cases)@(mulop op)@(term nod2)@(bind nod (op nod1 nod2))@\
    @(or)@(bind nod nod1)@\
    @(end)@\
  @(or)@\
    @(addop op)@(factor nod1)@\
    @(bind nod (op nod1))@\
  @(end)@\
@(end)
@(define expr (nod))@\
  @(local op nod1 nod2)@\
  @(term nod1)@\
  @(cases)@(addop op)@(expr nod2)@(bind nod (op nod1 nod2))@\
  @(or)@(bind nod nod1)@\
  @(end)@\
@(end)
@(cases)
@  {source (expr e)}
@  (output)
source: @source
AST:    @(format nil "~s" e)
value:  @(eval e nil)
@  (end)
@(or)
@  (maybe)@(expr e)@(end)@bad
@  (output)
erroneous suffix "@bad"
@  (end)
@(end)


#import std
#import nat
#import flo

lex = ~=' '*~F+ rlc both -=digits    # separate into tokens

parse = # build a tree

--<';'>; @iNX ~&l->rh ^/~&lt cases~&lhh\~&lhPNVrC {
   '*/': ^|C/~&hNV associate '*/',
   '+-': ^|C/~&hNV associate '*/+-',
   ');': @r ~&htitBPC+ associate '*/+-'}

associate "ops" = ~&tihdh2B-="ops"-> ~&thd2tth2hNCCVttt2C

traverse = *^ ~&v?\%ep ^H\~&vhthPX '+-*/'-$<plus,minus,times,div>@dh

evaluate = traverse+ parse+ lex


(define (fibonacci n)
  (if (> 0 n)
      "Error: argument must not be negative."
      (let aux ((a 1) (b 0) (count n))
        (if (= count 0)
            b
            (aux (+ a b) a (- count 1))))))

(map fibonacci '(1 2 3 4 5 6 7 8 9 10))


$ include "seed7_05.s7i";

const func integer: fib (in integer: x) is func
  result
    var integer: fib is 0;
  local
    const func integer: fib1 (in integer: n) is func
      result
        var integer: fib1 is 0;
      begin
        if n < 2 then
          fib1 := n;
        else
          fib1 := fib1(n-2) + fib1(n-1);
        end if;
      end func;
  begin
    if x < 0 then
      raise RANGE_ERROR;
    else
      fib := fib1(x);
    end if;
  end func;

const proc: main is func
  local
    var integer: i is 0;
  begin
    for i range 0 to 4 do
      writeln(fib(i));
    end for;
  end func;


import "/pattern" for Pattern

/* if string is empty, returns zero */
var toDoubleOrZero = Fn.new { |s|
    var n = Num.fromString(s)
    return n ? n : 0
}

var multiply = Fn.new { |s|
    var b = s.split("*").map { |t| toDoubleOrZero.call(t) }.toList
    return (b[0] * b[1]).toString
}

var divide = Fn.new { |s|
    var b = s.split("/").map { |t| toDoubleOrZero.call(t) }.toList
    return (b[0] / b[1]).toString
}

var add = Fn.new { |s|
    var p1 = Pattern.new("/+", Pattern.start)
    var p2 = Pattern.new("+1/+")
    var t = p1.replaceAll(s, "")
    t = p2.replaceAll(t, "+")
    var b = t.split("+").map { |u| toDoubleOrZero.call(u) }.toList
    return (b[0] + b[1]).toString
}

var subtract = Fn.new { |s|
    var p = Pattern.new("[/+-|-/+]")
    var t = p.replaceAll(s, "-")
    if (t.contains("--")) return add.call(t.replace("--", "+"))
    var b = t.split("-").map { |u| toDoubleOrZero.call(u) }.toList
    return ((b.count == 3) ? -b[1] - b[2] : b[0] - b[1]).toString
}

var evalExp = Fn.new { |s|
    var p = Pattern.new("[(|)|/s]")
    var t = p.replaceAll(s, "")
    var i = "*/"
    var pMD = Pattern.new("+1/f/i~/n+1/f", Pattern.within, i)
    var pM  = Pattern.new("*")
    var pAS = Pattern.new("~-+1/f+1/n+1/f")
    var pA  = Pattern.new("/d/+")

    while (true) {
        var match = pMD.find(t)
        if (!match) break
        var exp = match.text
        var match2 = pM.find(exp)
        t = match2 ? t.replace(exp, multiply.call(exp)) : t.replace(exp, divide.call(exp))
    }

    while (true) {
        var match = pAS.find(t)
        if (!match) break
        var exp = match.text
        var match2 = pA.find(exp)
        t = match2 ? t.replace(exp, add.call(exp)) : t.replace(exp, subtract.call(exp))
    }
    return t
}

var evalArithmeticExp = Fn.new { |s|
    var p1 = Pattern.new("/s")
    var p2 = Pattern.new("/+", Pattern.start)
    var t = p1.replaceAll(s, "")
    t = p2.replaceAll(t, "")
    var i = "()"
    var pPara = Pattern.new("(+0/I)", Pattern.within, i)
    while (true) {
        var match = pPara.find(t)
        if (!match) break
        var exp = match.text
        t = t.replace(exp, evalExp.call(exp))
    }
    return toDoubleOrZero.call(evalExp.call(t))
}

[
    "2+3",
    "2+3/4",
    "2*3-4",
    "2*(3+4)+5/6",
    "2 * (3 + (4 * 5 + (6 * 7) * 8) - 9) * 10",
    "2*-3--4+-0.25",
    "-4 - 3",
    "((((2))))+ 3 * 5",
    "1 + 2 * (3 + (4 * 5 + 6 * 7 * 8) - 9) / 10",
    "1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1"
].each { |s| System.print("%(s) = %(evalArithmeticExp.call(s))") }


func fib(n) {
    return NaN if (n < 0)

    func (n) {
        n < 2 ? n
              : (__FUNC__(n-1) + __FUNC__(n-2))
    }(n)
}


myMethodComputingFib:arg
    |_|

    ^ (_ := [:n | n <= 1
                    ifTrue:[n]
                    ifFalse:[(_ value:(n - 1))+(_ value:(n - 2))]]
      ) value:arg.


function(n, f) {
    return f(n, f);
}(10, function(n, f) {
    return n < 2 ? 1 : f(n - 1, f) + f(n - 2, f);
})


10 PRINT "Use integer numbers and signs"'"+ - * / ( )"''
20 LET s$="": REM last symbol
30 LET pc=0: REM parenthesis counter
40 LET i$="1+2*(3+(4*5+6*7*8)-9)/10"
50 PRINT "Input = ";i$
60 FOR n=1 TO LEN i$
70 LET c$=i$(n)
80 IF c$>="0" AND c$<="9" THEN GO SUB 170: GO TO 130
90 IF c$="+" OR c$="-" THEN GO SUB 200: GO TO 130
100 IF c$="*" OR c$="/" THEN GO SUB 200: GO TO 130
110 IF c$="(" OR c$=")" THEN GO SUB 230: GO TO 130
120 GO TO 300
130 NEXT n
140 IF pc>0 THEN PRINT FLASH 1;"Parentheses not paired.": BEEP 1,-25: STOP
150 PRINT "Result = ";VAL i$
160 STOP
170 IF s$=")" THEN GO TO 300
180 LET s$=c$
190 RETURN
200 IF (NOT (s$>="0" AND s$<="9")) AND s$<>")" THEN GO TO 300
210 LET s$=c$
220 RETURN
230 IF c$="(" AND ((s$>="0" AND s$<="9") OR s$=")") THEN GO TO 300
240 IF c$=")" AND ((NOT (s$>="0" AND s$<="9")) OR s$="(") THEN GO TO 300
250 LET s$=c$
260 IF c$="(" THEN LET pc=pc+1: RETURN
270 LET pc=pc-1
280 IF pc<0 THEN GO TO 300
290 RETURN
300 PRINT FLASH 1;"Invalid symbol ";c$;" detected in pos ";n: BEEP 1,-25
310 STOP


fun fix f x = f (fix f) x

fun fib n =
    if n < 0 then raise Fail "Negative"
    else
        fix (fn fib =>
                (fn 0 => 0
                | 1 => 1
                | n => fib (n-1) + fib (n-2))) n


let fib: Int -> Int = {
  func f(n: Int) -> Int {
    assert(n >= 0, "fib: no negative numbers")
    return n < 2 ? 1 : f(n-1) + f(n-2)
  }
  return f
}()

print(fib(8))


V array = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]
V arrsq = array.map(i -> i * i)
print(arrsq)


proc fib n {
    # sanity checks
    if {[incr n 0] < 0} {error "argument may not be negative"}
    apply {x {
	if {$x < 2} {return $x}
	# Extract the lambda term from the stack introspector for brevity
	set f [lindex [info level 0] 1]
	expr {[apply $f [incr x -1]] + [apply $f [incr x -1]]}
    }} $n
}


define SRC_LO  $00
define SRC_HI  $01

define DEST_LO $02
define DEST_HI $03

define temp $04		;temp storage used by foo

;some prep work since easy6502 doesn't allow you to define arbitrary bytes before runtime.

SET_TABLE:
TXA
STA $1000,X
INX
BNE SET_TABLE
;stores the identity table at memory address $1000-$10FF

CLEAR_TABLE:
LDA #0
STA $1200,X
INX
BNE CLEAR_TABLE
;fills the range $1200-$12FF with zeroes.

LDA #$10
STA SRC_HI
LDA #$00
STA SRC_LO
;store memory address $1000 in zero page

LDA #$12
STA DEST_HI
LDA #$00
STA DEST_LO
;store memory address $1200 in zero page

loop:
LDA (SRC_LO),y  ;load accumulator from memory address $1000+y
JSR foo		;multiplies accumulator by 3.
STA (DEST_LO),y ;store accumulator in memory address $1200+y

INY
CPY #$56 ;alternatively you can store a size variable and check that here instead.
BCC loop
BRK

foo:
STA temp
ASL		;double accumulator
CLC
ADC temp	;2a + a = 3a
RTS


LEA MyArray,A0
MOVE.W #(MyArray_End-MyArray)-1,D7  ;Len(MyArray)-1
MOVEQ #0,D0 ;sanitize D0-D2 to ensure nothing from any previous work will affect our math.
MOVEQ #0,D1
MOVEQ #0,D2

loop:
MOVE.B (A0),D0
MOVE.B D0,D1
MOVE.B D0,D2
MULU D1,D2
MOVE.B D2,(A0)+
dbra d7,loop
jmp *       ;halt the CPU

MyArray:
DC.B 1,2,3,4,5,6,7,8,9,10
MyArray_End:


FUNCTION Fibonacci (num)
    IF num < 0 THEN
       PRINT "Invalid argument: ";
       LET Fibonacci = num
    END IF

    IF num < 2 THEN
       LET Fibonacci = num
    ELSE
       LET Fibonacci = Fibonacci(num - 1) + Fibonacci(num - 2)
    END IF
END FUNCTION

PRINT Fibonacci(20)
PRINT Fibonacci(30)
PRINT Fibonacci(-10)
PRINT Fibonacci(10)
END


(defmacro recursive ((. parm-init-pairs) . body)
  (let ((hidden-name (gensym "RECURSIVE-")))
    ^(macrolet ((recurse (. args) ^(,',hidden-name ,*args)))
       (labels ((,hidden-name (,*[mapcar first parm-init-pairs]) ,*body))
         (,hidden-name ,*[mapcar second parm-init-pairs])))))

(defun fib (number)
  (if (< number 0)
    (error "Error. The number entered: ~a is negative" number)
    (recursive ((n number) (a 0) (b 1))
      (if (= n 0)
        a
        (recurse (- n 1) b (+ a b))))))

(put-line `fib(10) = @(fib 10)`)
(put-line `fib(-1) = @(fib -1)`))


fib() {
  if test 0 -gt "$1"; then
    echo "fib: fib of negative" 1>&2
    return 1
  else
    (
      fib2() {
        if test 2 -gt "$1"; then
          echo "$1"
        else
          echo $(( $(fib2 $(($1 - 1)) ) + $(fib2 $(($1 - 2)) ) ))
        fi
      }
      fib2 "$1"
    )
  fi
}


(defun apply-to-each (xs)
   (if (endp xs)
       nil
       (cons (fn-to-apply (first xs))
             (sq-each (rest xs)))))

(defun fn-to-apply (x)
   (* x x))


package
{
    public class ArrayCallback
    {
        public function main():void
        {
            var nums:Array = new Array(1, 2, 3);
            nums.map(function(n:Number, index:int, arr:Array):void { trace(n * n * n); });

            // You can also pass a function reference
            nums.map(cube);
        }

        private function cube(n:Number, index:int, arr:Array):void
        {
            trace(n * n * n);
        }
    }
}


#import nat

fib =

~&izZB?(                    # test the sign bit of the argument
   <'fib of negative'>!%,   # throw an exception if it's negative
   {0,1}^?<a(               # test the argument to a recursively defined function
      ~&a,                  # if the argument was a member of {0,1}, return it
      sum^|W(               # otherwise return the sum of two recursive calls
         ~&,                # to the function thus defined
         predecessor^~(     # with the respective predecessors of
            ~&,             # the given argument
            predecessor)))) # and the predecessor thereof


···
http://rosettacode.org/wiki/Anonymous_recursion
···
⟦import java.util.function.UnaryOperator;⟧

■ AnonymousRecursion
  § static
    ▶ main
    • args⦂ String[]
      if 0 > Integer.valueOf args[0]
         System.out.println "negative argument"
      else
         System.out.println *UnaryOperator⟨Integer⟩° ■
           ▶ apply⦂ Integer
           • n⦂ Integer
             ⏎ n ≤ 1 ? n ! (apply n - 1) + (apply n - 2)
         °.apply Integer.valueOf args[0]


Sub Main()
Debug.Print F(-10)
Debug.Print F(10)
End Sub

Private Function F(N As Long) As Variant
    If N < 0 Then
        F = "Error. Negative argument"
    ElseIf N <= 1 Then
        F = N
    Else
        F = F(N - 1) + F(N - 2)
    End If
End Function


with Ada.Text_Io;
 with Ada.Integer_text_IO;

 procedure Call_Back_Example is
    -- Purpose: Apply a callback to an array
    -- Output: Prints the squares of an integer array to the console

    -- Define the callback procedure
    procedure Display(Location : Positive; Value : Integer) is
    begin
       Ada.Text_Io.Put("array(");
       Ada.Integer_Text_Io.Put(Item => Location, Width => 1);
       Ada.Text_Io.Put(") = ");
       Ada.Integer_Text_Io.Put(Item => Value * Value, Width => 1);
       Ada.Text_Io.New_Line;
    end Display;

    -- Define an access type matching the signature of the callback procedure
    type Call_Back_Access is access procedure(L : Positive; V : Integer);

    -- Define an unconstrained array type
    type Value_Array is array(Positive range <>) of Integer;

    -- Define the procedure performing the callback
    procedure Map(Values : Value_Array; Worker : Call_Back_Access) is
    begin
       for I in Values'range loop
          Worker(I, Values(I));
       end loop;
    end Map;

    -- Define and initialize the actual array
    Sample : Value_Array := (5,4,3,2,1);

 begin
    Map(Sample, Display'access);
 end Call_Back_Example;


void
map(list l, void (*fp)(object))
{
    l.ucall(fp, 0);
}

void
out(object o)
{
    o_(o, "\n");
}

integer
main(void)
{
    list(0, 1, 2, 3).map(out);

    return 0;
}


def (fib n)
  if (n >= 0)
    (transform n :thru (afn (n)
                         (if (n < 2)
                           n
                           (+ (self n-1)
                              (self n-2)))))


let str => 'strings';

let fib n => switch n {
  < 0 => str.format 'Bad argument: {q}' n;
  default => n -> (@ memo s n => switch n {
    == 0 => 0; == 1 => 1;
    default => + (s (- n 1)) (s (- n 2));
  });
};


class Fibonacci {
    static compute(n) {
        var fib
        fib = Fn.new {|n|
            if (n < 2) return n
            return fib.call(n - 1) + fib.call(n - 2)
        }

        if (n < 0) return null
        return fib.call(n)
    }
}

System.print(Fibonacci.compute(36))


 PROC call back proc = (INT location, INT value)VOID:
 (
   printf(($"array["g"] = "gl$, location, value))
 );

 PROC map = (REF[]INT array, PROC (INT,INT)VOID call back)VOID:
 (
   FOR i FROM LWB array TO UPB array DO
      call back(i, array[i])
   OD
 );

 main:
 (
   [4]INT array := ( 1, 4, 9, 16 );
   map(array, call back proc)
 )


begin
    procedure printSquare ( integer value x ) ; writeon( i_w := 1, s_w := 0, " ", x * x );
    % applys f to each element of a from lb to ub (inclusive) %
    procedure applyI ( procedure f; integer array a ( * ); integer value lb, ub ) ;
        for i := lb until ub do f( a( i ) );
    % test applyI %
    begin
        integer array a ( 1 :: 3 );
        a( 1 ) := 1; a( 2 ) := 2; a( 3 ) := 3;
        applyI( printSquare, a, 1, 3 )
    end
end.


; Calculates and prints Fibonacci numbers (Fn)
; Prints numbers 1 - 47 (largest 32bit Fn that fits)
; Build:
;   nasm -felf32 fib.asm
;   ld -m elf32_i386 fib.o -o fib

global  _start
section .text

_start:
    mov ecx, 48         ; Initialize loop counter
.loop:
    mov ebx, 48         ; Calculate which Fn will be computed
    sub ebx, ecx        ; Takes into account the reversed nature
    push    ebx         ; Pass the parameter in on the stack
    push    .done       ; Emulate a call but "return" to end of loop
                        ; The return adress is manually set on the stack
; int fib (int n)
; Returns the n'th Fn
; fib(n) =  0                   if n <= 0
;           1                   if n == 1
;           fib(n-1) + fib(n-2) otherwise
.fib:
    push    ebp         ; Setup stack frame
    mov ebp, esp
    push    ebx         ; Save needed registers

    xor eax, eax
    mov ebx, [ebp + 8]  ; Get the parameter
    cmp ebx, 1          ; Test for base cases
    jl  .return
    mov eax, 1
    je  .return
    dec ebx             ; Calculate fib(n-1)
    push    ebx
    call    .fib
    mov [esp], eax      ; Save result on top of parameter in stack
    dec ebx             ; Calculate fib(n-2)
    push    ebx
    call    .fib
    add eax, [esp + 4]  ; Add the first to the second
    add esp, 8          ; Reset local stack
.return:
    pop ebx             ; Restore modified registers
    mov esp, ebp        ; Tear down stack frame and return
    pop ebp
    ret
.done:
    mov [esp], ecx      ; Save the counter between calls
    push    eax         ; Print the number
    call    print_num
    add esp, 4
    pop ecx             ; Restore the loop counter
    loop    .loop       ; Loop until 0

    mov eax, 0x01       ; sys_exit(int error)
    xor ebx, ebx        ; error = 0 (success)
    int 0x80            ; syscall

; void print_num (int n)
; Prints an integer and newline
print_num:
    push    ebp
    mov ebp, esp
    sub esp, 11         ; Save space for digits and newline

    lea ecx, [ebp - 1]  ; Save a pointer to after the buffer
    mov BYTE [ecx], 0x0A    ; Set the newline at the end
    mov eax, [ebp + 8]  ; Get the parameter
    mov ebx, DWORD 10   ; Divisor
.loop:
    dec ecx             ; Move pointer to next digit
    xor edx, edx
    div ebx             ; Extract one digit, quot in eax, rem in edx
    add dl, 0x30        ; Convert remainder to ascii
    mov [ecx], dl       ; Save the ascii form
    cmp eax, 0          ; Loop until all digits have been converted
    jg  .loop

    mov eax, 0x04       ; sys_write(int fd, char **buf, int len)
    mov ebx, 1          ; stdout
    mov edx, ebp        ; Calculate the length
    sub edx, ecx        ; address after newline - address of first digit
    int 0x80

    mov esp, ebp
    pop ebp
    ret


on callback for arg
    -- Returns a string like "arc has 3 letters"
    arg & " has " & (count arg) & " letters"
end callback

set alist to {"arc", "be", "circle"}
repeat with aref in alist
    -- Passes a reference to some item in alist
    -- to callback, then speaks the return value.
    say (callback for aref)
end repeat


map("callback", "3,4,5")

callback(array){
  Loop, Parse, array, `,
    MsgBox % (2 * A_LoopField)
}

map(callback, array){
  %callback%(array)
}


include c:\cxpl\codes;

func Fib(X);
int X;
        func ActualFib(N);
        int N;
        [if N<2 then return N
        else return ActualFib(N-1) + ActualFib(N-2);
        ]; \ActualFib;

[if X<0 then [Text(0, "Error "); return 0]
else return ActualFib(X);
]; \Fib;

[IntOut(0, Fib(8));  CrLf(0);
 IntOut(0, Fib(-2)); CrLf(0);
]


print Fibonacci(-10)
print Fibonacci(10)

sub Fibonacci(number)

    If number < 0 print "Invalid argument: "; : return number

    If number < 2 Then
        Return number
    Else
        Return Fibonacci(number - 1) + Fibonacci(number - 2)
    EndIf

end sub


fcn fib(n){
   if (n<0) throw(Exception.ValueError);
   fcn(n){
      if (n < 2) return(1);
      else       return(self.fcn(n-1) + self.fcn(n-2));
   }(n);
}
fib(8) .println();
fib(-8).println();


10 INPUT "Enter a number: ";n
20 LET t=0
30 GO SUB 60
40 PRINT t
50 STOP
60 LET nold1=1: LET nold2=0
70 IF n<0 THEN PRINT "Positive argument required!": RETURN
80 IF n=0 THEN LET t=nold2: RETURN
90 IF n=1 THEN LET t=nold1: RETURN
100 LET t=nold2+nold1
110 IF n>2 THEN LET n=n-1: LET nold2=nold1: LET nold1=t: GO SUB 100
120 RETURN


$ awk 'func psqr(x){print x,x*x}BEGIN{split("1 2 3 4 5",a);for(i in a)psqr(a[i])}'
4 16
5 25
1 1
2 4
3 9


      DIM a(4)
      a() = 1, 2, 3, 4, 5
      PROCmap(a(), FNsqrt())
      FOR i = 0 TO 4
        PRINT a(i)
      NEXT
      END

      DEF FNsqrt(n) = SQR(n)

      DEF PROCmap(array(), RETURN func%)
      LOCAL I%
      FOR I% = 0 TO DIM(array(),1)
        array(I%) = FN(^func%)(array(I%))
      NEXT
      ENDPROC


( ( callbackFunction1
  =   location value
    .   !arg:(?location,?value)
      & out$(str$(array[ !location "] = " !!value))
  )
& ( callbackFunction2
  =   location value
    .   !arg:(?location,?value)
      & !!value^2:?!value
  )
& ( mapar
  =   arr len callback i
    .   !arg:(?arr,?len,?callback)
      & 0:?i
      &   whl
        ' ( !i:<!len
          & !callback$(!i,!i$!arr)
          & 1+!i:?i
          )
  )
& tbl$(array,4)
& 1:?(0$array)
& 2:?(1$array)
& 3:?(2$array)
& 4:?(3$array)
& mapar$(array,4,callbackFunction1)
& mapar$(array,4,callbackFunction2)
& mapar$(array,4,callbackFunction1)
);


#Print out each element in array
[:a :b :c :d :e].each { element |
	p element
}


#ifndef CALLBACK_H
#define CALLBACK_H

/*
 * By declaring the function in a separate file, we allow
 * it to be used by other source files.
 *
 * It also stops ICC from complaining.
 *
 * If you don't want to use it outside of callback.c, this
 * file can be removed, provided the static keyword is prepended
 * to the definition.
 */
void map(int* array, int len, void(*callback)(int,int));

#endif


int[] intArray = { 1, 2, 3, 4, 5 };
// Simplest method:  LINQ, functional
int[] squares1 = intArray.Select(x => x * x).ToArray();

// Slightly fancier: LINQ, query expression
int[] squares2 = (from x in intArray
                  select x * x).ToArray();

// Or, if you only want to call a function on each element, just use foreach
foreach (var i in intArray)
    Console.WriteLine(i * i);


#include <iostream> //cout for printing
#include <algorithm> //for_each defined here

//create the function (print the square)
void print_square(int i) {
  std::cout << i*i << " ";
}

int main() {
  //create the array
  int ary[]={1,2,3,4,5};
  //stl for_each
  std::for_each(ary,ary+5,print_square);
  return 0;
}
//prints 1 4 9 16 25


square x = x * x

values :: {#Int}
values = {x \\ x <- [1 .. 10]}


;; apply a named function, inc
(map inc [1 2 3 4])


% This procedure will call a given procedure with each element
% of the given array. Thanks to CLU's type parameterization,
% it will work for any type of element.
apply_to_all = proc [T: type] (a: array[T], f: proctype(int,T))
    for i: int in array[T]$indexes(a) do
        f(i, a[i])
    end
end apply_to_all

% Callbacks for both string and int
show_int = proc (i, val: int)
    po: stream := stream$primary_output()
    stream$putl(po, "array[" || int$unparse(i) || "] = " || int$unparse(val));
end show_int

show_string = proc (i: int, val: string)
    po: stream := stream$primary_output()
    stream$putl(po, "array[" || int$unparse(i) || "] = " || val);
end show_string

% Here's how to use them
start_up = proc ()
    po: stream := stream$primary_output()

    ints: array[int] := array[int]$[2, 3, 5, 7, 11]
    strings: array[string] := array[string]$
        ["enemy", "lasagna", "robust", "below", "wax"]

    stream$putl(po, "Ints: ")
    apply_to_all[int](ints, show_int)

    stream$putl(po, "\nStrings: ")
    apply_to_all[string](strings, show_string)
end start_up


       IDENTIFICATION DIVISION.
       PROGRAM-ID. Map.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  Table-Size CONSTANT 30.

       LOCAL-STORAGE SECTION.
       01  I USAGE UNSIGNED-INT.

       LINKAGE SECTION.
       01  Table-Param.
           03  Table-Values USAGE COMP-2 OCCURS Table-Size TIMES.

       01  Func-Id PIC X(30).

       PROCEDURE DIVISION USING Table-Param Func-Id.
           PERFORM VARYING I FROM 1 BY 1 UNTIL Table-Size < I
               CALL Func-Id USING BY REFERENCE Table-Values (I)
           END-PERFORM

           GOBACK
           .


map = (arr, f) -> (f(e) for e in arr)
arr = [1, 2, 3, 4, 5]
f = (x) -> x * x
console.log map arr, f # prints [1, 4, 9, 16, 25]


MODULE Callback;
IMPORT StdLog;

TYPE
	Callback = PROCEDURE (x: INTEGER;OUT doubled: INTEGER);
	Callback2 = PROCEDURE (x: INTEGER): INTEGER;

	PROCEDURE Apply(proc: Callback; VAR x: ARRAY OF INTEGER);
	VAR
		i: INTEGER;
	BEGIN
		FOR i := 0 TO LEN(x) - 1 DO;
			proc(x[i],x[i]);
		END
	END Apply;

	PROCEDURE Apply2(func: Callback2; VAR x: ARRAY OF INTEGER);
	VAR
		i: INTEGER;
	BEGIN
		FOR i := 0 TO LEN(x) - 1 DO;
			x[i] := func(x[i]);
		END
	END Apply2;

	PROCEDURE Double(x: INTEGER; OUT y: INTEGER);
	BEGIN
		y := x * x;
	END Double;

	PROCEDURE Double2(x: INTEGER): INTEGER;
	BEGIN
		RETURN x * x
	END Double2;

	PROCEDURE Do*;
	VAR
		i: INTEGER;
		ary: ARRAY 10 OF INTEGER;

	BEGIN
		FOR i := 0 TO LEN(ary) - 1 DO ary[i] := i END;
		Apply(Double,ary);
		FOR i := 0 TO LEN(ary) - 1 DO
			StdLog.Int(ary[i]);StdLog.Ln
		END;
		StdLog.Ln;
		Apply2(Double2,ary);
		FOR  i := 0 TO LEN(ary) - 1 DO
		        StdLog.Int(ary[i]);StdLog.Ln
		END
	END Do;
END Callback.


values = [1, 2, 3]

new_values = values.map do |number|
  number * 2
end

puts new_values  #=> [2, 4, 6]


import std.stdio, std.algorithm;

void main() {
    auto items = [1, 2, 3, 4, 5];
    auto m = items.map!(x => x + 5)();
    writeln(m);
}


// Declare the callback function
procedure callback(const AInt:Integer);
begin
  WriteLn(AInt);
end;

const
  // Declare a static array
  myArray:Array[0..4] of Integer=(1,4,6,8,7);
var
  // Declare interator variable
  i:Integer;
begin
  // Iterate the array and apply callback
  for i:=0 to length(myArray)-1 do
    callback(myArray[i]);
end.


func Array.Select(pred) {
    let ys = []
    for x in this when pred(x) {
        ys.Add(x)
    }
    return ys
}

var arr = [1, 2, 3, 4, 5]
var squares = arr.Select(x => x * x)

print(squares)


!. map @++ [ 1 4 8 ]

#implemented roughly like this:
#map f lst:
#    ]
#    for i in lst:
#         f i
#    [


def array := [1,2,3,4,5]
def square(value) {
    return value * value
}


square = fn (N) {
    N * N
}

# list comprehension
squares1 = fn (Numbers) {
    [square(N) for N in Numbers]
}

# functional form
squares2a = fn (Numbers) {
    lists.map(fn square:1, Numbers)
}

# functional form with lambda
squares2b = fn (Numbers) {
    lists.map(fn (N) { N * N }, Numbers)
}

# no need for a function
squares3 = fn (Numbers) {
    [N * N for N in Numbers]
}

@public
run = fn () {
    Numbers = [1, 3, 5, 7]
    io.format("squares1 : ~p~n", [squares1(Numbers)])
    io.format("squares2a: ~p~n", [squares2a(Numbers)])
    io.format("squares2b: ~p~n", [squares2b(Numbers)])
    io.format("squares3 : ~p~n", [squares3(Numbers)])
}


delegate callback( i int ) returns( int ) end

program ApplyCallbackToArray
	function main()
		values int[] = [ 1, 2, 3, 4, 5 ];

		func callback = square;
		for ( i int to values.getSize() )
			values[ i ] = func( values[ i ] );
		end

		for ( i int to values.getSize() )
			SysLib.writeStdout( values[ i ] );
		end
	end

	function square( i int ) returns( int )
		return( i * i );
	end
end


import system'routines;

PrintSecondPower(n){ console.writeLine(n * n) }

public program()
{
    new int[]{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}.forEach:PrintSecondPower
}


PROGRAM CALLBACK

!
! for rosettacode.org
!

DIM A[5]

FUNCTION CBACK(X)
   CBACK=2*X-1
END FUNCTION

PROCEDURE PROCMAP(ZETA,DUMMY(X)->OUTP)
   OUTP=DUMMY(ZETA)
END PROCEDURE

BEGIN
   A[1]=1  A[2]=2   A[3]=3  A[4]=4  A[5]=5
   FOR I%=1 TO 5 DO
      PROCMAP(A[I%],CBACK(X)->OUTP)
      PRINT(OUTP;)
   END FOR
   PRINT
END PROGRAM


function apply_to_all(sequence s, integer f)
    -- apply a function to all elements of a sequence
    sequence result
    result = {}
    for i = 1 to length(s) do
	-- we can call add1() here although it comes later in the program
	result = append(result, call_func(f, {s[i]}))
    end for
    return result
end function

function add1(atom x)
    return x + 1
end function

-- add1() is visible here, so we can ask for its routine id
? apply_to_all({1, 2, 3}, routine_id("add1"))
-- displays {2,3,4}


let evenp x = x % 2 = 0
let result = Array.map evenp [| 1; 2; 3; 4; 5; 6 |]


class Main
{
  public static Void main ()
  {
    [1,2,3,4,5].each |Int i| { echo (i) }
    Int[] result := [1,2,3,4,5].map |Int i->Int| { return i * i }
    echo (result)
  }
}


#APPTYPE CONSOLE

FOREACH DIM e IN MyMap(Add42, {1, 2, 3})
	PRINT e, " ";
NEXT

PAUSE

FUNCTION MyMap(f, a)
	DIM ret[]
	FOREACH DIM e IN a
		ret[] = f(e)
	NEXT
	RETURN ret
END FUNCTION

FUNCTION Add42(n): RETURN n + 42: END FUNCTION


: map ( addr n fn -- )
   -rot cells bounds do  i @ over execute i !  cell +loop ;


module arrCallback
contains
    elemental function cube( x )
        implicit none
        real :: cube
        real, intent(in) :: x
        cube = x * x * x
    end function cube
end module arrCallback


' FB 1.05.0 Win64

Sub PrintEx(n As Integer)
  Print n, n * n, n * n * n
End Sub

Sub Proc(a() As Integer, callback As Sub(n As Integer))
  For i As Integer = LBound(a) To UBound(a)
    callback(i)
  Next
End Sub

Dim a(1 To 10) As Integer = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}
Print " n", "n^2", "n^3"
Print " -", "---", "---"
Proc(a(), @PrintEx)
Print
Print "Press any key to quit the program"
Sleep


f = {|x| x^2}   // Anonymous function to square input
a = [1,2,3,5,7]
println[map[f, a]]


[1, 2, 3].foreach( println )

[1, 2, 3].foreach( a -> println(2a) )


a := [1 .. 4];
b := ShallowCopy(a);

# Apply and replace values
Apply(a, n -> n*n);
a;
# [ 1, 4, 9, 16 ]

# Apply and don't change values
List(b, n -> n*n);
# [ 1, 4, 9, 16 ]

# Apply and don't return anything (only side effects)
Perform(b, Display);
1
2
3
4

b;
# [ 1 .. 4 ]


package main

import "fmt"

func main() {
    for _, i := range []int{1, 2, 3, 4, 5} {
        fmt.Println(i * i)
    }
}


let square x = x*x
let values = [1..10]
map square values


procedure main()
   local lst
   lst := [10, 20, 30, 40]
   every callback(write,!lst)
end

procedure callback(p,arg)
   return p(" -> ", arg)
end


public class ArrayCallback7 {

    interface IntConsumer {
        void run(int x);
    }

    interface IntToInt {
        int run(int x);
    }

    static void forEach(int[] arr, IntConsumer consumer) {
        for (int i : arr) {
            consumer.run(i);
        }
    }

    static void update(int[] arr, IntToInt mapper) {
        for (int i = 0; i < arr.length; i++) {
            arr[i] = mapper.run(arr[i]);
        }
    }

    public static void main(String[] args) {
        int[] numbers = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10};

        forEach(numbers, new IntConsumer() {
            public void run(int x) {
                System.out.println(x);
            }
        });

        update(numbers, new IntToInt() {
            @Override
            public int run(int x) {
                return x * x;
            }
        });

        forEach(numbers, new IntConsumer() {
            public void run(int x) {
                System.out.println(x);
            }
        });
    }
}


function map(a, func) {
  var ret = [];
  for (var i = 0; i < a.length; i++) {
    ret[i] = func(a[i]);
  }
  return ret;
}

map([1, 2, 3, 4, 5], function(v) { return v * v; });


# Illustration of map/1 using the builtin filter: exp
map(exp)  # exponentiate each item in the input list

# A compound expression can be specified as the argument to map, e.g.
map( (. * .) + sqrt ) # x*x + sqrt(x)

# The compound expression can also be a composition of filters, e.g.
map( sqrt|floor )     # the floor of the sqrt

# Array comprehension
reduce .[] as $n ([]; . + [ exp ])

# Elementwise operation
 [.[] + 1 ]   # add 1 to each element of the input array


/* Apply callback, in Jsish using array.map() */
;[1, 2, 3, 4, 5].map(function(v,i,a) { return v * v; });

/*
=!EXPECTSTART!=
[1, 2, 3, 4, 5].map(function(v,i,a) { return v * v; }) ==> [ 1, 4, 9, 16, 25 ]
=!EXPECTEND!=
*/


numbers = [1, 3, 5, 7]

@show [n ^ 2 for n in numbers]                  # list comprehension
square(x) = x ^ 2; @show map(square, numbers)   # functional form
@show map(x -> x ^ 2, numbers)                  # functional form with anonymous function
@show [n * n for n in numbers]    				# no need for a function,
@show numbers .* numbers                        # element-wise operation
@show numbers .^ 2                              # includes .+, .-, ./, comparison, and bitwise operations as well


fun main(args: Array<String>) {
    val array = arrayOf(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)  // build
    val function = { i: Int -> i * i } // function to apply
    val list = array.map { function(it) } // process each item
    println(list) // print results
}


include ..\Utilitys.tlhy

( 1 2 3 4 ) [dup *] map

pstack

" " input


define cube(n::integer) => #n*#n*#n

local(
	mynumbers = array(1, 2, 3, 4, 5),
	mycube = array
)

#mynumbers -> foreach => {
	#mycube -> insert(cube(#1))
}

#mycube


+ a : ARRAY(INTEGER);
+ b : {INTEGER;};

a := ARRAY(INTEGER).create 1 to 3;
1.to 3 do { i : INTEGER;
  a.put i to i;
};

b := { arg : INTEGER;
  (arg * arg).print;
  '\n'.print;
};

a.foreach b;


to square :x
  output :x * :x
end
show map "square [1 2 3 4 5]  ; [1 4 9 16 25]
show map [? * ?] [1 2 3 4 5]  ; [1 4 9 16 25]
foreach [1 2 3 4 5] [print square ?]  ; 1 4 9 16 25, one per line


a=(1,2,3,4,5)
b=lambda->{
	push number**2
}
Print a#map(b) ' 1 4 9 16 25
Print a#map(b, b)  ' 1 16 81 256 625
b=lambda (z) ->{
	=lambda z ->{
		push number**z
	}
}
Print a#map(b(2)) ' 1 4 9 16 25
Print a#map(b(3)) ' 1 8 27 64 125

\\ second example
a=(1,2,3,4,5)
class s {sum=0}
\\ s is a pointer to an instance of s()
s->s()
c=lambda s -> {
	push number+number
	s=>sum=stackitem()  ' peek the value from stack
}
\\ c passed by value to fold(), but has a pointer to s
Print a#fold(c, 100)=115
Print s=>sum=115


define(`foreach', `pushdef(`$1')_foreach([email protected])popdef(`$1')')dnl
define(`_arg1', `$1')dnl
define(`_foreach', `ifelse(`$2', `()', `',
   `define(`$1', _arg1$2)$3`'$0(`$1', (shift$2), `$3')')')dnl
dnl
define(`apply',`foreach(`x',$1,`$2(x)')')dnl
dnl
define(`z',`eval(`$1*2') ')dnl
apply(`(1,2,3)',`z')


/* for lists or sets */

map(sin, [1, 2, 3, 4]);
map(sin, {1, 2, 3, 4});

/* for matrices */

matrixmap(sin, matrix([1, 2], [2, 4]));


(1 2 3 4 5) (sqrt puts) foreach   ; print each square root
(1 2 3 4 5) 'sqrt map             ; collect return values


MODULE Callback EXPORTS Main;

IMPORT IO, Fmt;

TYPE CallBack = PROCEDURE (a: CARDINAL; b: INTEGER);
     Values = REF ARRAY OF INTEGER;

VAR sample := ARRAY [1..5] OF INTEGER {5, 4, 3, 2, 1};
    callback := Display;

PROCEDURE Display(loc: CARDINAL; val: INTEGER) =
  BEGIN
    IO.Put("array[" & Fmt.Int(loc) & "] = " & Fmt.Int(val * val) & "\n");
  END Display;

PROCEDURE Map(VAR values: ARRAY OF INTEGER; size: CARDINAL; worker: CallBack) =
  VAR lvalues := NEW(Values, size);
  BEGIN
    FOR i := FIRST(lvalues^) TO LAST(lvalues^) DO
      worker(i, values[i]);
    END;
  END Map;

BEGIN
  Map(sample, NUMBER(sample), callback);
END Callback.


// create a list of numbers 1-10
numbers = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}

// display the list as it is
println numbers

// square each element in the list
for i in range(1, len(numbers) - 1)
	numbers[i] = numbers[i] * numbers[i]
end

// display the squared list
println numbers


def seg = array[1, 2, 3, 5, 8, 13];
def squares = seq.Map(x => x*x);


;; NetLogo “anonymous procedures”
;; stored in a variable, just to show it can be done.
let callback [ [ x ] x * x ]
show (map callback [ 1 2 3 4 5 ])


var arr = @[1,2,3,4]
arr.apply proc(some: var int) = echo(some, " squared = ", some*some)


MODULE ApplyCallBack;
IMPORT
  Out := NPCT:Console;

TYPE
  Fun = PROCEDURE (x: LONGINT): LONGINT;
  Ptr2Ary = POINTER TO ARRAY OF LONGINT;

VAR
  a: ARRAY 5 OF LONGINT;
  x: ARRAY 3 OF LONGINT;
  r: Ptr2Ary;

  PROCEDURE Min(x,y: LONGINT): LONGINT;
  BEGIN
    IF x <= y THEN RETURN x ELSE RETURN y END;
  END Min;

  PROCEDURE Init(VAR a: ARRAY OF LONGINT);
  BEGIN
    a[0] := 0;
    a[1] := 1;
    a[2] := 2;
    a[3] := 3;
    a[4] := 4;
  END Init;

  PROCEDURE Fun1(x: LONGINT): LONGINT;
  BEGIN
    RETURN x * 2
  END Fun1;

  PROCEDURE Fun2(x: LONGINT): LONGINT;
  BEGIN
    RETURN x DIV 2;
  END Fun2;

  PROCEDURE Fun3(x: LONGINT): LONGINT;
  BEGIN
    RETURN x + 3;
  END Fun3;

  PROCEDURE Map(F: Fun; VAR x: ARRAY OF LONGINT);
  VAR
    i: LONGINT;
  BEGIN
    FOR i := 0 TO LEN(x) - 1 DO
      x[i] := F(x[i])
    END
  END Map;

  PROCEDURE Map2(F: Fun; a: ARRAY OF LONGINT; VAR r: ARRAY OF LONGINT);
  VAR
    i,l: LONGINT;
  BEGIN
    l := Min(LEN(a),LEN(x));
    FOR i := 0 TO l - 1 DO
      r[i] := F(a[i])
    END
  END Map2;

  PROCEDURE Map3(F: Fun; a: ARRAY OF LONGINT): Ptr2Ary;
  VAR
    r: Ptr2Ary;
    i: LONGINT;
  BEGIN
    NEW(r,LEN(a));
    FOR i := 0 TO LEN(a) - 1 DO
      r[i] := F(a[i]);
    END;
    RETURN r
  END Map3;

  PROCEDURE Show(a: ARRAY OF LONGINT);
  VAR
    i: LONGINT;
  BEGIN
    FOR i := 0 TO LEN(a) - 1 DO
      Out.Int(a[i],4)
    END;
    Out.Ln
  END Show;

BEGIN
  Init(a);Map(Fun1,a);Show(a);
  Init(a);Map2(Fun2,a,x);Show(x);
  Init(a);r := Map3(Fun3,a);Show(r^);
END ApplyCallBack.


use Structure;

bundle Default {
  class Test {
    function : Main(args : String[]) ~ Nil {
      Run();
    }

    function : native : Run() ~ Nil {
      values := IntVector->New([1, 2, 3, 4, 5]);
      squares := values->Apply(Square(Int) ~ Int);
      each(i : squares) {
        squares->Get(i)->PrintLine();
      };
    }

    function : Square(value : Int) ~ Int {
      return value * value;
    }
  }
}


function e = f(x, y)
  e = x^2 + exp(-1/(y+1));
endfunction

% f([2,3], [1,4]) gives and error, but
arrayfun(@f, [2, 3], [1,4])
% works


(for-each
   (lambda (element)
      (display element))
   '(1 2 3 4 5))
; ==> 12345


start = .array~of("Rick", "Mike", "David", "Mark")
new = map(start, .routines~reversit)
call map new, .routines~sayit

-- a function to perform an iterated callback over an array
-- using the provided function.  Returns an array containing
-- each function result
::routine map
  use strict arg array, function
  resultArray = .array~new(array~items)
  do item over array
     resultArray~append(function~call(item))
  end
  return resultArray

::routine reversit
  use arg string
  return string~reverse

::routine sayit
  use arg string
  say string
  return .true   -- called as a function, so a result is required


declare
  fun{Square A}
    A*A
  end

  Lst = [1 2 3 4 5]

  %% apply a PROCEDURE to every element
  {ForAll Lst Show}

  %% apply a FUNCTION to every element
  Result = {Map Lst Square}
  {Show Result}


# create array
my @a = (1, 2, 3, 4, 5);

# create callback function
sub mycallback {
  return 2 * shift;
}

# use array indexing
for (my $i = 0; $i < scalar @a; $i++) {
  print "mycallback($a[$i]) = ", mycallback($a[$i]), "\n";
}

# using foreach
foreach my $x (@a) {
  print "mycallback($x) = ", mycallback($x), "\n";
}

# using map (useful for transforming an array)
my @b = map mycallback($_), @a;                # @b is now (2, 4, 6, 8, 10)

# and the same using an anonymous function
my @c = map { $_ * 2 } @a;                     # @c is now (2, 4, 6, 8, 10)

# use a callback stored in a variable
my $func = \&mycallback;
my @d = map $func->($_), @a;                  # @d is now (2, 4, 6, 8, 10)

# filter an array
my @e = grep { $_ % 2 == 0 } @a;               # @e is now (2, 4)


requires("0.8.2")

function add1(integer x)
    return x + 1
end function

?apply({1,2,3},add1)


/# Rosetta Code problem: http://rosettacode.org/wiki/Apply_a_callback_to_an_array
by Galileo, 05/2022 #/

include ..\Utilitys.pmt

def ++
    1 +
enddef

def square
    dup *
enddef

( 1 2 3 ) dup

getid ++ map swap
getid square map

pstack


function cube($n)
{
   return($n * $n * $n);
}

$a = array(1, 2, 3, 4, 5);
$b = array_map("cube", $a);
print_r($b);


go =>
   L = 1..10,

   % Using map/2 in different ways
   println(L.map(fun)),
   println(map(L,fun)),
   println(map(fun,L)),

   % List comprehensions
   println([fun(I) : I in L]),

   % Using apply/2
   println([apply(fun,I) : I in L]),

   % And using list comprehension with the function directly.
   println([I*I : I in L]),
   nl.

% Some function
fun(X) = X*X.


: (mapc println (1 2 3 4 5))  # Print numbers
1
2
3
4
5
-> 5

: (mapcar '((N) (* N N)) (1 2 3 4 5))  # Calculate squares
-> (1 4 9 16 25)

: (mapcar ** (1 2 3 4 5) (2 .))  # Same, using a circular list
-> (1 4 9 16 25)

: (mapcar if '(T NIL T NIL) '(1 2 3 4) '(5 6 7 8))  # Conditional function
-> (1 6 3 8)


int cube(int n)
{
    return n*n*n;
}

array(int) a = ({ 1,2,3,4,5 });
array(int) b = cube(a[*]);      // automap operator
array(int) c = map(a, cube);    // conventional map function


   declare x(5) initial (1,3,5,7,8);
   x = sqrt(x);
   x = sin(x);


-- Let's create a generic class with one method to be used as an interface:
CREATE OR REPLACE
TYPE callback AS OBJECT (
    -- A class needs at least one member even though we don't use it
    -- There's no generic OBJECT type, so let's call it NUMBER
    dummy NUMBER,
    -- Here's our function, and since PL/SQL doesn't have generics,
    -- let's use type NUMBER for our params
    MEMBER FUNCTION exec(n NUMBER) RETURN NUMBER
) NOT FINAL NOT instantiable;
/

-- Now let's inherit from that, defining a class with one method. We'll have ours square a number.
-- We can pass this class into any function that takes type callback:
CREATE OR REPLACE TYPE CB_SQUARE under callback (
    OVERRIDING MEMBER FUNCTION exec(n NUMBER) RETURN NUMBER
)
/
CREATE OR REPLACE
TYPE BODY CB_SQUARE AS
    OVERRIDING MEMBER FUNCTION exec(n NUMBER) RETURN NUMBER IS
    BEGIN
        RETURN n * n;
    END exec;
END;
/

-- And a package to hold our test
CREATE OR REPLACE
PACKAGE PKG_CALLBACK AS
    myCallback cb_square;
    TYPE intTable IS TABLE OF NUMBER INDEX BY BINARY_INTEGER;
    ints intTable;
    i PLS_INTEGER;

    PROCEDURE test_callback;
END PKG_CALLBACK;
/

CREATE OR REPLACE PACKAGE BODY PKG_CALLBACK AS
    -- Our generic mapping function that takes a "method" and a collection
    -- Note that it takes the generic callback type
    -- that doesn't know anything about squaring
    PROCEDURE do_callback(myCallback IN callback, ints IN OUT intTable) IS
        i PLS_INTEGER;
        myInt NUMBER;
    BEGIN
        FOR i IN 1 .. ints.COUNT LOOP
            myInt := ints(i);
            -- PL/SQL call's the child's method
            ints(i) := myCallback.exec(myInt);
        END LOOP;
    END do_callback;

    PROCEDURE test_callback IS
    BEGIN
        myCallback := cb_square(NULL);
        FOR i IN 1..5 LOOP
            ints(i) := i;
        END LOOP;

        do_callback(myCallback, ints);

        i := ints.FIRST;
        WHILE i IS NOT NULL LOOP
            DBMS_OUTPUT.put_line(ints(i));
            i := ints.next(i);
        END LOOP;
    END test_callback;
END PKG_CALLBACK;
/

BEGIN
  PKG_CALLBACK.TEST_CALLBACK();
END;
/


;;; Define a procedure
define proc(x);
    printf(x*x, '%p,');
enddefine;

;;; Create array
lvars ar = { 1 2 3 4 5};

;;; Apply procedure to array
appdata(ar, proc);


Procedure Cube(Array param.i(1))
    Protected n.i
    For n = 0 To ArraySize(param())
        Debug Str(param(n)) + "^3 = " + Str(param(n) * param(n) * param(n))
    Next
EndProcedure

Dim AnArray.i(4)

For n = 0 To ArraySize(AnArray())
    AnArray(n) = Random(99)
Next

Cube(AnArray())


def square(n):
    return n * n

numbers = [1, 3, 5, 7]

squares1 = [square(n) for n in numbers]     # list comprehension

squares2a = map(square, numbers)            # functional form

squares2b = map(lambda x: x*x, numbers)     # functional form with `lambda`

squares3 = [n * n for n in numbers]         # no need for a function,
                                            # anonymous or otherwise

isquares1 = (n * n for n in numbers)        # iterator, lazy

import itertools
isquares2 = itertools.imap(square, numbers) # iterator, lazy


'Task
'Take a combined set of elements and apply a function to each element.
'UDT
Type Friend
    Names As String * 8
    Surnames As String * 8
    Age As Integer
End Type

Dim Friends(1 To 6) As Friend
Restore
FillArray
SearchForAdult Friends(), LBound(friends), UBound(friends)

End

Data "John","Beoz",13,"Will","Strange",22
Data "Arthur","Boile",16,"Peter","Smith",21
Data "Tom","Parker",14,"Tim","Wesson",24

Sub FillArray
    Shared Friends() As Friend
    Dim indeX As Integer
    For indeX = LBound(friends) To UBound(friends) Step 1
        Read Friends(indeX).Names, Friends(indeX).Surnames, Friends(indeX).Age
    Next
End Sub

Sub SearchForAdult (F() As Friend, Min As Integer, Max As Integer)
    Dim Index As Integer
    Print "Friends with more than 18 years old"
    For Index = Min To Max Step 1
        If F(Index).Age > 18 Then Print F(Index).Names; " "; F(Index).Surnames; " "; F(Index).Age
    Next Index
End Sub


cube <- function(x) x*x*x
elements <- 1:5
cubes <- cube(elements)


#lang racket

;; using the `for/vector' comprehension form
(for/vector ([i #(1 2 3 4 5)]) (sqr i))

;; the usual functional `map'
(vector-map sqr #(1 2 3 4 5))


sub function { 2 * $^x + 3 };
my @array = 1 .. 5;

# via map function
.say for map &function, @array;

# via map method
.say for @array.map(&function);

# via for loop
for @array {
    say function($_);
}

# via the "hyper" metaoperator and method indirection
say @array».&function;

# we neither need a variable for the array nor for the function
say [1,2,3]>>.&({ $^x + 1});


# To print the squared elements
[1 2 3 4 5] each dup * print


rebol [
    Title: "Array Callback"
    URL: http://rosettacode.org/wiki/Apply_a_callback_to_an_Array
]

map: func [
	"Apply a function across an array."
	f [native! function!] "Function to apply to each element of array."
	a [block!] "Array to process."
	/local x
][x: copy []  forall a [append x do [f a/1]]  x]

square: func [x][x * x]

; Tests:

assert: func [code][print [either do code ["  ok"]["FAIL"]  mold code]]

print "Simple loop, modify in place:"
assert [[1 100 81] = (a: [1 10 9]  forall a [a/1: square a/1]  a)]

print [crlf "Functional style with 'map':"]
assert [[4 16 36] = map :square [2 4 6]]

print [crlf "Applying native function with 'map':"]
assert [[2 4 6] = map :square-root [4 16 36]]


/*REXX program applies a  callback  to an array  (using factorials for a demonstration).*/
numeric digits 100                               /*be able to display some huge numbers.*/
parse arg # .                                    /*obtain an optional value from the CL.*/
a.=                                              /*initialize the array  A  to all nulls*/
if #=='' | #==","  then #= 12                    /*Not assigned?  Then use default value*/
                        do j=0  to #;   a.j= j   /*assign the integer   J  ───►   A.j   */
                        end   /*j*/              /*array  A  will have N values: 0 ──► #*/

call listA   'before callback'                   /*display  A  array before the callback*/
say                                              /*display a blank line for readability.*/
say '      ··· applying callback to array A ···' /*display what is about to happen to B.*/
say                                              /*display a blank line for readability.*/
call bangit  'a'                                 /*factorialize (the values) of A array.*/
                                                 /*    store the results  ───►  array B.*/
call listA   ' after callback'                   /*display  A  array after the callback.*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
bangit:   do v=0;  $= value(arg(1)'.'v);  if $=='' then return  /*No value?  Then return*/
          call value arg(1)'.'v, fact($)         /*assign a value (a factorial) to array*/
          end    /*i*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
fact:   procedure; arg x;   != 1;         do f=2  to x;  != !*f;  end; /*f*/;     return !
listA:    do k=0  while a.k\=='';  say arg(1)  'a.'k"="  a.k;     end  /*k*/;     return


for i in [1,2,3,4,5] do
   puts i**2
end


function apply(list, ageless to_apply)
  (comprehend(x; list) (to_apply(x)));

function square(x) (x*x);

iterate(x; apply([0...9], square))
    x!;


class MAIN is
  do_something(i:INT):INT is
    return i * i;
  end;

  main is
    a:ARRAY{INT} := |1, 2, 3, 4, 5|;
    -- we use an anonymous closure to apply our do_something "callback"
    a.map(bind(do_something(_)));
    loop #OUT + a.elt! + "\n"; end;
  end;
end;


val l = List(1,2,3,4)
l.foreach {i => println(i)}


(define (square n) (* n n))
(define x #(1 2 3 4 5))
(map square (vector->list x))


put each item in [1,2,3,5,9,14,24] squared

put myFunc of each for each item of [1,2,3,5,9,14,24]

to handle myFunc of num
	return 2*num + 1
end myFunc


BEGIN

    ! APPLIES A CALLBACK FUNCTION TO AN ARRAY ;
    PROCEDURE APPLY(ARR, FUN);
        REAL ARRAY ARR;
        PROCEDURE FUN IS REAL PROCEDURE FUN(X); REAL X;;
    BEGIN
        INTEGER I;
        FOR I := LOWERBOUND(ARR, 1) STEP 1 UNTIL UPPERBOUND(ARR, 1) DO
            ARR(I) := FUN(ARR(I));
    END APPLY;

    ! CALLBACK ;
    REAL PROCEDURE SQUARE(X); REAL X; SQUARE := X * X;

    REAL ARRAY A(1:5);
    INTEGER I;
    FOR I := 1 STEP 1 UNTIL 5 DO A(I) := I;
    APPLY(A, SQUARE);
    FOR I := 1 STEP 1 UNTIL 5 DO OUTFIX(A(I), 2, 8); OUTIMAGE;

END.


#( 1 2.0 'three') do: [:each | each displayNl].


let numbers = { 1, 2, 3, 4 };
foreach(numbers, function(idx, num) {
    print(num);
});


--#SET TERMINATOR @

SET SERVEROUTPUT ON @

BEGIN
 DECLARE TYPE NUMBERS AS SMALLINT ARRAY[5];
 DECLARE NUMBERS NUMBERS;
 DECLARE I SMALLINT;

 SET I = 1;
 WHILE (I <= 5) DO
  SET NUMBERS[I] = I;
  SET I = I + 1;
 END WHILE;

 BEGIN
  DECLARE PROCEDURE PRINT_SQUARE (
    IN VALUE SMALLINT
   )
  BEGIN
   CALL DBMS_OUTPUT.PUT(VALUE * VALUE || ' ');
  END;

  SET I = 1;
  WHILE (I <= 5) DO
   CALL PRINT_SQUARE(NUMBERS[I]);
   SET I = I + 1;
  END WHILE;
  CALL DBMS_OUTPUT.PUT_LINE('');
 END;
END @


function map(f,a) {
	nr = rows(a)
	nc = cols(a)
	b = J(nr,nc,.)
	for (i=1;i<=nr;i++) {
		for (j=1;j<=nc;j++) b[i,j] = (*f)(a[i,j])
	}
	return(b)
}

function maps(f,a) {
	nr = rows(a)
	nc = cols(a)
	b = J(nr,nc,"")
	for (i=1;i<=nr;i++) {
		for (j=1;j<=nc;j++) b[i,j] = (*f)(a[i,j])
	}
	return(b)
}

function square(x) {
	return(x*x)
}


func square(n: Int) -> Int {
    return n * n
}

let numbers = [1, 3, 5, 7]

let squares1a = numbers.map(square)         // map method on array

let squares1b = numbers.map {x in x*x}      // map method on array with anonymous function

let squares1b = numbers.map { $0 * $0 }      // map method on array with anonymous function and unnamed parameters

let isquares1 = numbers.lazy.map(square)   // lazy sequence


def numbers: [1,3,7,10];

templates cube
  $ * $ * $ !
end cube

// Using inline array templates (which also allows access to index by $i)
$numbers -> \[i]($ * $i !\) -> !OUT::write
$numbers -> \[i]($ * $ !\) -> !OUT::write
$numbers -> \[i]($ -> cube !\) -> !OUT::write

// Using array literal and deconstructor
[ $numbers... -> $ * $ ] -> !OUT::write
[ $numbers... -> cube ] -> !OUT::write


© For no return value
Define foreach(fe_cname,fe_list) = Prgm
  Local fe_i
  For fe_i,1,dim(fe_list)
    #fe_cname(fe_list[fe_i])
  EndFor
EndPrgm

© For a list of results
Define map(map_cnam,map_list) = seq(#map_cnam(map_list[map_i]),map_i,1,dim(map_list))

Define callback(elem) = Prgm
  Disp elem
EndPrgm

foreach("callback", {1,2,3,4,5})
Disp map("√", {1,2,3,4,5})


var a = [1, 2, 3, 4, 5];
a.map(function(v) { return v * v; })


( array count function -- )
{
  value| array fn |
  [ i array ] is I
  [ to fn swap to array 0 swap [ I array.get :stack fn invoke I array.put ] countedLoop ]
} is map-array

( Build an array )
5 cells is-array a
10 0 a array.put
11 1 a array.put
12 2 a array.put
13 3 a array.put
14 4 a array.put

( Add 1 to each item in the array )
a 5  [ 1 + ] map-array


function map(%array,%arrayCount,%function)
{
	for(%i=0;%i<%arrayCount;%i++)
	{
		eval("%a = "@%[email protected]"["@%[email protected]"];");
		eval(""@%[email protected]"("@%[email protected]");");
	}
}


S = 5                                  ' Size of the array

For x = 0 To S - 1                     ' Initialize array
  @(x) = x + 1
Next

Proc _MapArray (_SquareRoot, S)        ' Call mapping procedure

For x = 0 To S - 1                     ' Print results
  Print "SQRT(";x+1;") = ";Using "#.####";@(x)
Next

For x = 0 To S - 1                     ' Reinitialize array
  @(x) = x + 1
Next

Proc _MapArray (_Cosine, S)            ' Call mapping procedure

Print : For x = 0 To S - 1             ' Print results
  Print "COS(";x+1;") = ";Using "#.####";@(x)
Next

End

_MapArray Param(2)                     ' Param(1) = function
  Local (1)                            ' Param(2) = array size

  For [email protected] = 0 To [email protected] - 1
    @([email protected]) = FUNC([email protected](@([email protected])))
  Next
Return

_SquareRoot Param (1)                  ' This is an integer SQR subroutine
  Local (2)

  [email protected] = (10^(4*2)) * [email protected]                 ' Output is scaled by 10^4
  [email protected] = [email protected]

  Do
    [email protected] = ([email protected] + ([email protected] / [email protected]))/2
  Until (Abs([email protected] - [email protected]) < 2)
    [email protected] = [email protected]
  Loop

Return ([email protected])

_Cosine Param(1)                       ' This is an integer COS subroutine
  Push Abs(([email protected]*10000)%62832)           ' Output is scaled by 10^4
  If Tos()>31416 Then Push 62832-Pop()
  Let [email protected]=Tos()>15708
  If [email protected] Then Push 31416-Pop()
  Push Tos()
  Push (Pop()*Pop())/10000
  Push 10000+((10000*-(Tos()/56))/10000)
  Push 10000+((Pop()*-(Tos()/30))/10000)
  Push 10000+((Pop()*-(Tos()/12))/10000)
  Push 10000+((Pop()*-(Pop()/2))/10000)
  If [email protected] Then Push -Pop()               ' Result is directly transferred
Return                                 ' through the stack


map() {
	map_command=$1
	shift
	for i do "$map_command" "$i"; done
}
list=1:2:3
(IFS=:; map echo $list)


#import nat

#cast %nL

demo = successor* <325,32,67,1,3,7,315>


Option Explicit

Sub Main()
Dim arr, i
    'init
    arr = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10)

    'Loop and apply a function (Fibonacci) to each element
    For i = LBound(arr) To UBound(arr): arr(i) = Fibonacci(arr(i)): Next

    'return
    Debug.Print Join(arr, ", ")
End Sub

Private Function Fibonacci(N) As Variant
    If N <= 1 Then
        Fibonacci = N
    Else
        Fibonacci = Fibonacci(N - 1) + Fibonacci(N - 2)
    End If
End Function


class callback
	dim sRule

	public property let rule( x )
		sRule = x
	end property

	public default function applyTo(a)
		dim p1
		for i = lbound( a ) to ubound( a )
			p1 = a( i )
			a( i ) = eval( sRule )
		next
		applyTo = a
	end function
end class


echo map([10, 20, 30], 'v:val * v:val')
echo map([10, 20, 30], '"Element " . v:key . " = " . v:val')
echo map({"a": "foo", "b": "Bar", "c": "BaZ"}, 'toupper(v:val)')
echo map({"a": "foo", "b": "Bar", "c": "BaZ"}, 'toupper(v:key)')


Module Program
    Function OneMoreThan(i As Integer) As Integer
        Return i + 1
    End Function

    Sub Main()
        Dim source As Integer() = {1, 2, 3}

        ' Create a delegate from an existing method.
        Dim resultEnumerable1 = source.Select(AddressOf OneMoreThan)

        ' The above is just syntax sugar for this; extension methods can be called as if they were instance methods of the first parameter.
        resultEnumerable1 = Enumerable.Select(source, AddressOf OneMoreThan)

        ' Or use an anonymous delegate.
        Dim resultEnumerable2 = source.Select(Function(i) i + 1)

        ' The sequences are the same.
        Console.WriteLine(Enumerable.SequenceEqual(resultEnumerable1, resultEnumerable2))

        Dim resultArr As Integer() = resultEnumerable1.ToArray()

        Array.ForEach(resultArr, AddressOf Console.WriteLine)
    End Sub
End Module


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

let example => [3; 5; 2];

let double => a.stream example
-> s.map (* 2)
-> s.collect
;


var arr = [1, 2, 3, 4, 5]
arr = arr.map { |x| x * 2 }.toList
arr = arr.map(Fn.new { |x| x / 2 }).toList
arr.each { |x| System.print(x) }


func map(arr:array,callback:function){
	set newArr:array = [];
	foreach(k,v as arr){
		newArr[k]=callback(v,k,arr);
	}
	send newArr;
}

set arr:array = [1,2,3,4,5];
set result:array = map(arr,func(v){
	send v*2;
});

log(arr.join(", "));
log(result.join(", "));


sub map(f$, t())
    local i

    for i = 1 to arraysize(t(), 1)
        t(i) = execute(f$, t(i))
    next i
end sub

sub add1(x)
    return x + 1
end sub

sub square(x)
    return x * x
end sub

dim t(10)

for i = 1 to 10
    t(i) = i
    print t(i), "\t";
next i
print

//map("add1", t())
map("square", t())

for i = 1 to 10
    print t(i), "\t";
next i
print


Array:
byte &01,&02,&03,&04,&05
Array_End:

foo:
ld hl,Array
ld b,Array_End-Array ;ld b,5

bar:
inc (hl)
inc (hl)
inc (hl)
inc hl     ;next entry in array
djnz bar


pub fn main() !void {
    var array = [_]i32{1, 2, 3};
    apply(@TypeOf(array[0]), array[0..], func);
}

fn apply(comptime T: type, a: []T, f: fn(T) void) void {
    for (a) |item| {
        f(item);
    }
}

fn func(a: i32) void {
    const std = @import("std");
    std.debug.print("{d}\n", .{a-1});
}


module Main;
type
	Callback = procedure (integer): integer;
	Vector = array {math} * of integer;

procedure Power(i:integer):integer;
begin
	return i*i;
end Power;

procedure Map(x: Vector;p: Callback): Vector;
var
	i: integer;
	r: Vector;
begin
	r := new Vector(len(x));
	for i := 0 to len(x) - 1 do
		r[i] := p(i);
	end;
	return r
end Map;

procedure Write(x: Vector);
var
	i: integer;
begin
	for i := 0 to len(x) - 1 do
		write(x[i]:4)
	end;
	writeln
end Write;

var
	x,y: Vector;

begin
	x := [1,2,3,4,5];
	Write(Map(x,Power))
end Main.


PROC DrawWindow(BYTE x,y,len)
  BYTE i

  Position(x,y)
  Put(17)
  FOR i=1 TO len DO Put(18) OD
  Put(5)

  Position(x,y+1)
  Put(124)
  Position(x+len+1,y+1)
  Put(124)

  Position(x,y+2)
  Put(26)
  FOR i=1 TO len DO Put(18) OD
  Put(3)
RETURN

PROC RotateLeft(CHAR ARRAY a)
  BYTE i,tmp

  IF a(0)<1 THEN RETURN FI

  i=1 tmp=a(i)
  WHILE i<a(0)
  DO
    a(i)=a(i+1)
    i==+1
  OD
  a(a(0))=tmp
RETURN

PROC RotateRight(CHAR ARRAY a)
  BYTE i,tmp

  IF a(0)<1 THEN RETURN FI

  i=a(0) tmp=a(i)
  WHILE i>1
  DO
    a(i)=a(i-1)
    i==-1
  OD
  a(1)=tmp
RETURN

PROC Wait(BYTE frames)
  BYTE RTCLOK=$14

  frames==+RTCLOK
  WHILE frames#RTCLOK DO OD
RETURN

PROC Main()
  BYTE
    CH=$02FC, ;Internal hardware value for last key pressed
    CRSINH=$02F0 ;Controls visibility of cursor
  BYTE k,dir=[0]
  CHAR ARRAY text="Hello World! "

  Graphics(0)
  CRSINH=1 ;hide cursor
  Position(4,1)
  PrintE("Press Space to reverse direction")
  Position(11,2)
  Print("Press Esc to exit")
  DrawWindow(12,4,text(0))

  DO
    Position(13,5)
    Print(text)
    k=CH CH=$FF
    IF k=33 THEN dir==!$FF FI
    IF dir THEN
      RotateLeft(text)
    ELSE
      RotateRight(text)
    FI
    Wait(6)
  UNTIL k=28
  OD

  CRSINH=0 ;show cursor
RETURN


//create the text box
var textBox:TextField = new TextField();
addChild(textBox);

var text = "Hello, World! ";
var goingRight = true;

//modify the string and update it in the text box
function animate(e:Event)
{
	if(goingRight)
		text = text.slice(text.length-1,text.length) + text.slice(0, text.length - 1);
	else
		text = text.slice(1) + text.slice(0,1);
	textBox.text = text;
}

//event handler to perform the animation
textBox.addEventListener(Event.ENTER_FRAME, animate);
//event handler to register clicks
textBox.addEventListener(MouseEvent.MOUSE_DOWN, function(){goingRight = !goingRight;});


with Gtk.Main;
with Gtk.Handlers;
with Gtk.Label;
with Gtk.Button;
with Gtk.Window;
with Glib.Main;

procedure Animation is
   Scroll_Forwards : Boolean := True;

   package Button_Callbacks is new Gtk.Handlers.Callback
     (Gtk.Button.Gtk_Button_Record);

   package Label_Timeout is new Glib.Main.Generic_Sources
     (Gtk.Label.Gtk_Label);

   package Window_Callbacks is new Gtk.Handlers.Return_Callback
     (Gtk.Window.Gtk_Window_Record, Boolean);

   --  Callback for click event
   procedure On_Button_Click
     (Object : access Gtk.Button.Gtk_Button_Record'Class);

   --  Callback for delete event
   function On_Main_Window_Delete
     (Object : access Gtk.Window.Gtk_Window_Record'Class)
      return   Boolean;

   function Scroll_Text (Data : Gtk.Label.Gtk_Label) return Boolean;

   procedure On_Button_Click
     (Object : access Gtk.Button.Gtk_Button_Record'Class)
   is
      pragma Unreferenced (Object);
   begin
      Scroll_Forwards := not Scroll_Forwards;
   end On_Button_Click;

   function On_Main_Window_Delete
     (Object : access Gtk.Window.Gtk_Window_Record'Class)
      return   Boolean
   is
      pragma Unreferenced (Object);
   begin
      Gtk.Main.Main_Quit;
      return True;
   end On_Main_Window_Delete;

   function Scroll_Text (Data : Gtk.Label.Gtk_Label) return Boolean is
      Text : constant String := Gtk.Label.Get_Text (Data);
   begin
      if Scroll_Forwards then
         Gtk.Label.Set_Text
           (Label => Data,
            Str   => Text (Text'First + 1 .. Text'Last) & Text (Text'First));
      else
         Gtk.Label.Set_Text
           (Label => Data,
            Str   => Text (Text'Last) & Text (Text'First .. Text'Last - 1));
      end if;
      return True;
   end Scroll_Text;

   Main_Window     : Gtk.Window.Gtk_Window;
   Text_Button     : Gtk.Button.Gtk_Button;
   Scrolling_Text  : Gtk.Label.Gtk_Label;
   Timeout_ID      : Glib.Main.G_Source_Id;
   pragma Unreferenced (Timeout_ID);

begin
   Gtk.Main.Init;
   Gtk.Window.Gtk_New (Window => Main_Window);
   Gtk.Label.Gtk_New (Label => Scrolling_Text, Str => "Hello World! ");
   Gtk.Button.Gtk_New (Button => Text_Button);
   Gtk.Button.Add (Container => Text_Button, Widget => Scrolling_Text);
   Button_Callbacks.Connect
     (Widget => Text_Button,
      Name   => "clicked",
      Marsh  => Button_Callbacks.To_Marshaller (On_Button_Click'Access));
   Timeout_ID :=
     Label_Timeout.Timeout_Add
       (Interval => 125,
        Func     => Scroll_Text'Access,
        Data     => Scrolling_Text);
   Gtk.Window.Add (Container => Main_Window, Widget => Text_Button);
   Window_Callbacks.Connect
     (Widget => Main_Window,
      Name   => "delete_event",
      Marsh  => Window_Callbacks.To_Marshaller (On_Main_Window_Delete'Access));
   Gtk.Window.Show_All (Widget => Main_Window);
   Gtk.Main.Main;
end Animation;


 10  LET T$ = "HELLO WORLD! ":P = 1:L =  LEN (T$):T$ = T$ + T$
 20 D = 1: VTAB  INT (( PEEK (35) -  PEEK (34)) / 2) + 1: FOR R = 1 TO 0 STEP 0
 30  HTAB  INT (( PEEK (33) - L) / 2) + 1: PRINT  MID$ (T$,P,L);
 40 P = P + D: IF P > L THEN P = 1
 50  IF P < 1 THEN P = L
 60 R =  PEEK (49152) < 128: FOR I = 1 TO 5:B =  PEEK (49249) > 127: IF B <  > BO THEN BO = B: IF B = 0 THEN D =  - D
 70  NEXT I,R:R =  PEEK (49168)


SetTimer, Animate ; Timer runs every 250 ms.
String := "Hello World "
Gui, Add, Text, vS gRev, %String%
Gui, +AlwaysOnTop -SysMenu
Gui, Show
Return

Animate:
	String := (!Reverse) ? (SubStr(String, 0) . Substr(String, 1, StrLen(String)-1)) : (SubStr(String, 2) . SubStr(String, 1, 1))
	GuiControl,,S, %String%
return

Rev: ; Runs whenever user clicks on the text control
	Reverse := !Reverse
return


str$="Hello, World! "
direction=0	#value of 0: to the right, 1: to the left.
tlx=10		#Top left x
tly=10		#Top left y
fastgraphics
font "Arial",20,100	#The Font configuration (Font face, size, weight)

main:
while clickb=0
	if direction=0 then
		str$=RIGHT(str$,1) + LEFT(str$,length(str$)-1)
	else
		str$=MID(str$,2,length(str$)-1)+LEFT(str$,1)
	end if
	refresh
	clg
	color red
	text tlx,tly,str$
	pause .1
end while
	#Note: textheight() and textwidth() depends on the latest configuration of the FONT command.
if clickb=1 and clickx>=tlx and clickx<=tlx+textwidth(str$) and clicky>=tly and clicky<=tly+textheight() then
	direction=NOT direction
end if
clickclear
goto main


      VDU 23,22,212;40;16,32,16,128
      txt$ = "Hello World! "
      direction% = TRUE
      ON MOUSE direction% = NOT direction% : RETURN
      OFF
      REPEAT
        CLS
        PRINT txt$;
        IF direction% THEN
          txt$ = RIGHT$(txt$) + LEFT$(txt$)
        ELSE
          txt$ = MID$(txt$,2) + LEFT$(txt$,1)
        ENDIF
        WAIT 20
      UNTIL FALSE


#include <stdlib.h>
#include <string.h>
#include <gtk/gtk.h>

const gchar *hello = "Hello World! ";
gint direction = -1;
gint cx=0;
gint slen=0;

GtkLabel *label;

void change_dir(GtkLayout *o, gpointer d)
{
  direction = -direction;
}

gchar *rotateby(const gchar *t, gint q, gint l)
{
  gint i, cl = l, j;
  gchar *r = malloc(l+1);
  for(i=q, j=0; cl > 0; cl--, i = (i + 1)%l, j++)
    r[j] = t[i];
  r[l] = 0;
  return r;
}

gboolean scroll_it(gpointer data)
{
  if ( direction > 0 )
    cx = (cx + 1) % slen;
  else
    cx = (cx + slen - 1 ) % slen;
  gchar *scrolled = rotateby(hello, cx, slen);
  gtk_label_set_text(label, scrolled);
  free(scrolled);
  return TRUE;
}

int main(int argc, char **argv)
{
  GtkWidget *win;
  GtkButton *button;
  PangoFontDescription *pd;

  gtk_init(&argc, &argv);
  win = gtk_window_new(GTK_WINDOW_TOPLEVEL);
  gtk_window_set_title(GTK_WINDOW(win), "Basic Animation");
  g_signal_connect(G_OBJECT(win), "delete-event", gtk_main_quit, NULL);

  label = (GtkLabel *)gtk_label_new(hello);

  // since we shift a whole character per time, it's better to use
  // a monospace font, so that the shifting seems done at the same pace
  pd = pango_font_description_new();
  pango_font_description_set_family(pd, "monospace");
  gtk_widget_modify_font(GTK_WIDGET(label), pd);

  button = (GtkButton *)gtk_button_new();
  gtk_container_add(GTK_CONTAINER(button), GTK_WIDGET(label));

  gtk_container_add(GTK_CONTAINER(win), GTK_WIDGET(button));
  g_signal_connect(G_OBJECT(button), "clicked", G_CALLBACK(change_dir), NULL);

  slen = strlen(hello);

  g_timeout_add(125, scroll_it, NULL);

  gtk_widget_show_all(GTK_WIDGET(win));
  gtk_main();
  return 0;
}


using System;
using System.Drawing;
using System.Windows.Forms;

namespace BasicAnimation
{
  class BasicAnimationForm : Form
  {
    bool isReverseDirection;
    Label textLabel;
    Timer timer;

    internal BasicAnimationForm()
    {
      this.Size = new Size(150, 75);
      this.Text = "Basic Animation";

      textLabel = new Label();
      textLabel.Text = "Hello World! ";
      textLabel.Location = new Point(3,3);
      textLabel.AutoSize = true;
      textLabel.Click += new EventHandler(textLabel_OnClick);
      this.Controls.Add(textLabel);

      timer = new Timer();
      timer.Interval = 500;
      timer.Tick += new EventHandler(timer_OnTick);
      timer.Enabled = true;

      isReverseDirection = false;
    }

    private void timer_OnTick(object sender, EventArgs e)
    {
      string oldText = textLabel.Text, newText;
      if(isReverseDirection)
        newText = oldText.Substring(1, oldText.Length - 1) + oldText.Substring(0, 1);
      else
        newText = oldText.Substring(oldText.Length - 1, 1) + oldText.Substring(0, oldText.Length - 1);
      textLabel.Text = newText;
    }

    private void textLabel_OnClick(object sender, EventArgs e)
    {
      isReverseDirection = !isReverseDirection;
    }
  }

   class Program
   {
      static void Main()
      {
	Application.Run(new BasicAnimationForm());
      }
   }
}


#include "animationwidget.h"

#include <QLabel>
#include <QTimer>
#include <QVBoxLayout>

#include <algorithm>

AnimationWidget::AnimationWidget(QWidget *parent) : QWidget(parent) {
    setWindowTitle(tr("Animation"));
    QFont font("Courier", 24);
    QLabel* label = new QLabel("Hello World! ");
    label->setFont(font);
    QVBoxLayout* layout = new QVBoxLayout(this);
    layout->addWidget(label);
    QTimer* timer = new QTimer(this);
    connect(timer, &QTimer::timeout, this, [label,this]() {
        QString text = label->text();
        std::rotate(text.begin(), text.begin() + (right_ ? text.length() - 1 : 1), text.end());
        label->setText(text);
    });
    timer->start(200);
}

void AnimationWidget::mousePressEvent(QMouseEvent*) {
    right_ = !right_;
}


native("jvm")
module animation "1.0.0" {
	import java.desktop "8";
}


(import '[javax.swing JFrame JLabel])
(import '[java.awt.event MouseAdapter])

(def text "Hello World! ")
(def text-ct (count text))
(def rotations
  (vec
    (take text-ct
      (map #(apply str %)
        (partition text-ct 1 (cycle text))))))

(def pos (atom 0))  ;position in rotations vector being displayed
(def dir (atom 1))  ;direction of next position (-1 or 1)

(def label (JLabel. text))

(.addMouseListener label
  (proxy [MouseAdapter] []
    (mouseClicked [evt] (swap! dir -))))

(defn animator []
  (while true
    (Thread/sleep 100)
    (swap! pos #(-> % (+ @dir) (mod text-ct)))
    (.setText label (rotations @pos))))

(doto (JFrame.)
  (.add label)
  (.pack)
  (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
  (.setVisible true))

(future-call animator)  ;simple way to run animator on a separate thread


1 rem rosetta code
2 rem task: animation
10 t$="hello world! ":d=-1
20 print chr$(147);:rem clear screen
30 print "*****************"
35 print "*               *"
40 print "*               *"
45 print "*               *"
50 print "*****************"
60 print "{HOME}{DOWN}{DOWN}{RIGHT}{RIGHT}"t$
70 get k$
75 if k$=" " then d=not d
80 on (abs(d))+1 gosub 1000,1010
90 if k$="q" then print chr$(147):end
95 rem
100 rem between line 80 and line 999
110 rem check for other user input
120 rem and process accordingly
130 rem
999 for i=1 to 100:next:goto 60
1000 t$=right$(t$,len(t$)-1)+left$(t$,1):return
1010 t$=right$(t$,1)+left$(t$,len(t$)-1):return


(use-package :ltk)

(defparameter *message* "Hello World! ")
(defparameter *direction* :left)
(defun animate (label)
  (let* ((n (length *message*))
         (i (if (eq *direction* :left) 0 (1- n)))
         (c (char *message* i)))
    (if (eq *direction* :left)
        (setq *message* (concatenate 'string
				     (subseq *message* 1 n)
				     (list c)))
	(setq *message* (concatenate 'string (list c)
				     (subseq *message* 0 (1- n)))))
    (setf (ltk:text label) *message*)
    (ltk:after 125 (lambda () (animate label)))))

(defun basic-animation ()
  (ltk:with-ltk ()
      (let* ((label (make-instance 'label
                                   :font "Courier 14")))
        (setf (text label) *message*)
        (ltk:bind label "<Button-1>"
                  (lambda (event)
                    (declare (ignore event))
                    (cond
                     ((eq *direction* :left) (setq *direction* :right))
                     ((eq *direction* :right) (setq *direction* :left)))))
        (ltk:pack label)
        (animate label)
        (ltk:mainloop))))

(basic-animation)


module test26;

import qd, SDL_ttf, tools.time;

void main() {
  screen(320, 200);
  auto last = sec();
  string text = "Hello World! ";
  auto speed = 0.2;
  int dir = true;
  while (true) {
    cls;
    print(10, 10, Bottom|Right, text);
    if (sec() - last > speed) {
      last = sec();
      if (dir == 0) text = text[$-1] ~ text[0 .. $-1];
      else text = text[1 .. $] ~ text[0];
    }
    flip; events;
    if (mouse.clicked
      && mouse.pos in display.select(10, 10, 100, 20)
    ) dir = !dir;
  }
}


import 'package:flutter/material.dart';
import 'dart:async' show Timer;

void main() {

  var timer = const Duration( milliseconds: 75 ); // How often to update i.e. how fast the animation is

  runApp(MaterialApp (
    home: Scaffold (
      body: Center (
        child: AnimatedText( timer )
      )
    )
  ));
}

class AnimatedText extends StatefulWidget {

  final Duration period; // Time period for update

  AnimatedText( this.period );
  @override
  _AnimatedText createState() => _AnimatedText( period );
}

class _AnimatedText extends State<AnimatedText> {

  bool forward = true; // Text should go forward?

  Timer timer; // Timer Objects allow us to do things based on a period of time
  // We want to get an array of characters, but Dart does not have a char type
  // Below is the equivalent code
  var _text =  'Hello World!      '.runes // .runes gives us the unicode number of each character
    .map( (code) => String.fromCharCode(code) ) // Map all these codes to Strings containing the single character
    .toList(); // Conver to a List

  _AnimatedText( Duration period ){
    timer = Timer.periodic( period , (_){
      setState((){ // Set state forces the gui elements to be redrawn
        shiftText();

      });
    });
  }

  String get text => _text.join(''); // Getter, joins the list of chars into a string

  void shiftText() {
    if (forward) { // If we should go forward
      var last = _text.removeLast(); // Remove the last char

      _text.insert( 0, last); // Insert it at the front

    } else { // If we should go backward
      var first = _text.removeAt(0); // Remove the first char

      _text.insert( _text.length, first ); // Insert it at the end
    }

 }

  @override
  Widget build(BuildContext context) {
    return GestureDetector( // GestureDetector lets us capture events
      onTap: () => forward = !forward, // on Tap (Click in browser) invert the forward bool
      child: Text(
        text, // Call the text getter to get the shifted string
        style: TextStyle( // Styling
          fontSize: 50,
          color: Colors.grey[600]
        )
      )

    );
  }

}


unit Main;

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, Vcl.Controls, Vcl.Forms,
  Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    lblAniText: TLabel;
    tmrAniFrame: TTimer;
    procedure lblAniTextClick(Sender: TObject);
    procedure tmrAniFrameTimer(Sender: TObject);
  end;

var
  Form1: TForm1;
  Reverse: boolean = false;

implementation

{$R *.dfm}

procedure TForm1.lblAniTextClick(Sender: TObject);
begin
  Reverse := not Reverse;
end;

function Shift(text: string; direction: boolean): string;
begin
  if direction then
    result := text[text.Length] + text.Substring(0, text.Length - 1)
  else
    result := text.Substring(1, text.Length) + text[1];
end;

procedure TForm1.tmrAniFrameTimer(Sender: TObject);
begin
  with lblAniText do
    Caption := Shift(Caption, Reverse);
end;
end.


# State
var text := "Hello World! "
var leftward := false

# Window
def w := <swing:makeJFrame>("RC: Basic Animation")

# Text in window
w.setContentPane(def l := <swing:makeJLabel>(text))
l.setOpaque(true) # repaints badly if not set!
l.addMouseListener(def mouseListener {
    to mouseClicked(_) {
        leftward := !leftward
    }
    match _ {}
})

# Animation
def anim := timer.every(100, fn _ { # milliseconds
    def s := text.size()
    l.setText(text := if (leftward) {
        text(1, s) + text(0, 1)
    } else {
        text(s - 1, s) + text(0, s - 1)
    })
})

# Set up window shape and close behavior
w.pack()
w.setLocationRelativeTo(null)
w.addWindowListener(def windowListener {
    to windowClosing(_) { anim.stop() }
    match _ {}
})

# Start everything
w.show()
anim.start()


module Main exposing (..)

import Browser
import Html exposing (Html, div, pre, text)
import Html.Events exposing (onClick)
import Time

message : String
message =
    "Hello World! "

main : Program () Model Msg
main =
    Browser.element
        { init = init
        , update = update
        , subscriptions = subscriptions
        , view = view
        }

-- MODEL

type Direction
    = Forwards
    | Backwards

type alias Model =
    { time : Int
    , direction : Direction
    }

init : () -> ( Model, Cmd Msg )
init _ =
    ( { time = 0, direction = Forwards }, Cmd.none )

-- UPDATE

type Msg
    = Tick
    | SwitchDirection

switchDirection : Direction -> Direction
switchDirection d =
    case d of
        Forwards ->
            Backwards

        Backwards ->
            Forwards

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    let
        nextTime =
            case model.direction of
                Forwards ->
                    model.time - 1

                Backwards ->
                    model.time + 1
    in
    case msg of
        Tick ->
            ( { model | time = modBy (String.length message) nextTime }, Cmd.none )

        SwitchDirection ->
            ( { model | direction = switchDirection model.direction }, Cmd.none )

-- SUBSCRIPTIONS

subscriptions : Model -> Sub Msg
subscriptions _ =
    Time.every 200 (\_ -> Tick)

-- VIEW

rotate : String -> Int -> String
rotate m x =
    let
        end =
            String.slice x (String.length m) m

        beginning =
            String.slice 0 x m
    in
    end ++ beginning

view : Model -> Html Msg
view model =
    div []
        [ pre [ onClick SwitchDirection ]
            [ text <| rotate message model.time ]
        ]


open System.Windows

let str = "Hello world! "
let mutable i = 0
let mutable d = 1

[<System.STAThread>]
do
  let button = Controls.Button()
  button.Click.Add(fun _ -> d <- str.Length - d)
  let update _ =
    i <- (i + d) % str.Length
    button.Content <- str.[i..] + str.[..i-1]
  Media.CompositionTarget.Rendering.Add update
  (Application()).Run(Window(Content=button)) |> ignore


USING: accessors timers calendar kernel models sequences ui
ui.gadgets ui.gadgets.labels ui.gestures ;
FROM: models => change-model ;
IN: rosetta.animation

CONSTANT: sentence "Hello World! "

TUPLE: animated-label < label-control reversed alarm ;
: <animated-label> ( model -- <animated-model> )
    sentence animated-label new-label swap >>model
    monospace-font >>font ;
: update-string ( str reverse -- str )
    [ unclip-last prefix ] [ unclip suffix ] if ;
: update-model ( model reversed? -- )
    [ update-string ] curry change-model ;

animated-label
    H{
        { T{ button-down } [ [ not ] change-reversed drop ] }
     } set-gestures

M: animated-label graft*
  [ [ [ model>> ] [ reversed>> ] bi update-model ] curry 400 milliseconds every ] keep
  alarm<< ;
M: animated-label ungraft*
    alarm>> stop-timer ;
: main ( -- )
   [ sentence <model> <animated-label> "Rosetta" open-window ] with-ui ;

MAIN: main


using concurrent
using fwt
using gfx

const class RotateString : Actor
{
  new make (Label label) : super (ActorPool ())
  {
    Actor.locals["rotate-label"] = label
    Actor.locals["rotate-string"] = label.text
    Actor.locals["direction"] = "forward"
    sendLater (1sec, "update")
  }

  // responsible for calling appropriate methods to process each message
  override Obj? receive (Obj? msg)
  {
    switch (msg)
    {
      case "update":
        Desktop.callAsync |->| { update }  // make sure we update GUI in event thread
        sendLater (1sec, "update")
      case "reverse":
        Desktop.callAsync |->| { reverse }
    }

    return null
  }

  // change the stored string indicating the direction to rotate
  Void reverse ()
  {
    Actor.locals["direction"] =
        (Actor.locals["direction"] == "forward" ? "backward" : "forward")
  }

  // update the text on the label according to the stored direction
  Void update ()
  {
    label := Actor.locals["rotate-label"] as Label
    str := Actor.locals["rotate-string"] as Str
    if (label != null)
    {
      newStr := ""
      if (Actor.locals["direction"] == "forward")
        newStr = str[1..-1] + str[0].toChar
      else
        newStr = str[-1].toChar + str[0..<-1]
      label.text = newStr
      Actor.locals["rotate-string"] = newStr
    }
  }
}

class Animate
{
  public static Void main ()
  {
    label := Label
    {
      text = "Hello world! "
      halign = Halign.center
    }
    ticker := RotateString (label)
    label.onMouseDown.add |Event e|
    {
      ticker.send ("reverse")
    }
    Window
    {
      title = "Animate"
      label,
    }.open
  }
}


#INCLUDE <Include\Windows.inc>

FBSLSETTEXT(ME, "Hello world! ")
RESIZE(ME, 0, 0, 220, 0)
CENTER(ME)
SHOW(ME)
SetTimer(ME, 1000, 100, NULL)

BEGIN EVENTS
	STATIC bForward AS BOOLEAN = TRUE
	IF CBMSG = WM_TIMER THEN
		Marquee(bForward)
		RETURN 0
	ELSEIF CBMSG = WM_NCLBUTTONDOWN THEN
		IF CBWPARAM = HTCAPTION THEN bForward = NOT bForward
	ELSEIF CBMSG = WM_CLOSE THEN
		KillTimer(ME, 1000)
	END IF
END EVENTS

SUB Marquee(BYVAL forward AS BOOLEAN)
	STATIC caption AS STRING = FBSLGETTEXT(ME)
	STATIC length AS INTEGER = STRLEN(caption)
	IF forward THEN
		caption = RIGHT(caption, 1) & LEFT(caption, length - 1)
	ELSE
		caption = MID(caption, 2) & LEFT(caption, 1)
	END IF
	FBSLSETTEXT(ME, caption)
END SUB


DIM C AS STRING = "Hello World! ", SIZE AS USHORT = LEN(C)
DIM DIRECTION AS BYTE = 0
DIM AS INTEGER X, Y, BTNS
DIM HELD AS BYTE = 0

SCREEN 19

DO
 LOCATE 1, 1
 PRINT C

 GETMOUSE X, Y, , BTNS

 IF BTNS <> 0 AND HELD = 0 THEN
  'remember if it was pressed, to not react every frame
  HELD = 1
  IF X >= 0 AND X < SIZE * 8 AND Y >= 0 AND Y < 16 THEN
   DIRECTION = 1 - DIRECTION
  END IF
 ELSE
  HELD = 0
 END IF

 IF INKEY = CHR(255) + CHR(107) THEN EXIT DO

 IF DIRECTION = 0 THEN
  C = RIGHT(C, 1) + LEFT(C, SIZE - 1)
 ELSE
  C = RIGHT(C, SIZE - 1) + LEFT(C, 1)
 END IF

 SLEEP 100, 1
LOOP


'This code will create the necessary controls on a GUI Form

hLabel As Label                                   'Label needed to display the 'Hello World! " message
hTimer As Timer                                   'Timer to rotate the display
bDirection As Boolean                             'Used to control the direction of the text
'__________________________________________________
Public Sub Form_Open()
Dim hPanel As Panel                               '2 Panels used to centre the Label vertically on the Form
Dim hHBox As HBox                                 'Box to hold the Label

With Me                                           'Set the Form Properties
  .Arrangement = Arrange.Vertical                 'Arrange controls vertically
  .Title = "Animation"                            'Give the Form a Title
  .Height = 75                                    'Set the Height of the Form
  .Width = 225                                    'Set the Width of the Form
End With

hPanel = New Panel(Me)                            'Add a Panel to the Form
HPanel.Expand = True                              'Expand the Panel

hHBox = New HBox(Me)                              'Add a HBox to the Form
hHBox.Height = 28                                 'Set the HBox Height

hLabel = New Label(hHBox) As "LabelAnimation"     'Add new Lable with Event name

With hLabel                                       'Change the hLabel properties
  .Height = 35                                    'Set the Height of the Label
  .Expand = True                                  'Expand the hLabel
  .Font.Bold = True                               'Set the Font to Bold
  .Font.size = 20                                 'Set the Font Size
  .Alignment = Align.Center                       'Centre align the text
  .Tooltip = "Click me to reverse direction"      'Add a Tooltip
  .Border = Border.Plain                          'Add a Border
  .Text = "Hello World! "                         'Add the Text
End With

hPanel = New Panel(Me)                            'Add another Panel
HPanel.Expand = True                              'Expand the Panel

hTimer = New Timer As "Timer1"                    'Add a Timer
hTimer.delay = 500                                'Set the Timer Delay
hTimer.Start                                      'Start the Timer

End
'__________________________________________________
Public Sub LabelAnimation_MouseDown()             'If the hLabel is clicked..

bDirection = Not bDirection                       'Change the value of bDirection

End
'__________________________________________________
Public Sub Timer1_Timer()                         'Timer
Dim sString As String = hLabel.Text               'To hold the text in the Label
Dim sTemp As String                               'Temp string

If bDirection Then                                'If the text is to rotate left then..
  sTemp = Left(sString, 1)                        'Get the first charater of the Label Text e.g 'H'
  sString = Right(sString, -1) & sTemp            'Recreate sString with all the text less the 1st character e.g. 'ello World! ' and add the 1st character to the end e.g. 'ello World! H'
Else                                              'Else if text is to rotate right then..
  sTemp = Right(sString, 1)                       'Get the last charater of the Label Text e.g '!'
  sString = sTemp & Left(sString, -1)             'Recreate sString with all the text less the last character e.g. ' Hello World' and add the last character to the begining e.g. '! Hello World'
End If

hLabel.text = sString                             'Display the result

End


package main

import (
    "log"
    "time"

    "github.com/gdamore/tcell"
)

const (
    msg             = "Hello World! "
    x0, y0          = 8, 3
    shiftsPerSecond = 4
    clicksToExit    = 5
)

func main() {
    s, err := tcell.NewScreen()
    if err != nil {
        log.Fatal(err)
    }
    if err = s.Init(); err != nil {
        log.Fatal(err)
    }
    s.Clear()
    s.EnableMouse()
    tick := time.Tick(time.Second / shiftsPerSecond)
    click := make(chan bool)
    go func() {
        for {
            em, ok := s.PollEvent().(*tcell.EventMouse)
            if !ok || em.Buttons()&0xFF == tcell.ButtonNone {
                continue
            }
            mx, my := em.Position()
            if my == y0 && mx >= x0 && mx < x0+len(msg) {
                click <- true
            }
        }
    }()
    for inc, shift, clicks := 1, 0, 0; ; {
        select {
        case <-tick:
            shift = (shift + inc) % len(msg)
            for i, r := range msg {
                s.SetContent(x0+((shift+i)%len(msg)), y0, r, nil, 0)
            }
            s.Show()
        case <-click:
            clicks++
            if clicks == clicksToExit {
                s.Fini()
                return
            }
            inc = len(msg) - inc
        }
    }
}


import Graphics.HGL.Units (Time, Point, Size, )
import Graphics.HGL.Draw.Monad (Graphic, )
import Graphics.HGL.Draw.Text
import Graphics.HGL.Draw.Font
import Graphics.HGL.Window
import Graphics.HGL.Run
import Graphics.HGL.Utils

import Control.Exception (bracket, )

runAnim = runGraphics $
 bracket
  (openWindowEx "Basic animation task" Nothing (250,50) DoubleBuffered (Just 110))
  closeWindow
  (\w -> do
    f <- createFont (64,28) 0 False False "courier"
    let loop t dir = do
	  e <- maybeGetWindowEvent w
	  let d = case e of
		  Just (Button _ True False)  -> -dir
		  _ -> dir
	      t' = if d == 1 then last t : init t else tail t ++ [head t]
	  setGraphic w (withFont f $ text (5,10) t') >> getWindowTick w
	  loop  t' d

    loop "Hello world ! " 1  )


CHARACTER string="Hello World! "

   WINDOW(WINdowhandle=wh, Height=1, X=1, TItle="left/right click to rotate left/right, Y-click-position sets milliseconds period")
   AXIS(WINdowhandle=wh, PoinT=20, X=2048, Y, Title='ms', MiN=0, MaX=400, MouSeY=msec, MouSeCall=Mouse_callback, MouSeButton=button_type)
   direction = 4
   msec = 100    ! initial milliseconds
   DO tic = 1, 1E20
      WRITE(WIN=wh, Align='Center Vertical') string
      IF(direction == 4) string = string(LEN(string)) // string ! rotate left
      IF(direction == 8) string = string(2:) // string(1)       ! rotate right
      WRITE(StatusBar, Name) tic, direction, msec
      SYSTEM(WAIT=msec)
   ENDDO
 END

SUBROUTINE Mouse_callback()
   direction = button_type ! 4 == left button up, 8 == right button up
 END


import gui
$include "guih.icn"

class WindowApp : Dialog (label, direction)

  method rotate_left (msg)
    return msg[2:0] || msg[1]
  end

  method rotate_right (msg)
    return msg[-1:0] || msg[1:-1]
  end

  method reverse_direction ()
    direction := 1-direction
  end

  # this method gets called by the ticker, and updates the label
  method tick ()
    static msg := "Hello World! "
    if direction = 0
      then msg := rotate_left (msg)
      else msg := rotate_right (msg)
    label.set_label(msg)
  end

  method component_setup ()
    direction := 1 # start off rotating to the right
    label := Label("label=Hello World! ", "pos=0,0")
    # respond to a mouse click on the label
    label.connect (self, "reverse_direction", MOUSE_RELEASE_EVENT)
    add (label)

    connect (self, "dispose", CLOSE_BUTTON_EVENT)
    # tick every 100ms
    self.set_ticker (100)
  end
end

# create and show the window
procedure main ()
  w := WindowApp ()
  w.show_modal ()
end


coinsert'jgl2' [ require'gl2'

MESSAGE        =: 'Hello World! '
TIMER_INTERVAL =: 0.5 * 1000                                          NB. Milliseconds
DIRECTION      =: -1                                                  NB. Initial direction is right -->

ANIM           =: noun define
  pc anim closeok;pn "Basic Animation in J";
  minwh 350 5;
  cc isi isigraph flush;
  pcenter;pshow;
)

anim_run        =: verb def 'wd ANIM,''; ptimer '',":TIMER_INTERVAL'  NB. Set form timer
anim_timer      =: verb def 'glpaint MESSAGE=: DIRECTION |. MESSAGE'  NB. Rotate MESSAGE according to DIRECTION
anim_isi_mbldown=: verb def 'DIRECTION=: - DIRECTION'                 NB. Reverse direction when user clicks
anim_close      =: verb def 'wd ''timer 0; pclose; reset'' '          NB. Shut down timer
anim_isi_paint  =:  verb define
  glclear ''                                                          NB.  Clear out old drawing
  glrgb 255 0 0
  gltextcolor''
  glfont '"courier new" 36'
  gltext MESSAGE
)

anim_run ''


import java.awt.event.MouseAdapter;
import java.awt.event.MouseEvent;
import java.awt.event.WindowAdapter;
import java.awt.event.WindowEvent;
import java.util.Timer;
import java.util.TimerTask;
import javax.swing.JFrame;
import javax.swing.JLabel;
import javax.swing.WindowConstants;

public class Rotate {

    private static class State {
        private final String text = "Hello World! ";
        private int startIndex = 0;
        private boolean rotateRight = true;
    }

    public static void main(String[] args) {
        State state = new State();

        JLabel label = new JLabel(state.text);
        label.addMouseListener(new MouseAdapter() {
            @Override
            public void mouseClicked(MouseEvent event) {
                state.rotateRight = !state.rotateRight;
            }
        });

        TimerTask task = new TimerTask() {
            public void run() {
                int delta = state.rotateRight ? 1 : -1;
                state.startIndex = (state.startIndex + state.text.length() + delta) % state.text.length();
                label.setText(rotate(state.text, state.startIndex));
            }
        };
        Timer timer = new Timer(false);
        timer.schedule(task, 0, 500);

        JFrame rot = new JFrame();
        rot.setDefaultCloseOperation(WindowConstants.DISPOSE_ON_CLOSE);
        rot.add(label);
        rot.pack();
        rot.setLocationRelativeTo(null);
        rot.addWindowListener(new WindowAdapter() {
            @Override
            public void windowClosed(WindowEvent e) {
                timer.cancel();
            }
        });
        rot.setVisible(true);
    }

    private static String rotate(String text, int startIdx) {
        char[] rotated = new char[text.length()];
        for (int i = 0; i < text.length(); i++) {
            rotated[i] = text.charAt((i + startIdx) % text.length());
        }
        return String.valueOf(rotated);
    }
}


<html> <head>
    <title>RC: Basic Animation</title>
    <script type="text/javascript">
        function animate(id) {
            var element = document.getElementById(id);
            var textNode = element.childNodes[0]; // assuming no other children

            var text = textNode.data;
            var reverse = false;

            element.onclick = function () { reverse = !reverse; };

            setInterval(function () {
                if (reverse)
                    text = text.substring(1) + text[0];
                else
                    text = text[text.length - 1] + text.substring(0, text.length - 1);
                textNode.data = text;
            }, 100);
        }
    </script>
</head> <body onload="animate('target')">
    <pre id="target">Hello World! </pre>
</body> </html>