LIBRA

	_beerlib == true ;

HIDE
	beer == "of beer " putchars ;
	wall == "on the wall" putchars ;
	take1 == "Take one down and pass it around, " putchars ;
	dup3 == dup dup dup ;
	comma == ", " putchars ;
	period == '. putch ;
	bottles == [dup small]
		[ [null] [pop "no more bottles " putchars] [put "bottle " putchars] ifte]
		[put "bottles " putchars] ifte ;
	sing-verse == dup3 bottles beer wall comma
		bottles beer ".\n" putchars
		take1 1 - bottles beer wall period newline newline ;
	sing-verse-0 == "No more bottles of beer on the wall, no more bottles of beer\n" putchars
			"Go to the store and buy some more, " putchars
			99 bottles pop beer wall period newline ;

IN
	(* n -- *)
	sing-verses == [null]
			[sing-verse-0]
			[sing-verse 1 -] tailrec .


99
| (. - range(0;.+1) )
| "
\(.) bottles of beer on the wall
\(.) bottles of beer
Take one down, pass it around
\(.) bottles of beer on the wall"


/* 99 Bottles, in Jsish */
function plural(n:number):string { return (bottles == 1) ? "" : "s"; }
function no(n:number):string { return (bottles == 0) ? "No" : n.toString(); }

var bottles = 99;
do {
    printf("%d bottle%s of beer on the wall\n", bottles, plural(bottles));
    printf("%d bottle%s of beer\n", bottles, plural(bottles));
    puts("Take one down, pass it around");
    bottles--;
    printf("%s bottle%s of beer on the wall\n\n", no(bottles), plural(bottles));
} while (bottles > 0);


for i = 99:-1:1 print("\n$i bottles of beer on the wall\n$i bottles of beer\nTake one down, pass it around\n$(i-1) bottles of beer on the wall\n") end


// Loop that spits lyrics to "99 Bottles of Beer"

$n = 99;
$out = "";

:loop;
	$out = $out << $n << " bottles of beer on the wall, " << $n << " bottles of beer. Take one down, pass it around, " << $n - 1 << " bottles of beer on the wall…  ";
	$n = $n - 1;
	if $n > 0;
		goto loop;

return = $out;


99 bottles_of_beer_on_the_wall

define bottles_of_beer_on_the_wall (Int32 -> +IO):
  -> n;
  n th_verse
  if (n > 1): (n - 1) bottles_of_beer_on_the_wall

define th_verse (Int32 -> +IO):
  -> n;
  n bottles_of_beer on_the_wall       say
  n bottles_of_beer                   say
  take_one_down_pass_it_around        say
  (n - 1) bottles_of_beer on_the_wall say
  newline

define bottles_of_beer (Int32 -> List<Char>):
  bottles " of beer" cat

define on_the_wall (List<Char> -> List<Char>):
  " on the wall" cat

define take_one_down_pass_it_around (-> List<Char>):
  "take one down, pass it around"

define bottles (Int32 -> List<Char>):
  -> n;
  if (n = 0):
    "no more bottles"
  elif (n = 1):
    "one bottle"
  else:
    n show " bottles" cat


include ..\Utilitys.tlhy

:bottles
    dup 0 ==
    (
      ["no more bottles of beer"]
      [ dup 1 ==
        (
          ["1 bottle of beer"]
          [dup tostr " bottles of beer" chain]
        ) if
      ]
    ) if
;

( 99 1 -1 )
[ bottles print " on the wall," ?
  bottles "," chain ?
  "take one down, pass it around," ?
  1 - bottles print " on the wall." ? nl
  drop] for

" " input


bottles::{:[x=1;"bottle";"bottles"]}
itone::{:[x=1;"it";"one"]}
numno::{:[x=0;"no";x]}
drink::{.d(numno(x));
	.d(" ");
	.d(bottles(x));
	.p(" of beer on the wall");
	.d(numno(x));
	.d(" ");
	.d(bottles(x));
	.p(" of beer");
	.d("take ");
	.d(itone(x));
	.p(" down and pass it round");
	.d(numno(x-1));
	.d(" ");
	.d(bottles(x-1));
	.p(" of beer on the wall");.p("")}
drink'1+|!99


fun main(args: Array<String>) {
    for (i in 99.downTo(1)) {
        println("$i bottles of beer on the wall")
        println("$i bottles of beer")
        println("Take one down, pass it around")
    }
    println("No more bottles of beer on the wall!")
}


sig bottles.

type println      string -> o.
type round        int    -> o.
type bottles_song int    -> o.


{def beer
 {lambda {:i}
  {br}:i bottles of beer on the wall
  {br}:i bottles of beer
  {br}Take one down, pass it around
  {br}{- :i 1} bottles of beer on the wall
  {br}
}}

{S.map beer {S.serie 99 98 -1}}
...
{S.map beer {S.serie 2 1 -1}}
->
99 bottles of beer on the wall
99 bottles of beer
Take one down, pass it around
98 bottles of beer on the wall

98 bottles of beer on the wall
98 bottles of beer
Take one down, pass it around
97 bottles of beer on the wall
...

2 bottles of beer on the wall
2 bottles of beer
Take one down, pass it around
1 bottles of beer on the wall

1 bottles of beer on the wall
1 bottles of beer
Take one down, pass it around
0 bottles of beer on the wall


: ~ 2 compress "" join ;
: verses(*)
    dup " bottles of beer on the wall\n" ~ .
    dup " bottles of beer\n" ~ .
    "Take one down, pass it around\n" .
    1 - " bottles of beer on the wall\n\n" ~ .
    ;

99 iota 1 + reverse verses


local(
    beer = 99,
    song = ''
)
while(#beer > 0) => {
    #song->append(
        #beer + ' bottles of beer on the wall\n' +
        #beer + ' bottles of beer\n' +
        'Take one down, pass it around\n' +
        (#beer-1) + ' bottles of beer on the wall\n\n'
    )
    #beer--
}

#song


\documentclass{minimal}
\newcounter{beer}
\newcommand{\verses}[1]{
    \setcounter{beer}{#1}
    \par\noindent
    \arabic{beer} bottles of beer on the wall,\\
    \arabic{beer} bottles of beer!\\
    Take one down, pass it around---\\
    \addtocounter{beer}{-1}
    \arabic{beer} bottles of beer on the wall!\\
    \ifnum#1>0
        \verses{\value{beer}}
    \fi
}
\begin{document}
\verses{99}
\end{document}


DATA:
bottles-in-the-wall is number
plural is text

PROCEDURE:
store 99 in bottles-in-the-wall

sub-procedure check-plural
    if bottles-in-the-wall is not equal to 1 then
        store "s" in plural
    else
        store "" in plural
    end if
end sub-procedure

while bottles-in-the-wall is greater than 0 do
    call sub-procedure check-plural
    display bottles-in-the-wall " bottle" plural " of beer on the wall," crlf
    display bottles-in-the-wall " bottle" plural " of beer." crlf
    display "Take one down, pass it around," crlf
    subtract 1 from bottles-in-the-wall in bottles-in-the-wall
    call sub-procedure check-plural
    if bottles-in-the-wall is greater than 0 then
        display bottles-in-the-wall " bottle" plural " of beer on the wall." crlf crlf
    else
        display "No bottles of beer on the wall." crlf
    end if
repeat


to bottle :i
    if :i = 0 [output "|No more bottles of beer|]
    if :i = 1 [output "|One bottle of beer|]
    output word :i "| bottles of beer|
end

to it_one :n
    if :n = 1 [output "it][output "one]
end

to verse :i
    (print bottle :i "| on the wall,|)
    (print word bottle :i ".)
    (print "Take it_one :i "|down, pass it round|)
    (print bottle :i - 1 "| on the wall.|)
    print
end

to sing :i
    if :i = 0
    [
    print "|No more bottles of beer on the wall,
No more bottles of beer.
Go to the store and buy some more.
99 bottles of beer on the wall.|
    stop
    ]
    verse :i
    sing :i - 1
end

;Using it:
sing 99


implement Beer;

include "sys.m";
include "draw.m";

sys: Sys;

Beer : module
{
	init : fn(ctxt : ref Draw->Context, args : list of string);
};

init (ctxt: ref Draw->Context, args: list of string)
{
	sys = load Sys Sys->PATH;
	beers := 99;
	for (; beers > 1; --beers) {
		sys->print("%d bottles of beer on the wall\n", beers);
		sys->print("%d bottles of beer\n", beers);
		sys->print("Take one down, pass it around,\n");
		sys->print("%d bottles of beer on the wall\n\n", beers-1);
	};
	sys->print("1 bottle of beer on the wall\n1 bottle of beer\n");
	sys->print("Take it down, pass it around\nand nothing is left!\n\n");

}


repeat with i = 99 down to 2
    put i & " bottles of beer on the wall"
    put i & " bottles of beer"
    put "Take one down, pass it around"
    put (i-1) & " bottles of beer on the wall"
    put
end repeat

put "1 bottle of beer on the wall"
put "1 bottle of beer"
put "Take one down, pass it around"
put "No more bottles of beer on the wall"
put

put "No more bottles of beer on the wall"
put "No more bottles of beer"
put "Go to the store and buy some more"
put "99 bottles of beer on the wall"


to bottles :n
  if :n = 0 [output [No more bottles]]
  if :n = 1 [output [1 bottle]]
  output sentence :n "bottles
end
to verse :n
  print sentence bottles :n [of beer on the wall]
  print sentence bottles :n [of beer]
  print [Take one down, pass it around]
  print sentence bottles :n-1 [of beer on the wall]
end
for [n 99 1] [verse :n  (print)]


:- object(bottles).

    :- initialization(sing(99)).

    sing(0) :-
        write('No more bottles of beer on the wall, no more bottles of beer.'), nl,
        write('Go to the store and buy some more, 99 bottles of beer on the wall.'), nl, nl.
    sing(N) :-
        N > 0,
        N2 is N -1,
        beers(N), write(' of beer on the wall, '), beers(N), write(' of beer.'), nl,
        write('Take one down and pass it around, '), beers(N2), write(' of beer on the wall.'), nl, nl,
        sing(N2).

    beers(0) :-
        write('no more bottles').
    beers(1) :-
        write('1 bottle').
    beers(N) :-
        N > 1,
        write(N), write(' bottles').

:- end_object.


local bottles = 99

local function plural (bottles) if bottles == 1 then return '' end return 's' end
while bottles > 0 do
    print (bottles..' bottle'..plural(bottles)..' of beer on the wall')
    print (bottles..' bottle'..plural(bottles)..' of beer')
    print ('Take one down, pass it around')
    bottles = bottles - 1
    print (bottles..' bottle'..plural(bottles)..' of beer on the wall')
    print ()
end


// Run luval with -s inside the lucid shell script
// The print out is a list of lines. So the output is not separated by new lines, rather
// by '[' and ']' -- I cant figure out how to do string concatenation with numbers in lucid.
// beer(N) ^ bottle(N) ^ wall ^ beer(N) ^ bottle(N) ^ pass ^ beer(N-1) ^ bottle(N-1) ^ wall
// should have worked but doesn't
[%beer(N),bottle(N),wall,beer(N),bottle(N),pass,beer(N-1),bottle(N-1),wall%]
   where
       N = 100 fby N - 1;
       wall = if N > 0 then ` On the wall ' else eod fi;
       pass = `Take one down and pass it around.';
       beer(A) = if A > 0 then A else `No more' fi;
       bottle(A) = if A eq 1 then `bottle of beer' else `bottles of beer' fi;
   end


DEFINE DATA
	LOCAL
	  01 #BOTTLES  (I2)
END-DEFINE
*
FOR #BOTTLES 99 TO 2 STEP -1
	IF #BOTTLES < 98
	  WRITE #BOTTLES ' BOTTLES OF BEER ON THE WALL'
	  WRITE ' '
	END-IF
*
	WRITE #BOTTLES ' BOTTLES OF BEER ON THE WALL'
	WRITE #BOTTLES ' BOTTLES OF BEER'
	WRITE 'TAKE ONE DOWN, PASS IT AROUND'
END-FOR
*
WRITE '1 BOTTLE OF BEER ON THE WALL'
WRITE ' '
WRITE '1 BOTTLE OF BEER ON THE WALL'
WRITE '1 BOTTLE OF BEER'
WRITE 'TAKE IT DOWN, PASS IT AROUND'
WRITE 'NO MORE BOTTLES OF BEER ON THE WALL'
WRITE ' '
WRITE 'NO MORE BOTTLES OF BEER ON THE WALL'
WRITE 'NO MORE BOTTLES OF BEER'
WRITE 'GO TO THE STORE AND BUY SOME MORE'
WRITE '99 BOTTLES OF BEER'
END
WRITE 'TAKE ONE DOWN, PASS IT AROUND'
*
END


define(`BOTTLES', `bottles of beer')dnl
define(`BOTTLE', `bottle of beer')dnl
define(`WALL', `on the wall')dnl
define(`TAKE', `take one down, pass it around')dnl
define(`NINETEEN', `$1 ifelse(`$1',`1',BOTTLE,BOTTLES) WALL
$1 ifelse(`$1',`1',BOTTLE,BOTTLES)
ifelse(`$1',`0',,`TAKE')
ifelse(`$1',`0',,`NINETEEN(eval($1-1))')')dnl
NINETEEN(99)


;
;          99 BOTTLES OF BEER
;          WRITTEN  BY:  BILL GUNSHANNON
;

           .MCALL  .PRINT .EXIT
           .RADIX  10

MESG1:
CNUM1:     .ASCII  "  "
           .ASCII  " BOTTLES OF BEER ON THE WALL, "
CNUM2:     .ASCII  "  "
           .ASCII  " BOTTLES OF BEER."<13><10>
           .ASCII  "TAKE ONE DOWN AND PASS IT AROUND, "
CNUM3:     .ASCII  "  "
           .ASCIZ  " BOTTLES OF BEER ON THE WALL."<13><10><10>

MESG2:     .ASCII  " 2 BOTTLES OF BEER ON THE WALL, "
           .ASCII  " 2 BOTTLES OF BEER."<13><10>
           .ASCII  "TAKE ONE DOWN AND PASS IT AROUND, "
           .ASCIZ  " 1 BOTTLE OF BEER ON THE WALL."<13><10><10>

MESG3:     .ASCII  " 1 BOTTLE OF BEER ON THE WALL, "
           .ASCII  " 1 BOTTLE OF BEER."<13><10>
           .ASCII  "TAKE ONE DOWN AND PASS IT AROUND, "
           .ASCIZ  "NO MORE BOTTLES OF BEER ON THE WALL."<13><10><10>

MESG4:     .ASCII  "NO MORE BOTTLES OF BEER ON THE WALL, "
           .ASCII  "NO MORE BOTTLES OF BEER."<13><10>
           .ASCII  "GO TO THE STORE AND BUY SOME MORE, "
           .ASCIZ  "99 BOTTLES OF BEER ON THE WALL."<13><10><10>

           .EVEN

COUNT1:    .WORD   99      ;  STARTING NUMBER OF BOTTLES
PV:        .WORD   10.,1,  ;  POSITION VALUES FOR 2 DIGITS

START:
           MOV     COUNT1, R0
           MOV     R0, R5
           DEC     R5
AGAIN:

           MOV     #CNUM1, R1

;       CONVERT NUMBER OF BOTTLES TO ASCII FOR THE FIRST FIELD

           MOV     R0,-(SP)
           MOV     R1,-(SP)
           MOV     R2,-(SP)
           MOV     R3,-(SP)
           MOV     R4,-(SP)
           MOV     R5,-(SP)

           MOV     #PV, R3
           MOV     #2, R2
A1$:       MOV     #-1,R4
A2$:       INC     R4
           SUB     (R3), R0
           BCC     A2$
           ADD     (R3)+, R0
           ADD     #48, R4
           MOVB    R4, (R1)+
A21$:      SOB     R2, A1$

;   REMOVE LEADING ZERO - JUST LOOKS BETTER THAT WAY

           MOV     #CNUM1, R1
           CMPB    (R1), #48
           BNE     CONT1
           MOVB    #32, (R1)
CONT1:     MOV     #CNUM2, R0

;    MOVE THE ASCII NUMBER TO FIELD TWO RATHER THAN COMPUTING IT AGAIN

           MOVB    (R1)+, (R0)+
           MOVB    (R1), (R0)

           MOV     R5, R0
           MOV     #CNUM3, R1

;       CONVERT NUMBER OF BOTTLES TO ASCII FOR THE THIRD FIELD

           MOV     #PV, R3
           MOV     #2, R2
B1$:       MOV     #-1,R4
B2$:       INC     R4
           SUB     (R3), R0
           BCC     B2$
           ADD     (R3)+, R0
           ADD     #48, R4
           MOVB    R4, (R1)+
B21$:      SOB     R2, B1$

;   REMOVE LEADING ZERO - JUST LOOKS BETTER THAT WAY

           MOV     #CNUM3, R1
           CMPB    (R1), #48
           BNE     CONT2
           MOVB    #32, (R1)
CONT2:

           MOV     (SP)+,R5
           MOV     (SP)+,R4
           MOV     (SP)+,R3
           MOV     (SP)+,R2
           MOV     (SP)+,R1
           MOV     (SP)+,R0

;       HANDLE SPECIAL GRAMMER CASES

           CMP     R0, #2
           BNE     ONE
           .PRINT  #MESG2
           BR      DONE
ONE:       CMP     R0, #1
           BNE     GREATER
           .PRINT  #MESG3
           BR      DONE
GREATER:
           .PRINT  #MESG1

DONE:

;        DECREMENT THE COUNT AND START AGAIN

           MOV     R5, R0
           DEC     R5
           TST     R0
           BNE     AGAIN

;    OUT OF BEER, SEND THEM TO THE STORE

           .PRINT  #MESG4

;   CLEAN UP AND GO BACK TO KMON

           .EXIT

           .END     START


            NORMAL MODE IS INTEGER

            BOTLES = 99
VERSE       WALL.(BOTLES)
            BOTL.(BOTLES)
            PRINT FORMAT TKDWN
            BOTLES = BOTLES - 1
            WALL.(BOTLES)
            PRINT FORMAT EMPTY
            WHENEVER BOTLES .G. 0, TRANSFER TO VERSE

            INTERNAL FUNCTION(B)
            ENTRY TO BOTL.
            WHENEVER B .E. 1
               PRINT FORMAT ONEBTL
            OTHERWISE
               PRINT FORMAT BBTL,B
            END OF CONDITIONAL
            FUNCTION RETURN
            END OF FUNCTION

            INTERNAL FUNCTION(B)
            ENTRY TO WALL.
            WHENEVER B .E. 0
               PRINT FORMAT NOMORE
            OR WHENEVER B .E. 1
               PRINT FORMAT ONEOTW
            OTHERWISE
               PRINT FORMAT BBOTW,B
            END OF CONDITIONAL
            FUNCTION RETURN
            END OF FUNCTION

            VECTOR VALUES BBOTW  = $I2,S1,27HBOTTLES OF BEER ON THE WALL*$
            VECTOR VALUES BBTL   = $I2,S1,15HBOTTLES OF BEER*$
            VECTOR VALUES TKDWN  = $32HTAKE ONE DOWN AND PASS IT AROUND*$
            VECTOR VALUES ONEOTW = $S1,29H 1 BOTTLE OF BEER ON THE WALL*$
            VECTOR VALUES ONEBTL = $S1,17H 1 BOTTLE OF BEER*$
            VECTOR VALUES NOMORE = $35HNO MORE BOTTLES OF BEER ON THE WALL*$
            VECTOR VALUES EMPTY  = $*$
            END OF PROGRAM


START = 99
UP != jot - 2 `expr $(START) - 1` 1

0-bottles-of-beer: 1-bottle-of-beer
	@echo No more bottles of beer on the wall!

1-bottle-of-beer: 2-bottles-of-beer
	@echo One last bottle of beer on the wall!
	@echo
	@echo One last bottle of beer on the wall,
	@echo One last bottle of beer,
	@echo Take it down, pass it around.

.for COUNT in $(UP)
ONE_MORE != expr 1 + $(COUNT)
$(COUNT)-bottles-of-beer: $(ONE_MORE)-bottles-of-beer
	@echo $(COUNT) bottles of beer on the wall!
	@echo
	@echo $(COUNT) bottles of beer on the wall,
	@echo $(COUNT) bottles of beer,
	@echo Take one down, pass it around.
.endfor

$(START)-bottles-of-beer:
	@echo $(START) bottles of beer on the wall,
	@echo $(START) bottles of beer.
	@echo Take one down, pass it around.


seq( printf( "%d %s of beer on the wall,\n%d %s of beer.\nTake one down, pass it around,\n%d %s of beer on the wall.\n\n",
             i, `if`( i<>1, "bottles", "bottle" ),
             i, `if`( i<>1, "bottles", "bottle" ),
             i-1, `if`( i-1<>1, "bottles", "bottle") ),
i = 99..1, -1 );


Bottle[n_] := ToString[n] <> If[n==1," bottle"," bottles"] <> " of beer"

BottleSong[n_] := Speak[
  Bottle[n] <> " on the wall," <>
  Bottle[n] <>
  ", take one down, pass it around," <>
  Bottle[n-1] <> " on the wall."
]

BottleSong /@ Range[99,1,-1]


function ninetyNineBottlesOfBeer()

    disp( [ sprintf(['%d bottles of beer on the wall, %d bottles of beer.\n'...
        'Take one down, pass it around...\n'],[(99:-1:2);(99:-1:2)])...
        sprintf(['1 bottle of beer on the wall, 1 bottle of beer.\nTake'...
        'one down, pass it around;\nNo more bottles of beer on the wall.']) ] );

    %The end of this song makes me sad. The shelf should always have more
    %beer...like college.

end


bottles(n) := for i from n thru 1 step -1 do (
  printf(true, "~d bottle~p of beer on the wall~%", i, i),
  printf(true, "~d bottle~p of beer~%", i, i),
  printf(true, "Take one down, pass it around~%"),
  printf(true, "~d bottle~p of beer on the wall~%", i - 1, i - 1),
  disp(""))$

bottles(3);
/*

3 bottles of beer on the wall
3 bottles of beer
Take one down, pass it around
2 bottles of beer on the wall

2 bottles of beer on the wall
2 bottles of beer
Take one down, pass it around
1 bottle of beer on the wall

1 bottle of beer on the wall
1 bottle of beer
Take one down, pass it around
0 bottles of beer on the wall

*/


escapeEnable  = true
resetMaxFile #noPrompt
viewport.setType #view_top
max tool maximize
viewport.SetRenderLevel #smoothhighlights
delay = 1.6
a = text size:30
a.wirecolor = white
theMod = extrude()
addModifier a theMod

for i in 99 to 1 by -1 do -- this will iterate through 99 times use the escape key to terminate.
(
    a.text = (i as string + " bottles of beer on the wall")
    redrawViews()
    sleep delay
    a.text = (i as string + " bottles of beer")
    redrawViews()
    sleep delay
    a.text = "Take one down, pass it around"
    redrawViews()
    sleep delay
    a.text = ((i-1) as string + " bottles of beer on the wall")
    redrawViews()
    sleep delay
)


% file: beer.m
% author:
%   Fergus Henderson <[email protected]> Thursday 9th November 1995
% Re-written with new syntax standard library calls:
%   Paul Bone <[email protected]> 2015-11-20
%
% This beer song is more idiomatic Mercury than the original, I feel bad
% saying that since Fergus is a founder of the language.

:- module beer.
:- interface.
:- import_module io.

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

:- implementation.

:- import_module int.
:- import_module list.
:- import_module string.

main(!IO) :-
    beer(99, !IO).

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

beer(N, !IO) :-
    io.write_string(beer_stanza(N), !IO),
    ( N > 0 ->
        io.nl(!IO),
        beer(N - 1, !IO)
    ;
        true
    ).

:- func beer_stanza(int) = string.

beer_stanza(N) = Stanza :-
    ( N = 0 ->
        Stanza = "Go to the store and buy some more!\n"
    ;
        NBottles = bottles_line(N),
        N1Bottles = bottles_line(N - 1),
        Stanza =
            NBottles ++ " on the wall.\n" ++
            NBottles ++ ".\n" ++
            "Take one down, pass it around,\n" ++
            N1Bottles ++ " on the wall.\n"
    ).

:- func bottles_line(int) = string.

bottles_line(N) =
    ( N = 0 ->
        "No more bottles of beer"
    ; N = 1 ->
        "1 bottle of beer"
    ;
        string.format("%d bottles of beer", [i(N)])
    ).


(swap quote interpolate puts!) :line

(
  (
    ("$1 bottles of beer on the wall" line)
    ("$1 bottles of beer" line)
    (pop "Take one down, pass it around" puts!)
    (pred dup "$1 bottles of beer on the wall" line newline)
  ) cleave
) :verse

99 'verse over times


bottles = function(n)
    if n == 0 then return "no bottles"
    if n == 1 then return "1 bottle"
    return n + " bottles"
end function

verse = function(n)
    print bottles(n) + " of beer on the wall"
    print bottles(n) + " of beer"
    print "Take one down, pass it around"
    print bottles(n-1) + " of beer on the wall"
    print
end function

for i in range(99, 1)
    verse i
end for


##################################
# 99 bottles of beer on the wall #
# MIPS Assembly targeting MARS   #
# By Keith Stellyes              #
# August 24, 2016                #
##################################

#It is simple, a loop that goes as follows:

#if accumulator is not 1:
#PRINT INTEGER: accumulator
#PRINT lyrica
#PRINT INTEGER: accumulator
#PRINT lyricb
#PRINT INTEGER: accumulator
#PRINT lyricc
#DECREMENT accumulator

#else:
#PRINT FINAL LYRICS

.data
	lyrica: .asciiz " bottles of beer on the wall, "
	lyricb: " bottles of beer.\nTake one down and pass it around, "
	lyricc: " bottles of beer on the wall. \n\n"

	#normally, I don't like going past 80 columns, but that was done here.
	# there's an argument to be had for breaking this up. I chose not to
	# for simpler instructions.
	final_lyrics: "1 bottle of beer on the wall, 1 bottle of beer.\nTake one down and pass it around, no more bottles of beer on the wall.\n\nNo more bottles of beer on the wall, no more bottles of beer.\nGo to the store and buy some more, 99 bottles of beer on the wall."

.text
	#lw $a0,accumulator #load address of accumulator into $a0 (or is it getting val?)
	li $a1,99 #set the inital value of the counter to 99

loop:
	###99
	li $v0, 1 #specify print integer system service
	move $a0,$a1
	syscall #print that integer

	### bottles of beer on the wall,
	la $a0,lyrica
	li $v0,4
	syscall

	###99
	li $v0, 1 #specify print integer system service
	move $a0,$a1
	syscall #print that integer

	### bottles of beer.\n Take one down and pass it around,
	la $a0,lyricb
	li $v0,4
	syscall

	###99
	li $v0, 1 #specify print integer system service
	move $a0,$a1
	syscall #print that integer

	### "bottles of beer on the wall. \n\n"
	la $a0,lyricc
	li $v0,4
	syscall

	#decrement counter, if at 1, print the final and exit.
	subi $a1,$a1,1
	bne $a1,1,loop

### PRINT FINAL LYRIC, THEN TERMINATE.
final:  la $a0,final_lyrics
	li $v0,4
	syscall

	li $v0,10
	syscall


plural = 's'
99.downto(1) do |i|
  puts "#{i} bottle#{plural} of beer on the wall,"
  puts "#{i} bottle#{plural} of beer"
  puts "Take one down, pass it around!"
  plural = '' if i - 1 == 1
  if i > 1
    puts "#{i-1} bottle#{plural} of beer on the wall!"
    puts
  else
    puts "No more bottles of beer on the wall!"
  end
end


var %x = 99
while (%x) {
  echo -ag %x bottles of beer on the wall
  echo -ag %x bottles of beer
  echo -ag Take one down, pass it around
  dec %x
  echo -ag %x bottles of beer on the wall
}


MCSKIP "WITH" NL
"" 99 bottles - simple iterative version
MCSKIP MT,<>
MCINS %.
"" Macro to generate singular or plural bottle(s)
MCDEF BOT WITHS () AS <bottle<>MCGO L0 IF %A1. EN 1
s>
"" Main macro - argument is initial number of bottles
MCDEF BOTTLES NL AS <MCSET T1=%A1.
%L1.%T1. BOT(%T1.) of beer on the wall
%T1. BOT(%T1.) of beer
Take one down, pass it around
MCSET T1=T1-1
%T1. BOT(%T1.) of beer on the wall
MCGO L0 IF T1 EN 0

MCGO L1
>
"" Do it
BOTTLES 99


val NL = implode [#"newline"]

fun itone 1 = "it"
        | n = "one"

fun plural (s, 0) = ("no " @ s @ "s")
         | (s, 1) = ("1 " @ s)
         | (s, n) = (ntos n @ " " @ s @ "s")

fun verse 0 = "no bottles of beer on the wall" @ NL @
	      "no bottles of beer" @ NL @
	      "go to the store and buy some more" @ NL @
	      "99 bottles of beer on the wall" @ NL @ NL
        | x = plural ("bottle",x) @ " of beer on the wall" @ NL @
	      plural ("bottle",x) @ " of beer" @ NL @
	      "take " @ (itone x) @ " down and pass it round" @ NL @
	      plural ("bottle", (x-1)) @ " of beer on the wall" @ NL @ NL

fun bottles x = map (print o verse) (rev (0 :: iota (1, x)))

fun default (false, y) = y | (x, _) = x

;
bottles ` ston ` default (argv 0, "99")


MODULE b99;
IMPORT  InOut;

VAR     nr      : CARDINAL;

BEGIN
  nr := 99;
  REPEAT
    InOut.WriteCard (nr, 4);
    InOut.WriteString (" bottles of beer on the wall");
    InOut.WriteLn;
    InOut.WriteCard (nr, 4);
    InOut.WriteString (" bottles of beer");
    InOut.WriteLn;
    InOut.WriteString ("Take one down, pass it around");
    InOut.WriteLn;
    DEC (nr);
    InOut.WriteCard (nr, 4);
    InOut.WriteString (" bottles of beer on the wall");
    InOut.WriteLn;
    InOut.WriteLn
  UNTIL nr = 0
END b99.


MODULE Bottles EXPORTS Main;

IMPORT IO, Fmt;

BEGIN
  FOR i := 99 TO 1 BY -1 DO
    IO.Put(Fmt.Int(i) & " bottles of beer on the wall\n");
    IO.Put(Fmt.Int(i) & " bottles of beer\n");
    IO.Put("Take one down, pass it around\n");
    IO.Put(Fmt.Int(i - 1) & " bottles of beer on the wall\n");
    IO.Put("\n");
  END;
END Bottles.


Import mojo

Function Main ()
	New NintyNineBottles
End

Class NintyNineBottles Extends App

	Field _bottles:Int = 99
	Field _y:Int=640
	Field tic:Int
	Field duration:Int = 1500
	Field lyric:Int = 1
	Method OnCreate ()
		SetUpdateRate 60
	End

	  ' Stuff to do while running...
	Method OnUpdate ()
		If Millisecs()-Self.tic > Self.duration
			Self.tic=Millisecs()
			If Self.lyric= 4 Then Self._bottles-=1
			Self.lyric+=1

		End If
	End

	  ' Drawing code...

	Method OnRender ()
		Cls

		Select Self.lyric
			Case 1
				DrawText(_bottles+" bottles of beer on the wall",10,10)
			Case 2
				DrawText(_bottles+" bottles of beer",10,10)
			Case 3
				If Self._bottles > 1
					DrawText("take one down",10,10)
				Else
					DrawText("take it down",10,10)
				End If
			Case 4
				DrawText("Pass it around",10,10)
			Case 5
				If Self._bottles>0
					DrawText(Self._bottles+" bottles of beer on the wall",10,10)
				Else
					DrawText("no more bottles of beer on the wall",10,10)
				End If
			Case 6
				If Self._bottles>0
					Self.lyric=1'DrawText(Self._bottles+" bottles of beer on the wall",10,10)
				Else
					DrawText("no more bottles of beer",10,10)
				End if
			Case 7
				DrawText("go to the store",10,10)

			Case 8
				DrawText("and buy some more",10,10)
			Case 9
				Self._bottles=99
				DrawText(_bottles+" more bottles of beer on the wall",10,10)
			Case 10
				Self.lyric=1
		End Select

	End

End


99 VAR i .

WHILE i
    i TOSTR OUT . | bottles of beer on the wall| PRINT .
    i TOSTR OUT . | bottles of beer| PRINT .
    |Take one down, pass it around| PRINT .

    i 1 - VAR i .
ENDWHILE


bottles = 99;
while (bottles > 0)
  unit = (bottles == 1 ? "bottle" | "bottles");
  player:tell(bottles, " ", unit, " of beer on the wall.");
  player:tell(bottles, " ", unit, " of beer.");
  player:tell("Take one down, pass it around.");
  bottles = bottles - 1;
endwhile
player:tell("0 bottles of beer on the wall.");


p = (i) ->
	i != 1 and 's' or ''

for b = 99,1,-1
	for i = 1,4
		print if i == 3
			'Take one down, pass it around'
		else
			string.format '%s bottle%s of beer%s',
				i < 4 and b or b-1,
				i < 4 and (p b) or (p b-1),
				i%3 == 1 and ' on the wall' or ''
	io.write '\n'


beer(n)	If n<1 Write "No bottles of beer on the wall... " Quit
	Write !!,n," bottle",$Select(n=1:"",1:"s")," of beer on the wall."
	Write !,n," bottle",$Select(n=1:"",1:"s")," of beer."
	Write !,"Take one down, pass it around."
	Do beer(n-1)
	Quit

Do beer(99)


T Error
   String message
   F (message)
      .message = message

T RPNParse
   [Float] stk
   [Int] digits

   F op(f)
      I .stk.len < 2
         X Error(‘Improperly written expression’)
      V b = .stk.pop()
      V a = .stk.pop()
      .stk.append(f(a, b))

   F parse(s)
      L(c) s
         I c C ‘0’..‘9’
            .stk.append(Float(c))
            .digits.append(Int(c))
         E I c == ‘+’ {.op((a, b) -> a + b)}
         E I c == ‘-’ {.op((a, b) -> a - b)}
         E I c == ‘*’ {.op((a, b) -> a * b)}
         E I c == ‘/’ {.op((a, b) -> a / b)}
         E I c != ‘ ’
            X Error(‘Wrong char: ’c)

   F get_result()
      I .stk.len != 1
         X Error(‘Improperly written expression’)
      R .stk.last

[Int] digits
print(‘Make 24 with the digits:’, end' ‘’)
L 4
   V n = random:(1..9)
   print(‘ ’n, end' ‘’)
   digits.append(n)
print()

V parser = RPNParse()

X.try
   parser.parse(input())
   V r = parser.get_result()

   I sorted(digits) != sorted(parser.digits)
      print(‘Error: Not using the given digits’)
   E
      print(‘Result: ’r)

      I r C 23.999<.<24.001
         print(‘Good job!’)
      E
         print(‘Try again.’)

X.catch Error error
   print(‘Error: ’error.message)


\ Generate four random digits and display to the user
\ then get an expression from the user using +, -, / and * and the digits
\ the result must equal 24
\ http://8th-dev.com/24game.html

\ Only the words in namespace 'game' are available to the player:
ns: game

: + n:+ ;
: - n:- ;
: * n:* ;
: / n:/ ;

ns: G

var random-digits
var user-input

: one-digit \ a -- a
	rand n:abs 9 n:mod n:1+ a:push ;

: gen-digits \ - a
	[] clone nip \ the clone nip is not needed in versions past 1.0.2...
	' one-digit 4 times
	' n:cmp a:sort
	random-digits !  ;

: prompt-user
	cr "The digits are: " .  random-digits @ . cr ;

: goodbye
	cr "Thanks for playing!\n" . cr 0 die ;

: get-input
	70 null con:accept dup user-input !
	null? if drop goodbye then ;

: compare-digits
	true swap
	(
		\ inputed-array index
		dup >r
		a:@
		random-digits @ r> a:@ nip
		n:= not if
			break
			swap drop false swap
		then
	) 0 3 loop drop ;

/^\D*(\d)\D+(\d)\D+(\d)\D+(\d)\D*$/  var, digits-regex

: all-digits?
	user-input @ digits-regex @ r:match
	null? if drop false else
		5 = not if
			false
		else
			\ convert the captured digits in the regex into a sorted array:
			digits-regex @
			( r:@ >n swap ) 1 4 loop drop
			4 a:close ' n:cmp a:sort
			compare-digits
		then
	then ;

: does-eval?
	0 user-input @ eval 24 n:=
	dup not if
		cr "Sorry, that expression is wrong" . cr
	then ;

: check-input
	reset
	all-digits?  if
		does-eval? if
			cr "Excellent!  Your expression: \"" .
			user-input @ .
			"\" worked!" . cr
		then
	else
		cr "You did not use the digits properly, try again." . cr
	then ;

: intro quote |

Welcome to the '24 game'!

You will be shown four digits each time.  Using only the + - * and / operators
and all the digits (and only the digits), produce the number '24'

Enter your result in 8th syntax, e.g.:  4 4 + 2 1 + *

To quit the game, just hit enter by itself. Enjoy!

	| . ;

: start
	\ don't allow anything but the desired words
	ns:game only
	intro
	repeat
		gen-digits
		prompt-user
		get-input
		check-input
	again ;

start


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program game24_64.s   */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

.equ NBDIGITS,   4       // digits number
.equ TOTAL,      24
.equ BUFFERSIZE, 100
.equ STACKSIZE,  10      // operator and digits number items in stacks

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessRules:         .ascii "24 Game  64 bits.\n"
                    .ascii "The program will display four randomly-generated \n"
                    .ascii "single-digit numbers and will then prompt you to enter\n"
                    .ascii "an arithmetic expression followed by <enter> to sum \n"
                    .ascii "the given numbers to 24.\n"
                    .asciz "Exemple : 9+8+3+4   or (7+5)+(3*4) \n\n"

szMessExpr:         .asciz "Enter your expression (or type (q)uit to exit or (n) for other digits): \n"
szMessDigits:       .asciz "The four digits are @ @ @ @ and the score is 24. \n"
szMessNoDigit:      .asciz "Error : One digit is not in digits list !! \n"
szMessSameDigit:    .asciz "Error : Two digits are same !! \n"
szMessOK:           .asciz "It is OK. \n"
szMessNotOK:        .asciz "Error, it is not ok  total = @ \n"
szMessErrOper:      .asciz "Unknow Operator (+,-,$,/,(,)) \n"
szMessNoparen:      .asciz "no opening parenthesis !! \n"
szMessErrParen:     .asciz "Error parenthesis number !! \n"
szMessNoalldigits:  .asciz "One or more digits not used !!\n"
szMessNewGame:      .asciz "New game (y/n) ? \n"
szCarriageReturn:   .asciz "\n"
.align 4
qGraine:  .quad 123456
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:        .skip 24
sBuffer:          .skip BUFFERSIZE
iTabDigit:        .skip 8 * NBDIGITS
iTabTopDigit:     .skip 8 * NBDIGITS
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                 // entry of program

    ldr x0,qAdrszMessRules            // display rules
    bl affichageMess
1:
    mov x3,#0
    ldr x12,qAdriTabDigit
    ldr x11,qAdriTabTopDigit
    ldr x5,qAdrszMessDigits
2:                                    // loop generate random digits
    mov x0,#8
    bl genereraleas
    add x0,x0,#1
    str x0,[x12,x3,lsl #3]            // store in table
    mov x1,#0
    str x1,[x11,x3,lsl #3]            // raz top table
    ldr x1,qAdrsZoneConv
    bl conversion10                   // call decimal conversion
    //mov x2,#0
    //strb w2,[x1,x0]                   // reduce size display area with zéro final
    mov x0,x5
    ldr x1,qAdrsZoneConv              // insert conversion in message
    bl strInsertAtCharInc
    mov x5,x0
    add x3,x3,#1
    cmp x3,#NBDIGITS                  // end ?
    blt 2b                            // no -> loop
    mov x0,x5
    bl affichageMess
3:                                    // loop human entry
    ldr x0,qAdrszMessExpr
    bl affichageMess
    bl saisie                         // entry
    cmp x0,#'q'
    beq 100f
    cmp x0,#'Q'
    beq 100f
    cmp x0,#'n'
    beq 1b
    cmp x0,#'N'
    beq 1b

    bl evalExpr                      // expression evaluation
    cmp x0,#0                        // ok ?
    bne 3b                           // no - > loop

10:                                  // display new game ?
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    ldr x0,qAdrszMessNewGame
    bl affichageMess
    bl saisie
    cmp x0,#'y'
    beq 1b
    cmp x0,#'Y'
    beq 1b

100:                                  // standard end of the program
    mov x0, #0                        // return code
    mov x8, #EXIT                     // request to exit program
    svc #0                            // perform the system call

qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrszMessRules:          .quad szMessRules
qAdrszMessDigits:         .quad szMessDigits
qAdrszMessExpr:           .quad szMessExpr
qAdrszMessNewGame:        .quad szMessNewGame
qAdrsZoneConv:            .quad sZoneConv
qAdriTabDigit:            .quad iTabDigit
qAdriTabTopDigit:         .quad iTabTopDigit
/******************************************************************/
/*            evaluation expression                                       */
/******************************************************************/
/* x0 return 0 if ok -1 else */
evalExpr:
    stp x1,lr,[sp,-16]!        // save  registres
    stp x2,x3,[sp,-16]!        // save  registres
    stp x4,x5,[sp,-16]!        // save  registres
    stp x6,x7,[sp,-16]!        // save  registres
    stp x8,x9,[sp,-16]!        // save  registres
    stp x10,fp,[sp,-16]!       // save  registres
    mov x0,#0
    ldr x1,qAdriTabTopDigit
    mov x2,#0
1:                             // loop init table top digits
    str x0,[x1,x2,lsl #3]
    add x2,x2,#1
    cmp x2,#NBDIGITS
    blt 1b

    sub sp,sp,#STACKSIZE * 8   // stack operator
    mov fp,sp
    sub sp,sp,#STACKSIZE * 8   // stack digit
    mov x1,sp
    ldr x10,qAdrsBuffer
    mov x8,#0                  // indice character in buffer
    mov x7,#0                  // indice digits stack
    mov x2,#0                  // indice operator stack
    mov x9,0
1:                             // begin loop
    ldrb w9,[x10,x8]
    cmp x9,#0xA               // end expression ?
    beq 90f
    cmp x9,#' '               // space  ?
    cinc x8,x8,eq             // loop
    beq 1b
    cmp x9,#'('               // left parenthesis -> store in operator stack
    bne 11f
    str x9,[fp,x2,lsl 3]
    add x2,x2,#1
    add x8,x8,#1             // and loop
    b 1b
11:
    cmp x9,#')'               // right parenthesis ?
    bne 3f
    mov x0,fp                  // compute operator stack until left parenthesis
    sub x2,x2,#1
2:
    ldr x6,[fp,x2,lsl 3]
    cmp x6,#'('                // left parenthesis
    cinc x8,x8,eq              //  end ?
    beq 1b                     // and loop
    sub x7,x7,#1               // last digit
    mov x3,x7
    bl compute
    sub x2,x2,#1
    cmp x2,#0
    bge 2b
    ldr x0,qAdrszMessNoparen   // no left parenthesis in stack
    bl affichageMess
    mov x0,#-1
    b 100f
3:
    cmp x9,#'+'               // addition
    beq 4f
    cmp x9,#'-'               // soustraction
    beq 4f
    cmp x9,#'*'               // multiplication
    beq 4f
    cmp x9,#'/'               // division
    beq 4f

    b 5f                       // not operator

4:                             // control priority and depile stacks
    mov x0,fp
    mov x3,x7
    mov x4,x9
    bl depileOper
    mov x7,x3
    add x8,x8,#1
    b 1b                       // and loop

5:                             //  digit
    sub x9,x9,#0x30
    mov x0,x9
    bl digitControl
    cmp x0,#0                  // error ?
    bne 100f
    str x9,[x1,x7,lsl #3]     // store digit in digits stack
    add x7,x7,#1

    add x8,x8,#1
    beq 1b

    b 100f
90:                            // compute all stack operators
    mov x0,fp
    sub x7,x7,#1
91:
    subs x2,x2,#1
    blt 92f
    mov x3,x7
    bl compute
    sub x7,x7,#1
    b 91b
92:
    ldr x0,[x1]                 // total = first value on digits stack
    cmp x0,#TOTAL               // control total
    beq 93f                     // ok
    ldr x1,qAdrsZoneConv
    bl conversion10             // call decimal conversion
    mov x2,#0
    strb w2,[x1,x0]
    ldr x0,qAdrszMessNotOK
    ldr x1,qAdrsZoneConv        // insert conversion in message
    bl strInsertAtCharInc
    bl affichageMess
    mov x0,#-1
    b 100f
93:                             // control use all digits
    ldr x1,qAdriTabTopDigit
    mov x2,#0
94:                             // begin loop
    ldr x0,[x1,x2,lsl #3]       // load top
    cmp x0,#0
    bne 95f
    ldr x0,qAdrszMessNoalldigits
    bl affichageMess
    mov x0,#-1
    b 100f
95:
    add x2,x2,#1
    cmp x2,#NBDIGITS
    blt 94b
96:                             // display message OK
    ldr x0,qAdrszMessOK
    bl affichageMess
    mov x0,#0
    b 100f

100:
    add sp,sp,8 * (STACKSIZE *2)    // stack algnement
    ldp x10,fp,[sp],16          // restaur des  2 registres
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
qAdrszMessNoparen:        .quad szMessNoparen
qAdrszMessNotOK:          .quad szMessNotOK
qAdrszMessOK:             .quad szMessOK
qAdrszMessNoalldigits:    .quad szMessNoalldigits
/******************************************************************/
/*            depile operator                                     */
/******************************************************************/
/* x0 operator stack address  */
/* x1 digits stack address */
/* x2 operator indice */
/* x3 digits indice */
/* x4 operator */
/* x2 return a new operator indice */
/* x3 return a new digits indice */
depileOper:
    stp x4,lr,[sp,-16]!    // save  registres
    stp x5,x6,[sp,-16]!    // save  registres
    stp x7,x8,[sp,-16]!    // save  registres
    cmp x2,#0              // first operator ?
    beq 60f
    sub x5,x2,#1
1:
    ldr x6,[x0,x5,lsl #3]  // load stack operator
    cmp x6,x4              // same operators
    beq 50f
    cmp x6,#'*'            // multiplication
    beq 50f
    cmp x6,#'/'            // division
    beq 50f
    cmp x6,#'-'            // soustraction
    beq 50f

    b 60f
50:                        // depile operators stack and compute
    sub x2,x2,#1
    sub x3,x3,#1
    bl compute
    sub x5,x5,#1
    cmp x5,#0
    bge 1b
60:
    str x4,[x0,x2,lsl #3]  // add operator in stack
    add x2,x2,#1

100:
    ldp x7,x8,[sp],16           // restaur des  2 registres
    ldp x5,x6,[sp],16           // restaur des  2 registres
    ldp x4,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*            compute                                             */
/******************************************************************/
/* x0 operator stack address  */
/* x1 digits stack address */
/* x2 operator indice */
/* x3 digits indice */
compute:
    stp x1,lr,[sp,-16]!   // save  registres
    stp x2,x3,[sp,-16]!   // save  registres
    stp x4,x5,[sp,-16]!   // save  registres
    stp x6,x7,[sp,-16]!   // save  registres
    stp x8,x9,[sp,-16]!   // save  registres
    ldr x6,[x1,x3,lsl 3]  // load second digit
    sub x5,x3,#1
    ldr x7,[x1,x5,lsl 3]  // load first digit

    ldr x8,[x0,x2,lsl 3]  // load operator
    cmp x8,#'+'
    bne 1f
    add x7,x7,x6           // addition
    str x7,[x1,x5,lsl 3]
    b 100f
1:
    cmp x8,#'-'
    bne 2f
    sub x7,x7,x6           // soustaction
    str x7,[x1,x5,lsl 3]
    b 100f
2:
    cmp x8,#'*'
    bne 3f                 // multiplication
    mul x7,x6,x7
    str x7,[x1,x5,lsl 3]
    b 100f
3:
    cmp x8,#'/'
    bne 4f
    udiv x7,x7,x6          // division
    str x7,[x1,x5,lsl 3]
    b 100f
4:
    cmp x8,#'('            // left parenthesis ?
    bne 5f
    ldr x0,qAdrszMessErrParen //  error
    bl affichageMess
    mov x0,#-1
    b 100f
5:
    ldr x0,qAdrszMessErrOper
    bl affichageMess
    mov x0,#-1
100:
    ldp x8,x9,[sp],16     // restaur des  2 registres
    ldp x6,x7,[sp],16     // restaur des  2 registres
    ldp x4,x5,[sp],16     // restaur des  2 registres
    ldp x2,x3,[sp],16     // restaur des  2 registres
    ldp x1,lr,[sp],16     // restaur des  2 registres
    ret
qAdrszMessErrOper:   .quad szMessErrOper
qAdrszMessErrParen:  .quad szMessErrParen
/******************************************************************/
/*            control digits                                       */
/******************************************************************/
/* x0 return 0 if OK 1 if  not digit   */
digitControl:
    stp x1,lr,[sp,-16]!   // save  registres
    stp x2,x3,[sp,-16]!   // save  registres
    stp x4,x5,[sp,-16]!   // save  registres
    ldr x1,qAdriTabTopDigit
    ldr x2,qAdriTabDigit
    mov x3,#0
1:
    ldr x4,[x2,x3,lsl #3]  // load digit
    cmp x0,x4              // equal ?
    beq 2f                 // yes
    add x3,x3,#1           // no -> loop
    cmp x3,#NBDIGITS       // end ?
    blt 1b
    ldr x0,qAdrszMessNoDigit // error
    bl affichageMess
    mov x0,#1
    b 100f
2:                         // control prev use
    ldr x4,[x1,x3,lsl #3]
    cmp x4,#0
    beq 3f
    add x3,x3,#1
    cmp x3,#NBDIGITS
    blt 1b
    ldr x0,qAdrszMessSameDigit
    bl affichageMess
    mov x0,#1
    b 100f
3:
    mov x4,#1
    str x4,[x1,x3,lsl #3]
    mov x0,#0
100:
    ldp x4,x5,[sp],16     // restaur des  2 registres
    ldp x2,x3,[sp],16     // restaur des  2 registres
    ldp x1,lr,[sp],16     // restaur des  2 registres
    ret
qAdrszMessNoDigit:     .quad szMessNoDigit
qAdrszMessSameDigit:   .quad szMessSameDigit
/******************************************************************/
/*            string entry                                       */
/******************************************************************/
/* x0 return the first character of human entry */
saisie:
    stp x1,lr,[sp,-16]!   // save  registres
    stp x2,x3,[sp,-16]!   // save  registres
    stp x4,x5,[sp,-16]!   // save  registres
    stp x6,x7,[sp,-16]!   // save  registres
    mov x0,STDIN          // Linux input console
    ldr x1,qAdrsBuffer    // buffer address
    mov x2,BUFFERSIZE     // buffer size
    mov x8,READ           // request to read datas
    svc 0                 // call system
    ldr x1,qAdrsBuffer    // buffer address
    ldrb w0,[x1]          // load first character
100:
    ldp x6,x7,[sp],16     // restaur des  2 registres
    ldp x4,x5,[sp],16     // restaur des  2 registres
    ldp x2,x3,[sp],16     // restaur des  2 registres
    ldp x1,lr,[sp],16     // restaur des  2 registres
    ret
qAdrsBuffer:         .quad sBuffer
/***************************************************/
/*   Generation random number                  */
/***************************************************/
/* x0 contains limit  */
genereraleas:
    stp x1,lr,[sp,-16]!   // save  registres
    stp x2,x3,[sp,-16]!   // save  registres
    stp x4,x5,[sp,-16]!   // save  registres
    ldr x4,qAdrqGraine
    ldr x2,[x4]
    ldr x3,qNbDep1
    mul x2,x3,x2
    ldr x3,qNbDep2
    add x2,x2,x3
    str x2,[x4]           // maj de la graine pour l appel suivant
    cmp x0,#0
    beq 100f
    add x0,x0,#1
    udiv x3,x2,x0
    msub x0,x3,x0,x2      // résult = remainder

    ldp x4,x5,[sp],16     // restaur des  2 registres
    ldp x2,x3,[sp],16     // restaur des  2 registres
    ldp x1,lr,[sp],16     // restaur des  2 registres
    ret

/*****************************************************/
qAdrqGraine: .quad qGraine
qNbDep1:     .quad 0x0019660d
qNbDep2:     .quad 0x3c6ef35f
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


with Ada.Float_Text_IO;
with Ada.Text_IO;
with Ada.Numerics.Discrete_Random;
procedure Game_24 is
   subtype Digit is Character range '1' .. '9';
   package Random_Digit is new Ada.Numerics.Discrete_Random (Digit);
   Exp_Error : exception;
   Digit_Generator : Random_Digit.Generator;
   Given_Digits : array (1 .. 4) of Digit;
   Float_Value : constant array (Digit) of Float :=
      (1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0);
   function Apply_Op (L, R : Float; Op : Character) return Float is
   begin
      case Op is
         when '+' =>
            return L + R;
         when '-' =>
            return L - R;
         when '*' =>
            return L * R;
         when '/' =>
            return L / R;
         when others =>
            Ada.Text_IO.Put_Line ("Unexpected operator: " & Op);
            raise Exp_Error;
      end case;
   end Apply_Op;
   function Eval_Exp (E : String) return Float is
      Flt : Float;
      First : Positive := E'First;
      Last : Positive;
      function Match_Paren (Start : Positive) return Positive is
         Pos : Positive := Start + 1;
         Level : Natural := 1;
      begin
         loop
            if Pos > E'Last then
               Ada.Text_IO.Put_Line ("Unclosed parentheses.");
               raise Exp_Error;
            elsif E (Pos) = '(' then
               Level := Level + 1;
            elsif E (Pos) = ')' then
               Level := Level - 1;
               exit when Level = 0;
            end if;
            Pos := Pos + 1;
         end loop;
         return Pos;
      end Match_Paren;
   begin
      if E (First) = '(' then
         Last := Match_Paren (First);
         Flt := Eval_Exp (E (First + 1 .. Last - 1));
      elsif E (First) in Digit then
         Last := First;
         Flt := Float_Value (E (First));
      else
         Ada.Text_IO.Put_Line ("Unexpected character: " & E (First));
         raise Exp_Error;
      end if;
      loop
         if Last = E'Last then
            return Flt;
         elsif Last = E'Last - 1 then
            Ada.Text_IO.Put_Line ("Unexpected end of expression.");
            raise Exp_Error;
         end if;
         First := Last + 2;
         if E (First) = '(' then
            Last := Match_Paren (First);
            Flt := Apply_Op (Flt, Eval_Exp (E (First + 1 .. Last - 1)),
                             Op => E (First - 1));
         elsif E (First) in Digit then
            Last := First;
            Flt := Apply_Op (Flt, Float_Value (E (First)),
                             Op => E (First - 1));
         else
            Ada.Text_IO.Put_Line ("Unexpected character: " & E (First));
            raise Exp_Error;
         end if;
      end loop;
   end Eval_Exp;
begin
   Ada.Text_IO.Put_Line ("24 Game");
   Ada.Text_IO.Put_Line ("- Enter Q to Quit");
   Ada.Text_IO.Put_Line ("- Enter N for New digits");
   Ada.Text_IO.Put_Line ("Note: Operators are evaluated left-to-right");
   Ada.Text_IO.Put_Line ("      (use parentheses to override)");
   Random_Digit.Reset (Digit_Generator);
   <<GEN_DIGITS>>
   Ada.Text_IO.Put_Line ("Generating 4 digits...");
   for I in Given_Digits'Range loop
      Given_Digits (I) := Random_Digit.Random (Digit_Generator);
   end loop;
   <<GET_EXP>>
   Ada.Text_IO.Put ("Your Digits:");
   for I in Given_Digits'Range loop
      Ada.Text_IO.Put (" " & Given_Digits (I));
   end loop;
   Ada.Text_IO.New_Line;
   Ada.Text_IO.Put ("Enter your Expression: ");
   declare
      Value : Float;
      Response : constant String := Ada.Text_IO.Get_Line;
      Prev_Ch : Character := ' ';
      Unused_Digits : array (Given_Digits'Range) of Boolean :=
        (others => True);
   begin
      if Response = "n" or Response = "N" then
         goto GEN_DIGITS;
      end if;
      if Response = "q" or Response = "Q" then
         return;
      end if;
      -- check input
      for I in Response'Range loop
         declare
            Ch : constant Character := Response (I);
            Found : Boolean;
         begin
            if Ch in Digit then
               if Prev_Ch in Digit then
                  Ada.Text_IO.Put_Line ("Illegal multi-digit number used.");
                  goto GET_EXP;
               end if;
               Found := False;
               for J in Given_Digits'Range loop
                  if Unused_Digits (J) and then
                        Given_Digits (J) = Ch then
                     Unused_Digits (J) := False;
                     Found := True;
                     exit;
                  end if;
               end loop;
               if not Found then
                  Ada.Text_IO.Put_Line ("Illegal number used: " & Ch);
                  goto GET_EXP;
               end if;
            elsif Ch /= '(' and Ch /= ')' and Ch /= '+' and
                  Ch /= '-' and Ch /= '*' and Ch /= '/' then
               Ada.Text_IO.Put_Line ("Illegal character used: " & Ch);
               goto GET_EXP;
            end if;
            Prev_Ch := Ch;
         end;
      end loop;
      -- check all digits used
      for I in Given_Digits'Range loop
         if Unused_Digits (I) then
            Ada.Text_IO.Put_Line ("Digit not used: " & Given_Digits (I));
            goto GET_EXP;
         end if;
      end loop;
      -- check value
      begin
         Value := Eval_Exp (Response);
      exception
         when Exp_Error =>
            goto GET_EXP; -- Message displayed by Eval_Exp;
      end;
      if abs (Value - 24.0) > 0.001 then
         Ada.Text_IO.Put ("Value ");
         Ada.Float_Text_IO.Put (Value, Fore => 0, Aft => 3, Exp => 0);
         Ada.Text_IO.Put_Line (" is not 24!");
         goto GET_EXP;
      else
         Ada.Text_IO.Put_Line ("You won!");
         Ada.Text_IO.Put_Line ("Enter N for a new game, or try another solution.");
         goto GET_EXP;
      end if;
   end;
end Game_24;


tfgame←{⎕IO←1
    ⎕←d←?⍵⍴9
    i←⍞
    u[⍋u←{⍎¨⍣(0≠≢⍵)⊢⍵}(i∊'1234567890')⊆i]≢d[⍋d]:'nope'
    ~∧/((~b←i∊'1234567890')/i)∊'+-×÷()':'nope'
    24≠⍎i:'nope'
    'Yeah!'
}


 0 BH =  PEEK (104):BL =  PEEK (103)
 1  GOSUB 1200: CALL  - 868
 10  LET N$ = ""
 20 R =  RND ( - ( PEEK (78) +  PEEK (79) * 256)): REM RANDOMIZE
 30  FOR I = 1 TO 4
 40      LET N$ = N$ +  STR$ ( INT ( RND (1) * 9) + 1)
 50  NEXT I
 60  PRINT " PRESS A KEY TO CONTINUE. ";: GET A$
 65  LET I$ = "": LET F$ = "": LET P$ = ""
 70  HOME
 80  PRINT M$M$ SPC( 16)"24 GAME"
 90  PRINT M$"ALLOWED CHARACTERS:"M$
 100  LET I$ = N$ + "+-*/()"
 110  HTAB 20
 120  FOR I = 1 TO 10
 130      PRINT  MID$ (I$,I,1)" ";
 140  NEXT I
 150  PRINT M$ TAB( 7)"0 TO END"M$
 160  INPUT "ENTER THE FORMULA: ";F$
 170  IF F$ = "0" THEN  END : GOTO 65
 180  PRINT M$ TAB( 7)F$" = ";
 190  FOR I = 1 TO  LEN (F$)
 200      LET C$ =  MID$ (F$,I,1)
 210      IF C$ = " " THEN  LET F$ =  MID$ (F$,1,I - 1) +  MID$ (F$,I + 1): GOTO 250
 220      IF C$ = "+" OR C$ = "-" OR C$ = "*" OR C$ = "/" THEN  LET P$ = P$ + "O": GOTO 250
 230      IF C$ = "(" OR C$ = ")" THEN  LET P$ = P$ + C$: GOTO 250
 240      LET P$ = P$ + "N"
 250  NEXT I
 260  RESTORE
 270  FOR I = 1 TO 11
 280      READ T$
 290      IF T$ = P$ THEN  LET I = 11
 300  NEXT I
 310  IF T$ <  > P$ THEN  INVERSE : PRINT "BAD CONSTRUCTION!"G$M$: NORMAL : GOTO 60
 320  FOR I = 1 TO  LEN (F$)
 330      FOR J = 1 TO 10
 340      IF ( MID$ (F$,I,1) =  MID$ (I$,J,1)) AND  MID$ (F$,I,1) > "0" AND  MID$ (F$,I,1) <  = "9" THEN  LET I$ =  MID$ (I$,1,J - 1) + " " +  MID$ (I$,J + 1, LEN (I$))
 350  NEXT J,I
 370  IF  MID$ (I$,1,4) <  > "    " THEN  INVERSE : PRINT "INVALID ARGUMENTS!"G$M$: NORMAL : GOTO 60
 380  GOSUB 600: REM LET R = VAL(F$)
 390  PRINT R" ";
 400  IF R <  > 24 THEN  INVERSE : PRINT "WRONG!"G$M$: NORMAL : GOTO 60
 410  INVERSE : PRINT "CORRECT!"M$: NORMAL : GOTO 10
 420  DATA"NONONON"
 430  DATA"(NON)ONON"
 440  DATA"NONO(NON)"
 450  DATA"NO(NO(NON))"
 460  DATA"((NON)ON)ON"
 470  DATA"NO(NON)ON"
 480  DATA"(NON)O(NON)"
 485  DATA"NO((NON)ON)"
 490  DATA"(NONON)ON"
 495  DATA"(NO(NON))ON"
 500  DATA"NO(NONON)"
 600  REMGET BASIC TO EVALUATE OUR EXPRESSION
 605 A$ = "R=" + F$: GOSUB 1440
 610  FOR I = 1 TO  LEN (A$)
 615      REMSIMPLE TOKEN TRANSLATION
 620     B =  ASC ( MID$ (A$,I,1))
 625      IF (B > 41 AND B < 48) OR B = 61 OR B = 94 THEN B = T(B)
 630      POKE (AD + I - 1),B
 635  NEXT
 640  GOSUB 2000
 645  REM  GOSUB 1440:REM UNCOMMENT TO CLEAR EVALUATION LINE AFTER USE
 650  RETURN
 1200 M$ =  CHR$ (13)
 1210 G$ =  CHR$ (7)
 1220  HOME
 1230  PRINT  SPC( 16)"24 GAME"
 1240  PRINT M$" THE GOAL OF THIS GAME IS TO FORMULATE"
 1250  PRINT M$" AN ARITHMETIC EXPRESSION THAT"
 1260  PRINT M$" EVALUATES TO A VALUE OF 24, HOWEVER"
 1270  PRINT M$" YOU MAY USE ONLY THE FOUR NUMBERS"
 1280  PRINT M$" GIVEN AT RANDOM BY THE COMPUTER AND"
 1290  PRINT M$" THE STANDARD ARITHMETIC OPERATIONS OF"
 1300  PRINT M$" ADD, SUBTRACT, MULTIPLY, AND DIVIDE."
 1310  PRINT M$" EACH DIGIT MUST BE USED BY ITSELF. "
 1320  PRINT M$" (E.G. IF GIVEN 1, 2, 3, 4, YOU CANNOT"
 1330  PRINT M$" COMBINE 1 AND 2 TO MAKE 12.)"
 1340  PRINT M$
 1350  PRINT "INITIALIZING...";
 1360  HTAB 1
 1400  DIM T(94)
 1401 T( ASC ("+")) = 200: REM $C8
 1402 T( ASC ("-")) = 201: REM $C9
 1403 T( ASC ("*")) = 202: REM $CA
 1404 T( ASC ("/")) = 203: REM $CB
 1405 T( ASC ("=")) = 208: REM $D0
 1406 T( ASC ("^")) = 204: REM $CC
 1409  REMLOCATE LINE 2005 IN RAM
 1410 LH = BH:LL = BL:NH = 0:NL = 0
 1415 AD = LH * 256 + LL
 1420 LH =  PEEK (AD + 1):LL =  PEEK (AD)
 1425 NL =  PEEK (AD + 2):NH =  PEEK (AD + 3):N = NH * 256 + NL
 1430  IF N <  > 2005 THEN  GOTO 1415
 1435 AD = AD + 4: RETURN
 1440  FOR J = AD TO AD + 12: POKE J, ASC (":"): NEXT
 1445  RETURN
 2000  REMPUT 13 COLONS ON THE NEXT LINE
 2005 :::::::::::::
 2010  RETURN


use std, array, list

do
  generate random digits
  show random digits
  let result = parse expression (get input line)
  if result != ERROR
    if some digits are unused
      print "Wrong ! (you didn't use all digits)" ; failure++
    else if result == 24.0
      print "Correct !" ; success++
    else
      print "Wrong ! (you got "result")" ; failure++
 while play again ?
print "success:"success" failure:"failure" total:"(success+failure) as int

let success = 0, failure = 0.

.: generate random digits :.
   our nat seed = 0xc6f31 (: default seed when /dev/urandom doesn't exist :)
   let urandom = fopen "/dev/urandom" "r"
   if  urandom isn't nil
     fread &seed size of seed 1 urandom
     fclose urandom
   Cfunc srandom seed
   seed = (Cfunc random) as nat
   for each (val int d) from 0 to 3
     digits[d] = '1' + (seed % 9)
     seed /= 9

let digits be an array of 4 byte

.: show random digits :.
   print "Enter an expression that equates to 24 using only all these digits:"
   printf "%c , %c , %c , %c\n"(digits[0])(digits[1])(digits[2])(digits[3])
   printf "24 = "

.: some digits are unused :. -> bool
   for each (val int d) from 0 to 3
     return true if digits[d] != '\0'
   false

.: get input line :. -> text
   our array of 64 byte line
   Cfunc fgets (line) (size of line) (stdin)
   let int i
   for (i = 0) (line[i] != 0) (i++)
     line[i] = '\0' if (line[i] == '\n')
   line as text

.: play again ? :. -> bool
   while true
     printf "Play again ? (y/n) " ; Cfunc fflush stdout
     let answer = get input line
     switch answer[0]
       case 'n' {return false}
       case 'y' {return true }
       default  {continue    }
   false

=: ERROR := -> real {-32202.0}

.: parse expression <text expr> :. -> real
   let x = 0.0, x_is_set = false, op = ' '.
   let stack be a list of State ; class State {byte op; real x}
   for (stack = nil) (*expr != 0) (expr++)
     switch *expr
       case '+' ; case '-' ; case '*' ; case '/'
         error "bad syntax" if not x_is_set
	 op = *expr
       case '1' ; case '2' ; case '3' ; case '4' ; case '5'
       case '6' ; case '7' ; case '8' ; case '9'
	 error "missing operator" if (x_is_set and op == ' ')
	 error "unavailable digit" unless consume digit expr[0]
	 do operation with (expr[0] - '0') as real
       case (Cgen "'('")
	 error "missing operator" if (op == ' ' but x_is_set)
	 (new list (new State) (code of del State())) << stack
	 op = ' ' ; x_is_set = false (: start fresh state :)
       case (Cgen "')'")
         error "mismatched parenthesis" if stack is nil
	 error "wrong syntax" if not x_is_set
	 let y = x
	 x = stack.data.x ; op = stack.data.op
	 delete pop stack
	 do operation with y
       default {error "disallowed character"}

       .:new State          :. -> State {let s=new(State); s.x=x; s.op=op; s}
       .:del State <State s>:.          {               free s              }
       .:do operation with <real y>:.
  	 switch op
	   case '+' {x += y}
	   case '-' {x -= y}
	   case '*' {x *= y}
	   case '/' {x /= y}
	   default  {x  = y; x_is_set = true}
         op = ' '
   =:error<text msg>:= ->real {eprint "Error: "msg" at ["expr"]";return ERROR}
   .:consume digit <byte b>:. -> bool
     for each (val int d) from 0 to 3
       if digits[d] == b
         digits[d] = '\0'
       	 return true
     false

   if stack isn't nil
     delete all stack
     error "unclosed parenthesis"
   return x


/* ARM assembly Raspberry PI  */
/*  program game24.s   */

/* REMARK 1 : this program use routines in a include file
   see task Include a file language arm assembly
   for the routine affichageMess conversion10
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"
.equ STDIN,      0       @ Linux input console
.equ READ,       3       @ Linux syscall
.equ NBDIGITS,   4       @ digits number
.equ TOTAL,      24
.equ BUFFERSIZE, 100
.equ STACKSIZE,  10      @ operator and digits number items in stacks

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessRules:         .ascii "24 Game\n"
                    .ascii "The program will display four randomly-generated \n"
                    .ascii "single-digit numbers and will then prompt you to enter\n"
                    .ascii "an arithmetic expression followed by <enter> to sum \n"
                    .ascii "the given numbers to 24.\n"
                    .asciz "Exemple : 9+8+3+4   or (7+5)+(3*4) \n\n"

szMessExpr:         .asciz "Enter your expression (or type (q)uit to exit or (n) for other digits): \n"
//szMessErrChoise:    .asciz "invalid choice.\n "
szMessDigits:       .asciz "The four digits are @ @ @ @ and the score is 24. \n"
szMessNoDigit:      .asciz "Error : One digit is not in digits list !! \n"
szMessSameDigit:    .asciz "Error : Two digits are same !! \n"
szMessOK:           .asciz "It is OK. \n"
szMessNotOK:        .asciz "Error, it is not ok  total = @ \n"
szMessErrOper:      .asciz "Unknow Operator (+,-,$,/,(,)) \n"
szMessNoparen:      .asciz "no opening parenthesis !! \n"
szMessErrParen:     .asciz "Error parenthesis number !! \n"
szMessNoalldigits:  .asciz "One or more digits not used !!\n"
szMessNewGame:      .asciz "New game (y/n) ? \n"
szCarriageReturn:   .asciz "\n"
.align 4
iGraine:  .int 123456
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:        .skip 24
sBuffer:          .skip BUFFERSIZE
iTabDigit:        .skip 4 * NBDIGITS
iTabTopDigit:     .skip 4 * NBDIGITS
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                 @ entry of program

    ldr r0,iAdrszMessRules            @ display rules
    bl affichageMess
1:
    mov r3,#0
    ldr r12,iAdriTabDigit
    ldr r11,iAdriTabTopDigit
    ldr r5,iAdrszMessDigits
2:                                    @ loop generate random digits
    mov r0,#8
    bl genereraleas
    add r0,r0,#1
    str r0,[r12,r3,lsl #2]            @ store in table
    mov r1,#0
    str r1,[r11,r3,lsl #2]            @ raz top table
    ldr r1,iAdrsZoneConv
    bl conversion10                   @ call decimal conversion
    mov r2,#0
    strb r2,[r1,r0]                   @ reduce size display area with zéro final
    mov r0,r5
    ldr r1,iAdrsZoneConv              @ insert conversion in message
    bl strInsertAtCharInc
    mov r5,r0
    add r3,r3,#1
    cmp r3,#NBDIGITS                  @ end ?
    blt 2b                            @ no -> loop
    mov r0,r5
    bl affichageMess
3:                                    @ loop human entry
    ldr r0,iAdrszMessExpr
    bl affichageMess
    bl saisie                         @ entry
    cmp r0,#'q'
    beq 100f
    cmp r0,#'Q'
    beq 100f
    cmp r0,#'n'
    beq 1b
    cmp r0,#'N'
    beq 1b

    bl evalExpr                      @ expression evaluation
    cmp r0,#0                        @ ok ?
    bne 3b                           @ no - > loop

10:                                  @ display new game ?
    ldr r0,iAdrszCarriageReturn
    bl affichageMess
    ldr r0,iAdrszMessNewGame
    bl affichageMess
    bl saisie
    cmp r0,#'y'
    beq 1b
    cmp r0,#'Y'
    beq 1b

100:                                  @ standard end of the program
    mov r0, #0                        @ return code
    mov r7, #EXIT                     @ request to exit program
    svc #0                            @ perform the system call

iAdrszCarriageReturn:     .int szCarriageReturn
iAdrszMessRules:          .int szMessRules
iAdrszMessDigits:         .int szMessDigits
iAdrszMessExpr:           .int szMessExpr
iAdrszMessNewGame:        .int szMessNewGame
iAdrsZoneConv:            .int sZoneConv
iAdriTabDigit:            .int iTabDigit
iAdriTabTopDigit:         .int iTabTopDigit
/******************************************************************/
/*            evaluation expression                                       */
/******************************************************************/
/* r0 return 0 if ok -1 else */
evalExpr:
    push {r1-r11,lr}           @ save registers

    mov r0,#0
    ldr r1,iAdriTabTopDigit
    mov r2,#0
1:                             @ loop init table top digits
    str r0,[r1,r2,lsl #2]
    add r2,r2,#1
    cmp r2,#NBDIGITS
    blt 1b

    sub sp,sp,#STACKSIZE * 4   @ stack operator
    mov fp,sp
    sub sp,sp,#STACKSIZE * 4   @ stack digit
    mov r1,sp
    ldr r10,iAdrsBuffer
    mov r8,#0                  @ indice character in buffer
    mov r7,#0                  @ indice digits stack
    mov r2,#0                  @ indice operator stack
1:                             @ begin loop
    ldrb r9,[r10,r8]
    cmp r9,#0xA               @ end expression ?
    beq 90f
    cmp r9,#' '               @ space  ?
    addeq r8,r8,#1             @ loop
    beq 1b
    cmp r9,#'('               @ left parenthesis -> store in operator stack
    streq r9,[fp,r2,lsl #2]
    addeq r2,r2,#1
    addeq r8,r8,#1             @ and loop
    beq 1b
    cmp r9,#')'               @ right parenthesis ?
    bne 3f
    mov r0,fp                  @ compute operator stack until left parenthesis
    sub r2,r2,#1
2:
    ldr r6,[fp,r2,lsl #2]
    cmp r6,#'('                @ left parenthesis
    addeq r8,r8,#1             @ end ?
    beq 1b                     @ and loop
    sub r7,r7,#1               @ last digit
    mov r3,r7
    bl compute
    sub r2,r2,#1
    cmp r2,#0
    bge 2b
    ldr r0,iAdrszMessNoparen   @ no left parenthesis in stack
    bl affichageMess
    mov r0,#-1
    b 100f
3:
    cmp r9,#'+'               @ addition
    beq 4f
    cmp r9,#'-'               @ soustraction
    beq 4f
    cmp r9,#'*'               @ multiplication
    beq 4f
    cmp r9,#'/'               @ division
    beq 4f

    b 5f                       @ not operator

4:                             @ control priority and depile stacks
    mov r0,fp
    mov r3,r7
    mov r4,r9
    bl depileOper
    mov r7,r3
    add r8,r8,#1
    b 1b                       @ and loop

5:                             @  digit
    sub r9,r9,#0x30
    mov r0,r9
    bl digitControl
    cmp r0,#0                  @ error ?
    bne 100f
    str r9,[r1,r7,lsl #2]     @ store digit in digits stack
    add r7,r7,#1

    add r8,r8,#1
    beq 1b

    b 100f
90:                            @ compute all stack operators
    mov r0,fp
    sub r7,r7,#1
91:
    subs r2,r2,#1
    blt 92f
    mov r3,r7
    bl compute
    sub r7,r7,#1
    b 91b
92:
    ldr r0,[r1]                 @ total = first value on digits stack
    cmp r0,#TOTAL               @ control total
    beq 93f                     @ ok
    ldr r1,iAdrsZoneConv
    bl conversion10             @ call decimal conversion
    mov r2,#0
    strb r2,[r1,r0]
    ldr r0,iAdrszMessNotOK
    ldr r1,iAdrsZoneConv        @ insert conversion in message
    bl strInsertAtCharInc
    bl affichageMess
    mov r0,#-1
    b 100f
93:                             @ control use all digits
    ldr r1,iAdriTabTopDigit
    mov r2,#0
94:                             @ begin loop
    ldr r0,[r1,r2,lsl #2]       @ load top
    cmp r0,#0
    bne 95f
    ldr r0,iAdrszMessNoalldigits
    bl affichageMess
    mov r0,#-1
    b 100f
95:
    add r2,r2,#1
    cmp r2,#NBDIGITS
    blt 94b
96:                             @ display message OK
    ldr r0,iAdrszMessOK
    bl affichageMess
    mov r0,#0
    b 100f

100:
    add sp,sp,#80               @ stack algnement
    pop {r1-r11,lr}
    bx lr                       @ return
iAdrszMessNoparen:        .int szMessNoparen
iAdrszMessNotOK:          .int szMessNotOK
iAdrszMessOK:             .int szMessOK
iAdrszMessNoalldigits:    .int szMessNoalldigits
/******************************************************************/
/*            depile operator                                     */
/******************************************************************/
/* r0 operator stack address  */
/* r1 digits stack address */
/* r2 operator indice */
/* r3 digits indice */
/* r4 operator */
/* r2 return a new operator indice */
/* r3 return a new digits indice */
depileOper:
    push {r4-r8,lr}        @ save registers
    cmp r2,#0              @ first operator ?
    beq 60f
    sub r5,r2,#1
1:
    ldr r6,[r0,r5,lsl #2]  @ load stack operator
    cmp r6,r4              @ same operators
    beq 50f
    cmp r6,#'*'            @ multiplication
    beq 50f
    cmp r6,#'/'            @ division
    beq 50f
    cmp r6,#'-'            @ soustraction
    beq 50f

    b 60f
50:                        @ depile operators stack and compute
    sub r2,r2,#1
    sub r3,r3,#1
    bl compute
    sub r5,r5,#1
    cmp r5,#0
    bge 1b
60:
    str r4,[r0,r2,lsl #2]  @ add operator in stack
    add r2,r2,#1

100:
    pop {r4-r8,lr}
    bx lr                  @ return
/******************************************************************/
/*            compute                                             */
/******************************************************************/
/* r0 operator stack address  */
/* r1 digits stack address */
/* r2 operator indice */
/* r3 digits indice */
compute:
    push {r1-r8,lr}        @ save registers
    ldr r6,[r1,r3,lsl #2]  @ load second digit
    sub r5,r3,#1
    ldr r7,[r1,r5,lsl #2]  @ load first digit

    ldr r8,[r0,r2,lsl #2]  @ load operator
    cmp r8,#'+'
    bne 1f
    add r7,r7,r6           @ addition
    str r7,[r1,r5,lsl #2]
    b 100f
1:
    cmp r8,#'-'
    bne 2f
    sub r7,r7,r6           @ soustaction
    str r7,[r1,r5,lsl #2]
    b 100f
2:
    cmp r8,#'*'
    bne 3f                 @ multiplication
    mul r7,r6,r7
    str r7,[r1,r5,lsl #2]
    b 100f
3:
    cmp r8,#'/'
    bne 4f
    udiv r7,r7,r6          @ division
    str r7,[r1,r5,lsl #2]
    b 100f
4:
    cmp r8,#'('            @ left parenthesis ?
    bne 5f
    ldr r0,iAdrszMessErrParen @  error
    bl affichageMess
    mov r0,#-1
    b 100f
5:
    ldr r0,iAdrszMessErrOper
    bl affichageMess
    mov r0,#-1
100:
    pop {r1-r8,lr}
    bx lr                   @ return
iAdrszMessErrOper:   .int szMessErrOper
iAdrszMessErrParen:  .int szMessErrParen
/******************************************************************/
/*            control digits                                       */
/******************************************************************/
/* r0 return 0 if OK 1 if  not digit   */
digitControl:
    push {r1-r4,lr}        @ save registers
    ldr r1,iAdriTabTopDigit
    ldr r2,iAdriTabDigit
    mov r3,#0
1:
    ldr r4,[r2,r3,lsl #2]  @ load digit
    cmp r0,r4              @ equal ?
    beq 2f                 @ yes
    add r3,r3,#1           @ no -> loop
    cmp r3,#NBDIGITS       @ end ?
    blt 1b
    ldr r0,iAdrszMessNoDigit @ error
    bl affichageMess
    mov r0,#1
    b 100f
2:                         @ control prev use
    ldr r4,[r1,r3,lsl #2]
    cmp r4,#0
    beq 3f
    add r3,r3,#1
    cmp r3,#NBDIGITS
    blt 1b
    ldr r0,iAdrszMessSameDigit
    bl affichageMess
    mov r0,#1
    b 100f
3:
    mov r4,#1
    str r4,[r1,r3,lsl #2]
    mov r0,#0
100:
    pop {r1-r4,lr}
    bx lr                   @ return
iAdrszMessNoDigit:     .int szMessNoDigit
iAdrszMessSameDigit:   .int szMessSameDigit
/******************************************************************/
/*            string entry                                       */
/******************************************************************/
/* r0 return the first character of human entry */
saisie:
    push {r1-r7,lr}        @ save registers
    mov r0,#STDIN          @ Linux input console
    ldr r1,iAdrsBuffer     @ buffer address
    mov r2,#BUFFERSIZE     @ buffer size
    mov r7,#READ           @ request to read datas
    svc 0                  @ call system
    ldr r1,iAdrsBuffer     @ buffer address
    ldrb r0,[r1]           @ load first character
100:
    pop {r1-r7,lr}
    bx lr                   @ return
iAdrsBuffer:         .int sBuffer
/***************************************************/
/*   Generation random number                  */
/***************************************************/
/* r0 contains limit  */
genereraleas:
    push {r1-r4,lr}         @ save registers
    ldr r4,iAdriGraine
    ldr r2,[r4]
    ldr r3,iNbDep1
    mul r2,r3,r2
    ldr r3,iNbDep2
    add r2,r2,r3
    str r2,[r4]             @ maj de la graine pour l appel suivant
    cmp r0,#0
    beq 100f
    add r1,r0,#1            @ divisor
    mov r0,r2               @ dividende
    bl division
    mov r0,r3               @ résult = remainder

100:                        @ end function
    pop {r1-r4,lr}          @ restaur registers
    bx lr                   @ return
/*****************************************************/
iAdriGraine: .int iGraine
iNbDep1:     .int 0x343FD
iNbDep2:     .int 0x269EC3
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"


print "-----------------------------"
print " Welcome to 24 Game"
print "-----------------------------"

digs: map 1..4 'x -> random 1 9

print ["The numbers you can use are:" join.with:" " digs]

print ""

validExpression?: function [expr][
    loop expr 'item [
        if or? inline? item block? item [
            if not? validExpression? item -> return false
        ]
        if symbol? item [
            if not? contains? [+ / - *] item -> return false
        ]
        if integer? item [
            if not? contains? digs item -> return false
        ]
    ]
    return true
]

result: 0

while [result<>24][
    got: input "Enter an expression to form 24: "
    blo: to :block got
    if? validExpression? blo [
        result: do blo
        print ["The result is:" result]
    ]
    else [
        print "Invalid expression. Please try again!"
    ]
    print ""
]

print "Well done!"


AutoExecute:
    Title := "24 Game"
    Gui, -MinimizeBox
    Gui, Add, Text, w230 vPuzzle
    Gui, Add, Edit, wp vAnswer
    Gui, Add, Button, w70, &Generate
    Gui, Add, Button, x+10 wp Default, &Submit
    Gui, Add, Button, x+10 wp, E&xit

ButtonGenerate: ; new set of numbers
    Loop, 4
        Random, r%A_Index%, 1, 9
    Puzzle = %r1%, %r2%, %r3%, and %r4%
    GuiControl,, Puzzle, The numbers are:  %Puzzle%  - Good luck!
    GuiControl,, Answer ; empty the edit box
    ControlFocus, Edit1
    Gui, -Disabled
    Gui, Show,, %Title%
Return ; end of auto execute section

ButtonSubmit: ; check solution
    Gui, Submit, NoHide
    Gui, +Disabled

    ; check numbers used
    RegExMatch(Answer, "(\d)\D+(\d)\D+(\d)\D+(\d)", $)
    ListPuzzle := r1 "," r2 "," r3 "," r4
    ListAnswer := $1 "," $2 "," $3 "," $4
    Sort, ListPuzzle, D,
    Sort, ListAnswer, D,
    If Not ListPuzzle = ListAnswer {
        MsgBox, 48, Error - %Title%, Numbers used!`n%Answer%
        Goto, TryAgain
    }

    ; check operators used
    StringReplace, $, $, +,, All
    StringReplace, $, $, -,, All
    StringReplace, $, $, *,, All
    StringReplace, $, $, /,, All
    StringReplace, $, $, (,, All
    StringReplace, $, $, ),, All
    Loop, 9
        StringReplace, $, $, %A_Index%,, All
    If StrLen($) > 0
    Or InStr(Answer, "**")
    Or InStr(Answer, "//")
    Or InStr(Answer, "++")
    Or InStr(Answer, "--") {
        MsgBox, 48, Error - %Title%, Operators used!`n%Answer%
        Goto, TryAgain
    }

    ; check result
    Result := Eval(Answer)
    If Not Result = 24 {
        MsgBox, 48, Error - %Title%, Result incorrect!`n%Result%
        Goto, TryAgain
    }

    ; if we are sill here
    MsgBox, 4, %Title%, Correct solution! Play again?
    IfMsgBox, Yes
        Gosub, ButtonGenerate
    Else
        ExitApp
Return

TryAgain: ; alternative ending of routine ButtonSubmit
    ControlFocus, Edit1
    Gui, -Disabled
    Gui, Show
Return

GuiClose:
GuiEscape:
ButtonExit:
    ExitApp
Return

;---------------------------------------------------------------------------
Eval(Expr) { ; evaluate expression using separate AHK process
;---------------------------------------------------------------------------
    ; credit for this function goes to AutoHotkey forum member Laszlo
    ; http://www.autohotkey.com/forum/topic9578.html
    ;-----------------------------------------------------------------------
    static File := "24$Temp.ahk"

    ; delete old temporary file, and write new
    FileDelete, %File%
    FileContent := "#NoTrayIcon`r`n"
                .  "FileDelete, " File "`r`n"
                .  "FileAppend, `% " Expr ", " File "`r`n"
    FileAppend, %FileContent%, %File%

    ; run AHK to execute temp script, evaluate expression
    RunWait, %A_AhkPath% %File%

    ; get result
    FileRead, Result, %File%
    FileDelete, %File%
    Return, Result
}


;AutoIt Script Example
;by Daniel Barnes
;spam me at djbarnes at orcon dot net dot en zed
;13/08/2012

;Choose four random digits (1-9) with repetitions allowed:
global $digits
FOR $i = 1 TO 4
	$digits &= Random(1,9,1)
NEXT

While 1
	main()
WEnd

Func main()
	$text  = "Enter an equation (using all of, and only, the single digits "&$digits &")"&@CRLF
	$text &= "which evaluates to exactly 24. Only multiplication (*) division (/)"&@CRLF
	$text &= "addition (+) and subtraction (-) operations and parentheses are allowed:"
	$input = InputBox ("24 Game",$text,"","",400,150)
	If @error Then exit

	;remove any spaces in input
	$input = StringReplace($input," ","")

	;check correct characters were used
	For $i = 1 To StringLen($input)
		$chr = StringMid($input,$i,1)
		If Not StringInStr("123456789*/+-()",$chr) Then
			MsgBox (0, "ERROR","Invalid character used: '"&$chr&"'")
			return
		endif
	Next

	;validate the equation uses all of the 4 characters, and nothing else
	$test = $input
	$test = StringReplace($test,"(","")
	$test = StringReplace($test,")","")

	;validate the length of the input - if its not 7 characters long then the user has done something wrong
	If StringLen ($test) <> 7 Then
		MsgBox (0,"ERROR","The equation "&$test&" is invalid")
		return
	endif

	$test = StringReplace($test,"/","")
	$test = StringReplace($test,"*","")
	$test = StringReplace($test,"-","")
	$test = StringReplace($test,"+","")

	For $i = 1 To StringLen($digits)
		$digit = StringMid($digits,$i,1)
		For $ii = 1 To StringLen($test)
			If  StringMid($test,$ii,1) = $digit Then
				$test = StringLeft($test,$ii-1) & StringRight($test,StringLen($test)-$ii)
				ExitLoop
			endif
		Next
	Next
	If $test <> "" Then
		MsgBox (0, "ERROR", "The equation didn't use all 4 characters, and nothing else!")
		return
	endif

	$try = Execute($input)

	If $try = 24 Then
		MsgBox (0, "24 Game","Well done. Your equation ("&$input&") = 24!")
		Exit
	Else
		MsgBox (0, "24 Game","Fail. Your equation ("&$input&") = "&$try&"!")
		return
	endif
EndFunc


      REM Choose four random digits (1-9) with repetitions allowed:
      DIM digits%(4), check%(4)
      FOR choice% = 1 TO 4
        digits%(choice%) = RND(9)
      NEXT choice%

      REM Prompt the player:
      PRINT "Enter an equation (using all of, and only, the single digits ";
      FOR index% = 1 TO 4
        PRINT ; digits%(index%) ;
        IF index%<>4 PRINT " " ;
      NEXT
      PRINT ")"
      PRINT "which evaluates to exactly 24.  Only multiplication (*), division (/),"
      PRINT "addition (+) & subtraction (-) operations and parentheses are allowed:"
      INPUT "24 = " equation$

      REPEAT

        REM Check that the correct digits are used:
        check%() = 0
        FOR char% = 1 TO LEN(equation$)
          digit% = INSTR("0123456789", MID$(equation$, char%, 1)) - 1
          IF digit% >= 0 THEN
            FOR index% = 1 TO 4
              IF digit% = digits%(index%) THEN
                IF NOT check%(index%) check%(index%) = TRUE : EXIT FOR
              ENDIF
            NEXT index%
            IF index% > 4 THEN
              PRINT "Sorry, you used the illegal digit "; digit%
              EXIT REPEAT
            ENDIF
          ENDIF
        NEXT char%

        FOR index% = 1 TO 4
          IF NOT check%(index%) THEN
            PRINT "Sorry, you failed to use the digit " ; digits%(index%)
            EXIT REPEAT
          ENDIF
        NEXT index%

        REM Check that no pairs of digits are used:
        FOR pair% = 11 TO 99
          IF INSTR(equation$, STR$(pair%)) THEN
            PRINT "Sorry, you may not use a pair of digits "; pair%
            EXIT REPEAT
          ENDIF
        NEXT pair%

        REM Check whether the equation evaluates to 24:
        ON ERROR LOCAL PRINT "Sorry, there was an error in the equation" : EXIT REPEAT
        result = EVAL(equation$)
        RESTORE ERROR
        IF result = 24 THEN
          PRINT "Congratulations, you succeeded in the task!"
        ELSE
          PRINT "Sorry, your equation evaluated to " ; result " rather than 24!"
        ENDIF

      UNTIL TRUE

      INPUT '"Play again", answer$
      IF LEFT$(answer$,1) = "y" OR LEFT$(answer$,1) = "Y" THEN CLS : RUN
      QUIT


  ( 24-game
  =     m-w m-z 4numbers answer expr numbers
      , seed get-random convertBinaryMinusToUnary
      , convertDivisionToMultiplication isExpresssion reciprocal
    .   (seed=.!arg:(~0:~/#?m-w.~0:~/#?m-z))
      & seed$!arg
      & ( get-random
        =
          .   36969*mod$(!m-z.65536)+div$(!m-z.65536):?m-z
            & 18000*mod$(!m-w.65536)+div$(!m-w.65536):?m-w
            & mod$(!m-z*65536+!m-w.9)+1
        )
      & ( convertBinaryMinusToUnary
        =   a z
          .     @(!arg:%?a "-" ?z)
              & str$(!a "+-1*" convertBinaryMinusToUnary$!z)
            | !arg
        )
      & (reciprocal=.!arg^-1)
      & ( convertDivisionToMultiplication
        =   a z
          .     @(!arg:?a "/" ?z)
              & str$(!a "*reciprocal$" convertDivisionToMultiplication$!z)
            | !arg
        )
      & ( isExpresssion
        =   A Z expr
          .   @( !arg
               :   ?A
                   ("+"|"-"|"*"|"/")
                   ( ?Z
                   & isExpresssion$!A
                   & isExpresssion$!Z
                   )
               )
            |   !numbers:?A !arg ?Z
              & !A !Z:?numbers
            |   ( @(!arg:"(" ?expr ")")
                | @(!arg:(" "|\t) ?expr)
                | @(!arg:?expr (" "|\t))
                )
              & isExpresssion$!expr
        )
      &   out
        $ "Enter an expression that evaluates to 24 by combining the following numbers."
      & out$"You may only use the operators + - * /"
      & out$"Parentheses and spaces are allowed."
      &   whl
        ' (   get-random$() get-random$() get-random$() get-random$
            : ?4numbers
          & out$!4numbers
          &   whl
            ' ( get'(,STR):?expr:~
              & !4numbers:?numbers
              & ~(isExpresssion$!expr&!numbers:)
              &   out
                $ ( str
                  $ ( "["
                      !expr
                      "] is not a valid expression. Try another expression."
                    )
                  )
              )
          & !expr:~
          & convertBinaryMinusToUnary$!expr:?expr
          & convertDivisionToMultiplication$!expr:?expr
          & get$(!expr,MEM):?answer
          & out$(str$(!expr " = " !answer))
          &   !answer
            : ( 24&out$Right!
              | #&out$Wrong!
              )
          & out$"Try another one:"
          )
      & out$bye
  )
& 24-game$(13.14)
& ;


#include <stdio.h>
#include <ctype.h>
#include <stdlib.h>
#include <setjmp.h>
#include <time.h>

jmp_buf ctx;
const char *msg;

enum { OP_NONE = 0, OP_NUM, OP_ADD, OP_SUB, OP_MUL, OP_DIV };

typedef struct expr_t *expr, expr_t;
struct expr_t {
	int op, val, used;
	expr left, right;
};

#define N_DIGITS 4
expr_t digits[N_DIGITS];

void gen_digits()
{
	int i;
	for (i = 0; i < N_DIGITS; i++)
		digits[i].val = 1 + rand() % 9;
}

#define MAX_INPUT 64
char str[MAX_INPUT];
int pos;

#define POOL_SIZE 8
expr_t pool[POOL_SIZE];
int pool_ptr;

void reset()
{
	int i;
	msg = 0;
	pool_ptr = pos = 0;
	for (i = 0; i < POOL_SIZE; i++) {
		pool[i].op = OP_NONE;
		pool[i].left = pool[i].right = 0;
	}
	for (i = 0; i < N_DIGITS; i++)
		digits[i].used = 0;
}

/* longish jumpish back to input cycle */
void bail(const char *s)
{
	msg = s;
	longjmp(ctx, 1);
}

expr new_expr()
{
	if (pool_ptr < POOL_SIZE)
		return pool + pool_ptr++;
	return 0;
}

/* check next input char */
int next_tok()
{
	while (isspace(str[pos])) pos++;
	return str[pos];
}

/* move input pointer forward */
int take()
{
	if (str[pos] != '\0') return ++pos;
	return 0;
}

/* BNF(ish)
expr = term { ("+")|("-") term }
term = fact { ("*")|("/") expr }
fact =	number
	| '(' expr ')'
*/

expr get_fact();
expr get_term();
expr get_expr();

expr get_expr()
{
	int c;
	expr l, r, ret;
	if (!(ret = get_term())) bail("Expected term");
	while ((c = next_tok()) == '+' || c == '-') {
		if (!take()) bail("Unexpected end of input");
		if (!(r = get_term())) bail("Expected term");

		l = ret;
		ret = new_expr();
		ret->op = (c == '+') ? OP_ADD : OP_SUB;
		ret->left = l;
		ret->right = r;
	}
	return ret;
}

expr get_term()
{
	int c;
	expr l, r, ret;
	ret = get_fact();
	while((c = next_tok()) == '*' || c == '/') {
		if (!take()) bail("Unexpected end of input");

		r = get_fact();
		l = ret;
		ret = new_expr();
		ret->op = (c == '*') ? OP_MUL : OP_DIV;
		ret->left = l;
		ret->right = r;
	}
	return ret;
}

expr get_digit()
{
	int i, c = next_tok();
	expr ret;
	if (c >= '0' && c <= '9') {
		take();
		ret = new_expr();
		ret->op = OP_NUM;
		ret->val = c - '0';
		for (i = 0; i < N_DIGITS; i++)
			if (digits[i].val == ret->val && !digits[i].used) {
				digits[i].used = 1;
				return ret;
			}
		bail("Invalid digit");
	}
	return 0;
}

expr get_fact()
{
	int c;
	expr l = get_digit();
	if (l) return l;
	if ((c = next_tok()) == '(') {
		take();
		l = get_expr();
		if (next_tok() != ')') bail("Unbalanced parens");
		take();
		return l;
	}
	return 0;
}

expr parse()
{
	int i;
	expr ret = get_expr();
	if (next_tok() != '\0')
		bail("Trailing garbage");
	for (i = 0; i < N_DIGITS; i++)
		if (!digits[i].used)
			bail("Not all digits are used");
	return ret;
}

typedef struct frac_t frac_t, *frac;
struct frac_t { int denom, num; };

int gcd(int m, int n)
{
	int t;
	while (m) {
		t = m; m = n % m; n = t;
	}
	return n;
}

/* evaluate expression tree.  result in fraction form */
void eval_tree(expr e, frac res)
{
	frac_t l, r;
	int t;
	if (e->op == OP_NUM) {
		res->num = e->val;
		res->denom = 1;
		return;
	}

	eval_tree(e->left, &l);
	eval_tree(e->right, &r);

	switch(e->op) {
	case OP_ADD:
		res->num = l.num * r.denom + l.denom * r.num;
		res->denom = l.denom * r.denom;
		break;
	case OP_SUB:
		res->num = l.num * r.denom - l.denom * r.num;
		res->denom = l.denom * r.denom;
		break;
	case OP_MUL:
		res->num = l.num * r.num;
		res->denom = l.denom * r.denom;
		break;
	case OP_DIV:
		res->num = l.num * r.denom;
		res->denom = l.denom * r.num;
		break;
	}
	if ((t = gcd(res->denom, res->num))) {
		res->denom /= t;
		res->num /= t;
	}
}

void get_input()
{
	int i;
reinput:
	reset();
	printf("\nAvailable digits are:");
	for (i = 0; i < N_DIGITS; i++)
		printf(" %d", digits[i].val);
	printf(". Type an expression and I'll check it for you, or make new numbers.\n"
		"Your choice? [Expr/n/q] ");

	while (1) {
		for (i = 0; i < MAX_INPUT; i++) str[i] = '\n';
		fgets(str, MAX_INPUT, stdin);
		if (*str == '\0') goto reinput;
		if (str[MAX_INPUT - 1] != '\n')
			bail("string too long");

		for (i = 0; i < MAX_INPUT; i++)
			if (str[i] == '\n') str[i] = '\0';
		if (str[0] == 'q') {
			printf("Bye\n");
			exit(0);
		}
		if (str[0] == 'n') {
			gen_digits();
			goto reinput;
		}
		return;
	}
}

int main()
{
	frac_t f;
	srand(time(0));

	gen_digits();
	while(1) {
		get_input();
		setjmp(ctx); /* if parse error, jump back here with err msg set */
		if (msg) {
			/* after error jump; announce, reset, redo */
			printf("%s at '%.*s'\n", msg, pos, str);
			continue;
		}

		eval_tree(parse(), &f);

		if (f.denom == 0) bail("Divide by zero");
		if (f.denom == 1 && f.num == 24)
			printf("You got 24.  Very good.\n");
		else {
			if (f.denom == 1)
				printf("Eval to: %d, ", f.num);
			else
				printf("Eval to: %d/%d, ", f.num, f.denom);
			printf("no good.  Try again.\n");
		}
	}
	return 0;
}


#include <random>
#include <iostream>
#include <stack>
#include <set>
#include <string>
#include <functional>
using namespace std;

class RPNParse
{
public:
  stack<double> stk;
  multiset<int> digits;

  void op(function<double(double,double)> f)
  {
    if(stk.size() < 2)
      throw "Improperly written expression";
    int b = stk.top(); stk.pop();
    int a = stk.top(); stk.pop();
    stk.push(f(a, b));
  }

  void parse(char c)
  {
    if(c >= '0' && c <= '9')
    {
      stk.push(c - '0');
      digits.insert(c - '0');
    }
    else if(c == '+')
      op([](double a, double b) {return a+b;});
    else if(c == '-')
      op([](double a, double b) {return a-b;});
    else if(c == '*')
      op([](double a, double b) {return a*b;});
    else if(c == '/')
      op([](double a, double b) {return a/b;});
  }

  void parse(string s)
  {
    for(int i = 0; i < s.size(); ++i)
      parse(s[i]);
  }

  double getResult()
  {
    if(stk.size() != 1)
      throw "Improperly written expression";
    return stk.top();
  }
};

int main()
{
  random_device seed;
  mt19937 engine(seed());
  uniform_int_distribution<> distribution(1, 9);
  auto rnd = bind(distribution, engine);

  multiset<int> digits;
  cout << "Make 24 with the digits: ";
  for(int i = 0; i < 4; ++i)
  {
    int n = rnd();
    cout << " " << n;
    digits.insert(n);
  }
  cout << endl;

  RPNParse parser;

  try
  {
    string input;
    getline(cin, input);
    parser.parse(input);

    if(digits != parser.digits)
      cout << "Error: Not using the given digits" << endl;
    else
    {
      double r = parser.getResult();
      cout << "Result: " << r << endl;

      if(r > 23.999 && r < 24.001)
        cout << "Good job!" << endl;
      else
        cout << "Try again." << endl;
    }
  }
  catch(char* e)
  {
    cout << "Error: " << e << endl;
  }
  return 0;
}


import ceylon.random {
	DefaultRandom
}

class Rational(shared Integer numerator, shared Integer denominator = 1) satisfies Numeric<Rational> {

	assert (denominator != 0);

	Integer gcd(Integer a, Integer b) => if (b == 0) then a else gcd(b, a % b);

	shared Rational inverted => Rational(denominator, numerator);

	shared Rational simplified =>
		let (largestFactor = gcd(numerator, denominator))
			Rational(numerator / largestFactor, denominator / largestFactor);

	divided(Rational other) => (this * other.inverted).simplified;

	negated => Rational(-numerator, denominator).simplified;

	plus(Rational other) =>
			let (top = numerator*other.denominator + other.numerator*denominator,
				bottom = denominator * other.denominator)
			Rational(top, bottom).simplified;

	times(Rational other) =>
		Rational(numerator * other.numerator, denominator * other.denominator).simplified;

	shared Integer integer => numerator / denominator;
	shared Float float => numerator.float / denominator.float;

	string => denominator == 1 then numerator.string else "``numerator``/``denominator``";

	shared actual Boolean equals(Object that) {
		if (is Rational that) {
			value simplifiedThis = this.simplified;
			value simplifiedThat = that.simplified;
			return simplifiedThis.numerator==simplifiedThat.numerator &&
					simplifiedThis.denominator==simplifiedThat.denominator;
		}
		else {
			return false;
		}
	}
}

interface Expression {
	shared formal Rational evaluate();
}

class NumberExpression(Rational number) satisfies Expression {
	evaluate() => number;
	string => number.string;
}

class OperatorExpression(Expression left, Character operator, Expression right) satisfies Expression {
	shared actual Rational evaluate() {
		switch (operator)
		case ('*') {
			return left.evaluate() * right.evaluate();
		}
		case ('/') {
			return left.evaluate() / right.evaluate();
		}
		case ('-') {
			return left.evaluate() - right.evaluate();
		}
		case ('+') {
			return left.evaluate() + right.evaluate();
		}
		else {
			throw Exception("unknown operator ``operator``");
		}
	}

	string => "(``left.string`` ``operator.string`` ``right.string``)";
}

"A simplified top down operator precedence parser. There aren't any right
 binding operators so we don't have to worry about that."
class PrattParser(String input) {

	value tokens = input.replace(" ", "");
	variable value index = -1;

	shared Expression expression(Integer precedence = 0) {
		value token = advance();
		variable value left = parseUnary(token);
		while (precedence < getPrecedence(peek())) {
			value nextToken = advance();
			left = parseBinary(left, nextToken);
		}
		return left;
	}

	Integer getPrecedence(Character op) =>
		switch (op)
			case ('*' | '/') 2
			case ('+' | '-') 1
			else 0;

	Character advance(Character? expected = null) {
		index++;
		value token = tokens[index] else ' ';
		if (exists expected, token != expected) {
			throw Exception("unknown character ``token``");
		}
		return token;
	}

	Character peek() => tokens[index + 1] else ' ';

	Expression parseBinary(Expression left, Character operator) =>
		let (right = expression(getPrecedence(operator)))
			OperatorExpression(left, operator, right);

	Expression parseUnary(Character token) {
		if (token.digit) {
			assert (is Integer int = Integer.parse(token.string));
			return NumberExpression(Rational(int));
		}
		else if (token == '(') {
			value exp = expression();
			advance(')');
			return exp;
		}
		else {
			throw Exception("unknown character ``token``");
		}
	}
}

shared void run() {

	value random = DefaultRandom();

	function random4Numbers() =>
		random.elements(1..9).take(4).sequence();

	function isValidGuess(String input, {Integer*} allowedNumbers) {
		value allowedOperators = set { *"()+-/*" };
		value extractedNumbers = input
			.split((Character ch) => ch in allowedOperators || ch.whitespace)
			.map((String element) => Integer.parse(element))
			.narrow<Integer>();
		if (extractedNumbers.any((Integer element) => element > 9)) {
			print("number too big!");
			return false;
		}
		if (extractedNumbers.any((Integer element) => element < 1)) {
			print("number too small!");
			return false;
		}
		if (extractedNumbers.sort(increasing) != allowedNumbers.sort(increasing)) {
			print("use all the numbers, please!");
			return false;
		}
		if (!input.every((Character element) => element in allowedOperators || element.digit || element.whitespace)) {
			print("only digits and mathematical operators, please");
			return false;
		}
		variable value leftParens = 0;
		for (c in input) {
			if (c == '(') {
				leftParens++;
			} else if (c == ')') {
				leftParens--;
				if (leftParens < 0) {
					break;
				}
			}
		}
		if (leftParens != 0) {
			print("unbalanced brackets!");
			return false;
		}
		return true;
	}

	function evaluate(String input) =>
		let (parser = PrattParser(input),
			exp = parser.expression())
			exp.evaluate();

	print("Welcome to The 24 Game.
	          Create a mathematical equation with four random
	          numbers that evaluates to 24.
	          You must use all the numbers once and only once,
	          but in any order.
	          Also, only + - / * and parentheses are allowed.
	          For example: (1 + 2 + 3) * 4
	          Also: enter n for new numbers and q to quit.
	          -----------------------------------------------");

	value twentyfour = Rational(24);

	while (true) {

		value chosenNumbers = random4Numbers();
		void pleaseTryAgain() => print("Sorry, please try again. (Your numbers are ``chosenNumbers``)");

		print("Your numbers are ``chosenNumbers``. Please turn them into 24.");

		while (true) {
			value line = process.readLine()?.trimmed;
			if (exists line) {
				if (line.uppercased == "Q") { // quit
					print("bye!");
					return;
				}
				if (line.uppercased == "N") { // new game
					break;
				}
				if (isValidGuess(line, chosenNumbers)) {
					try {
						value result = evaluate(line);
						print("= ``result``");
						if (result == twentyfour) {
							print("You did it!");
							break;
						}
						else {
							pleaseTryAgain();
						}
					}
					catch (Exception e) {
						print(e.message);
						pleaseTryAgain();
					}
				}
				else {
					pleaseTryAgain();
				}
			}
		}
	}
}


(ns rosettacode.24game)

(def ^:dynamic *luser*
"You guessed wrong, or your input was not in prefix notation.")

(def ^:private start #(println
"Your numbers are: " %1 ". Your goal is " %2 ".\n"
"Use the ops [+ - * /] in prefix notation to reach" %2 ".\n"
"q[enter] to quit."))

(defn play
  ([] (play 24))
  ([goal] (play goal (repeatedly 4 #(inc (rand-int 9)))))
  ([goal gns]
     (start gns goal)
     (let [input (read-string (read-line))
           flat  (flatten input)]
      (println
        (if (and (re-find #"^\([\d\s+*/-]+\d?\)$" (pr-str flat))
                 (= (set gns) (set (filter integer? flat)))
                 (= goal (eval input)))
         "You won the game!"
         *luser*))
      (when (not= input 'q) (recur goal gns)))))

; * checks prefix form, then checks to see that the numbers used
; and the numbers generated by the game are the same.


tty = require 'tty'
tty.setRawMode true

buffer  = ""
numbers = []

for n in [0...4]
    numbers.push Math.max 1, Math.floor(Math.random() * 9)

console.log "You can use the numbers: #{numbers.join ' '}"

process.stdin.on 'keypress', (char, key) ->

    # accept operator
    if char and isNaN(char) and /[()*\/+-]/.test(char) and buffer.substr(-1) isnt char
        buffer += char
        process.stdout.write char
    # accept number
    else if !isNaN(+char) and (buffer == '' or isNaN(buffer.substr -1))
        buffer += char
        process.stdout.write char

    # check then evaluate expression
    if key?.name is 'enter'
        result = calculate()
        process.stdout.write '\n'
        if result and result is 24
            console.log " = 24! congratulations."
        else
            console.log "#{result}. nope."
        process.exit 0

    # quit
    if key?.name is 'escape' or (key?.name == 'c' and key.ctrl)
        process.exit 0

calculate = () ->

    if /[^\d\s()+*\/-]/.test buffer
        console.log "invalid characters"
        process.exit 1

    used = buffer.match(/\d/g)
    if used?.length != 4 or used.sort().join() != numbers.sort().join()
        console.log "you must use the 4 numbers provided"
        process.exit 1

    res = try eval buffer catch e
    return res or 'invalid expression'

# begin taking input
process.stdin.resume()