% This program needs to be merged with PCLU's "misc" library
% to use the random number generator.

experiment = cluster is run
    rep = null

    own awake: int := 0
    own awake_heads: int := 0

    % Returns true if heads, false if tails
    coin_toss = proc () returns (bool)
        return(random$next(2)=1)
    end coin_toss

    % Do the experiment once
    do_experiment = proc ()
        heads: bool := coin_toss()

        % monday - wake up
        awake := awake + 1
        if heads then
            awake_heads := awake_heads + 1
            return
        end

        % tuesday - wake up if tails
        awake := awake + 1
    end do_experiment

    % Run the experiment N times
    run = proc (n: int) returns (real)
        awake := 0
        awake_heads := 0

        for i: int in int$from_to(1,n) do
            do_experiment()
        end

        return(real$i2r(awake_heads) / real$i2r(awake))
    end run
end experiment

start_up = proc ()
    N = 1000000

    po: stream := stream$primary_output()
    stream$puts(po, "Chance of waking up with heads: ")

    chance: real := experiment$run(N)
    stream$putl(po, f_form(chance, 1, 6))
end start_up


let experiments = 10000
var heads = 0
var wakenings = 0
for _ in 1..experiments {
    wakenings += 1
    match rnd(min: 0, max: 10) {
        <5 => heads += 1,
        _ => wakenings += 1
    }
}
print("Wakenings over \(experiments) experiments: \(wakenings)")
print("Sleeping Beauty should estimate a credence of: \(Float(heads) / Float(wakenings))")


SLEEPINGB
=LAMBDA(n,
    LET(
        headsWakes, LAMBDA(x,
            IF(1 = x,
               {1,1},
               {0,2}
            )
        )(
            RANDARRAY(n, 1, 0, 1, TRUE)
        ),
        CHOOSE(
            {1,2},
            SUM(INDEX(headsWakes, 0, 1)),
            SUM(INDEX(headsWakes, 0, 2))
        )
    )
)


Imports System
Imports System.IO
Imports System.Net.Sockets

Public Class Program
    Public Shared Sub Main(ByVal args As String[])
        Dim tcp As New TcpClient("localhost", 256)
        Dim writer As New StreamWriter(tcp.GetStream())

        writer.Write("hello socket world")
        writer.Flush()

        tcp.Close()
    End Sub
End Class


/* sockets.wren */

var AF_UNSPEC = 0
var SOCK_STREAM = 1

foreign class AddrInfo {
    foreign static getAddrInfo(name, service, req, pai)

    construct new() {}

    foreign family

    foreign family=(f)

    foreign sockType

    foreign sockType=(st)

    foreign protocol

    foreign addr

    foreign addrLen
}

foreign class AddrInfoPtr {
    construct new() {}

    foreign deref

    foreign free()
}

foreign class SockAddrPtr {
    construct new() {}
}

class Socket {
    foreign static create(domain, type, protocol)

    foreign static connect(fd, addr, len)

    foreign static send(fd, buf, n, flags)

    foreign static close(fd)
}

var msg = "hello socket world\n"
var hints = AddrInfo.new()
hints.family = AF_UNSPEC
hints.sockType = SOCK_STREAM
var addrInfoPtr = AddrInfoPtr.new()
if (AddrInfo.getAddrInfo("localhost", "256", hints, addrInfoPtr) == 0){
    var addrs = addrInfoPtr.deref
    var sock = Socket.create(addrs.family, addrs.sockType, addrs.protocol)
    if (sock >= 0) {
        var stat = Socket.connect(sock, addrs.addr, addrs.addrLen)
        if (stat >= 0) {
            var pm = msg
            while (true) {
                var len = pm.count
                var slen = Socket.send(sock, pm, len, 0)
                if (slen < 0 || slen >= len) break
                pm = pm[slen..-1]
            }
        }
        var status = Socket.close(sock)
        if (status != 0) System.print("Failed to close socket.")
    }
    addrInfoPtr.free()
}


require "prime"

smarandache = Enumerator.new do|y|
  prime_digits = [2,3,5,7]
  prime_digits.each{|pr| y << pr} # yield the below-tens
  (1..).each do |n|
    prime_digits.repeated_permutation(n).each do |perm|
      c = perm.join.to_i * 10
      y << c + 3 if (c+3).prime?
      y << c + 7 if (c+7).prime?
    end
  end
end

seq = smarandache.take(100)
p seq.first(25)
p seq.last


func is_prime_digital(n) {
    n.is_prime && n.digits.all { .is_prime }
}

say is_prime_digital.first(25).join(',')
say is_prime_digital.nth(100)


func isPrime(number: Int) -> Bool {
    if number < 2 {
        return false
    }
    if number % 2 == 0 {
        return number == 2
    }
    if number % 3 == 0 {
        return number == 3
    }
    if number % 5 == 0 {
        return number == 5
    }
    var p = 7
    let wheel = [4,2,4,2,4,6,2,6]
    while true {
        for w in wheel {
            if p * p > number {
                return true
            }
            if number % p == 0 {
                return false
            }
            p += w
        }
    }
}

func nextPrimeDigitNumber(number: Int) -> Int {
    if number == 0 {
        return 2
    }
    switch number % 10 {
    case 2:
        return number + 1
    case 3, 5:
        return number + 2
    default:
        return 2 + nextPrimeDigitNumber(number: number/10) * 10
    }
}

let limit = 1000000000
var n = 0
var max = 0
var count = 0
print("First 25 SPDS primes:")
while n < limit {
    n = nextPrimeDigitNumber(number: n)
    if !isPrime(number: n) {
        continue
    }
    if count < 25 {
        print(n, terminator: " ")
    } else if count == 25 {
        print()
    }
    count += 1
    if (count == 100) {
        print("Hundredth SPDS prime: \(n)")
    } else if (count == 1000) {
        print("Thousandth SPDS prime: \(n)")
    } else if (count == 10000) {
        print("Ten thousandth SPDS prime: \(n)")
    }
    max = n
}
print("Largest SPDS prime less than \(limit): \(max)")


import "/math" for Int

var limit = 1000
var spds = List.filled(limit, 0)
spds[0] = 2
var i = 3
var count = 1
while (count < limit) {
    if (Int.isPrime(i)) {
        var digits = i.toString
        if (digits.all { |d| "2357".contains(d) }) {
            spds[count] = i
            count = count + 1
        }
    }
    i = i + 2
    if (i > 10) {
        var j = i % 10
        if (j == 1 || j == 5) {
            i = i + 2
        } else if (j == 9) {
            i = i + 4
        }
    }
}
System.print("The first 25 SPDS primes are:")
System.print(spds.take(25).toList)
System.print("\nThe 100th SPDS prime is %(spds[99])")
System.print("\nThe 1,000th SPDS prime is %(spds[999])")


// Sleeping Beauty: Nigel Galloway. May 16th., 2021
let heads,woken=let n=System.Random() in {1..1000}|>Seq.fold(fun(h,w) g->match n.Next(2) with 0->(h+1,w+1) |_->(h,w+2))(0,0)
printfn "During 1000 tosses Sleeping Beauty woke %d times, %d times the toss was heads. %.0f%% of times heads had been tossed when she awoke" woken heads (100.0*float(heads)/float(woken))


USING: combinators.random io kernel math prettyprint ;

: sleeping ( n -- heads wakenings )
    0 0 rot [ 1 + .5 [ [ 1 + ] dip ] [ 1 + ] ifp ] times ;

"Wakenings over 1,000,000 experiments: " write
1e6 sleeping dup . /f
"Sleeping Beauty should estimate a credence of: " write .


package main

import (
    "fmt"
    "math/rand"
    "rcu"
    "time"
)

func sleepingBeauty(reps int) float64 {
    wakings := 0
    heads := 0
    for i := 0; i < reps; i++ {
        coin := rand.Intn(2) // heads = 0, tails = 1 say
        wakings++
        if coin == 0 {
            heads++
        } else {
            wakings++
        }
    }
    fmt.Printf("Wakings over %s repetitions = %s\n", rcu.Commatize(reps), rcu.Commatize(wakings))
    return float64(heads) / float64(wakings) * 100
}

func main() {
    rand.Seed(time.Now().UnixNano())
    pc := sleepingBeauty(1e6)
    fmt.Printf("Percentage probability of heads on waking = %f%%\n", pc)
}


import Data.Monoid   (Sum(..))
import System.Random (randomIO)
import Control.Monad (replicateM)
import Data.Bool     (bool)

data Toss = Heads | Tails deriving Show

anExperiment toss =
  moreWakenings <>
  case toss of
    Heads -> headsOnWaking
    Tails -> moreWakenings
  where
    moreWakenings = (1,0)
    headsOnWaking = (0,1)

main = do
  tosses <- map (bool Heads Tails) <$> replicateM 1000000 randomIO
  let (Sum w, Sum h) = foldMap anExperiment tosses
  let ratio = fromIntegral h / fromIntegral w
  putStrLn $ "Ratio: " ++ show ratio


;using sockets on linux with the 0x80 inturrprets.
;
;assemble
;  nasm -o socket.o -f elf32 -g socket.asm
;link
;  ld -o socket socket.o
;
;
;Just some assigns for better readability

%assign SOCK_STREAM         1
%assign AF_INET             2
%assign SYS_socketcall      102
%assign SYS_SOCKET          1
%assign SYS_CONNECT         3
%assign SYS_SEND            9
%assign SYS_RECV            10

section .text
  global _start

;--------------------------------------------------
;Functions to make things easier. :]
;--------------------------------------------------
_socket:
  mov [cArray+0], dword AF_INET
  mov [cArray+4], dword SOCK_STREAM
  mov [cArray+8], dword 0
  mov eax, SYS_socketcall
  mov ebx, SYS_SOCKET
  mov ecx, cArray
  int 0x80
  ret

_connect:
  call _socket
  mov dword [sock], eax
  mov dx, si
  mov byte [edi+3], dl
  mov byte [edi+2], dh
  mov [cArray+0], eax     ;sock;
  mov [cArray+4], edi     ;&sockaddr_in;
  mov edx, 16
  mov [cArray+8], edx   ;sizeof(sockaddr_in);
  mov eax, SYS_socketcall
  mov ebx, SYS_CONNECT
  mov ecx, cArray
  int 0x80
  ret

_send:
  mov edx, [sock]
  mov [sArray+0],edx
  mov [sArray+4],eax
  mov [sArray+8],ecx
  mov [sArray+12], dword 0
  mov eax, SYS_socketcall
  mov ebx, SYS_SEND
  mov ecx, sArray
  int 0x80
  ret

_exit:
  push 0x1
  mov eax, 1
  push eax
  int 0x80

_print:
  mov ebx, 1
  mov eax, 4
  int 0x80
  ret
;--------------------------------------------------
;Main code body
;--------------------------------------------------

_start:
  mov esi, szIp
  mov edi, sockaddr_in
  xor eax,eax
  xor ecx,ecx
  xor edx,edx
  .cc:
    xor   ebx,ebx
  .c:
    lodsb
    inc   edx
    sub   al,'0'
    jb   .next
    imul ebx,byte 10
    add   ebx,eax
    jmp   short .c
  .next:
    mov   [edi+ecx+4],bl
    inc   ecx
    cmp   ecx,byte 4
    jne   .cc

  mov word [edi], AF_INET
  mov esi, szPort
  xor eax,eax
  xor ebx,ebx
  .nextstr1:
    lodsb
    test al,al
    jz .ret1
    sub   al,'0'
    imul ebx,10
    add   ebx,eax
    jmp   .nextstr1
  .ret1:
    xchg ebx,eax
    mov [sport], eax

  mov si, [sport]
  call _connect
  cmp eax, 0
  jnz short _fail
  mov eax, msg
  mov ecx, msglen
  call _send
  call _exit

_fail:
  mov edx, cerrlen
  mov ecx, cerrmsg
  call _print
  call _exit

_recverr:
  call _exit
_dced:
  call _exit

section .data
cerrmsg      db 'failed to connect :(',0xa
cerrlen      equ $-cerrmsg
msg          db 'Hello socket world!',0xa
msglen       equ $-msg

szIp         db '127.0.0.1',0
szPort       db '256',0

section .bss
sock         resd 1
;general 'array' for syscall_socketcall argument arg.
cArray       resd 1
             resd 1
	     resd 1
             resd 1

;send 'array'.
sArray      resd 1
            resd 1
            resd 1
            resd 1
;duh?
sockaddr_in resb 16
;..
sport       resb 2
buff        resb 1024


func IsPrime(N);        \Return 'true' if N is prime
int  N, I;
[if N <= 2 then return N = 2;
if (N&1) = 0 then \even >2\ return false;
for I:= 3 to sqrt(N) do
    [if rem(N/I) = 0 then return false;
    I:= I+1;
    ];
return true;
];

func PrimeDigits(N);    \Return 'true' if all digits are prime
int  N;
[repeat N:= N/10;
        case rem(0) of
          0, 1, 4, 6, 8, 9: return false
        other [];
until   N = 0;
return true;
];

int C, N;
[C:= 0;  N:= 2;
loop    [if IsPrime(N) then
            if PrimeDigits(N) then
                [C:= C+1;
                if C <= 25 then
                    [IntOut(0, N);  ChOut(0, ^ )];
                if C = 100 then
                    [Text(0, "^m^j100th: ");  IntOut(0, N)];
                if C = 1000 then quit;
                ];
        N:= N+1;
        ];
Text(0, "^m^j1000th: ");  IntOut(0, N);  CrLf(0);
]


num = 0
limit = 26
limit100 = 100

print "First 25 Smarandache primes:\n"
for n = 1 to 34000
    flag = 0
    nStr$ = str$(n)
    for x = 1 to len(nStr$)
        nx = val(mid$(nStr$,x,1))
        if isPrime(n) and isPrime(nx) then
           flag = flag + 1
        else
           break
        end if
     next
     if flag = len(nStr$) then
        num = num + 1
        if num < limit  print "", n, " ";
        if num = limit100  print "\n\n100th Smarandache prime: ", n
     end if
next n
end

sub isPrime(v)
    if v < 2  return False
    if mod(v, 2) = 0  return v = 2
    if mod(v, 3) = 0  return v = 3
    d = 5
    while d * d <= v
        if mod(v, d) = 0 then return False else d = d + 2 : fi
    wend
    return True
end sub


"""
    Run the Sleeping Beauty Problem experiment `repetitions` times, checking to see
    how often we had heads on waking Sleeping Beauty.
"""
function sleeping_beauty_experiment(repetitions)
    gotheadsonwaking = 0
    wakenings = 0
    for _ in 1:repetitions
        coin_result = rand(["heads", "tails"])

        # On Monday, we check if we got heads.
        wakenings += 1
        if coin_result == "heads"
            gotheadsonwaking += 1
        end

        # If tails, we do this again, but of course we will not add as if it was heads.
        if coin_result == "tails"
            wakenings += 1
            if coin_result == "heads"
                gotheadsonwaking += 1   # never done
            end
        end
    end

    # Show the number of times she was wakened.
    println("Wakenings over ", repetitions, " experiments: ", wakenings)

    # Return the number of correct bets SB made out of the total number
    # of times she is awoken over all the experiments with that bet.
    return gotheadsonwaking / wakenings
end

CREDENCE = sleeping_beauty_experiment(1_000_000)
println("Results of experiment:  Sleeping Beauty should estimate a credence of: ", CREDENCE)


ClearAll[SleepingBeautyExperiment]
SleepingBeautyExperiment[reps_Integer] := Module[{gotheadsonwaking, wakenings, coinresult},
  gotheadsonwaking = 0;
  wakenings = 0;
  Do[
   coinresult = RandomChoice[{"heads", "tails"}];
   wakenings++;
   If[coinresult === "heads",
    gotheadsonwaking++;
    ,
    wakenings++;
    ]
   ,
   {reps}
   ];
  Print["Wakenings over ", reps, " experiments: ", wakenings];
  gotheadsonwaking/wakenings
 ]
out = [email protected][10^6];
Print["Results of experiment: Sleeping Beauty should estimate a credence of: ", out]


import random

const N = 1_000_000

type Side {.pure.} = enum Heads, Tails

const Sides = [Heads, Tails]

randomize()
var onHeads, wakenings = 0
for _ in 1..N:
  let side = sample(Sides)
  inc wakenings
  if side == Heads:
    inc onHeads
  else:
    inc wakenings

echo "Wakenings over ", N, " experiments: ", wakenings
echo "Sleeping Beauty should estimate a credence of: ", onHeads / wakenings


program sleepBeau;
uses
  sysutils; //Format
const
  iterations = 1000*1000;
fmt = 'Wakings over %d repetitions = %d'+#13#10+
      'Percentage probability of heads on waking = %8.5f%%';
var
  i,
  heads,
  wakings,
  flip: Uint32;
begin
  randomize;
  for i :=1 to iterations do
  Begin
    flip := random(2)+1;//-- 1==heads, 2==tails
    inc(wakings,1 + Ord(flip=2));
    inc(heads,Ord(flip=1));
  end;
  writeln(Format(fmt,[iterations,wakings,heads/wakings*100]));
end.


use strict;
use warnings;

sub sleeping_beauty {
    my($trials) = @_;
    my($gotheadsonwaking,$wakenings);
    $wakenings++ and rand > .5 ? $gotheadsonwaking++ : $wakenings++ for 1..$trials;
    $wakenings, $gotheadsonwaking/$wakenings
}

my $trials = 1_000_000;
printf "Wakenings over $trials experiments: %d\nSleeping Beauty should estimate a credence of: %.4f\n", sleeping_beauty($trials);


constant iterations = 1_000_000,
fmt = """
Wakings over %,d repetitions = %,d
Percentage probability of heads on waking = %f%%
"""
integer heads = 0, wakings = 0
for i=1 to iterations do
    integer flip = rand(2) -- 1==heads, 2==tails
    wakings += 1 + (flip==2)
    heads += (flip==1)
end for
printf(1,fmt,{iterations,wakings,heads/wakings*100})


option casemap:none
option literals:on

ifndef __SOCKET_CLASS__
__SOCKET_CLASS__ equ 1

if @Platform eq windows64

  WSADATA struct
    wVersion        dw ?
    wHighVersion    dw ?
    iMaxSockets     dw ?
    iMaxUdpDg       dw ?
    szDescription   db 256 dup (?)
    szSystemStatus  db 128 dup (?)
    lpVendorInfo    dq ?
  WSADATA ends

  option dllimport:<kernel32>
    ExitProcess     proto :word
    HeapAlloc       proto :qword, :dword, :qword
    HeapFree        proto :qword, :dword, :qword
    GetProcessHeap  proto

  option dllimport:<ws2_32>
    WSAStartup      proto :word, :qword
    WSACleanup      proto :qword
    closesocket     proto :dword

  option dllimport:none
    exit            equ ExitProcess
    close           equ closesocket

elseif @Platform eq linux64
  malloc            proto SYSTEMV :qword
  free              proto SYSTEMV :qword
  close             proto SYSTEMV :dword
  exit              proto SYSTEMV :dword

endif

  memset            proto :qword, :dword, :dword
  printf            proto :qword, :vararg
  strlen            proto :qword
  getaddrinfo       proto :qword, :qword, :qword, :qword
  gai_strerror      proto :dword
  send              proto :dword, :qword, :qword, :dword
  socket            proto :dword, :dword, :dword
  connect           proto :dword, :qword, :dword
  freeaddrinfo      proto :qword

  CLASS socket_class
    CMETHOD conn
    CMETHOD write
  ENDMETHODS
    if @Platform eq windows64
      wsa       WSADATA <?>
    endif
    sock        dd 0
    pai         dq 0
    hostname    dq ?
    port        dq ?
  ENDCLASS

  METHOD socket_class, Init, <VOIDARG>, <>, h:qword, p:qword
    mov rbx, thisPtr
    assume rbx:ptr socket_class
    mov rax, h
    mov [rbx].hostname, rax
    mov rax, p
    mov [rbx].port, rax
    mov rax, rbx
    assume rbx:nothing
    ret
  ENDMETHOD

  METHOD socket_class, conn, <dword>, <>
    local ht:qword

    mov rbx, thisPtr
    assume rbx:ptr socket_class
    invoke printf, CSTR("--> Attempting connection to %s on %s",10), [rbx].hostname ,[rbx].port
    if @Platform eq windows64
      invoke WSAStartup, 202h, addr [rbx].wsa
    endif
    invoke memset, ht, 0, 0x30            ;; sizeof(struct addrinfo)
    mov rax, ht
    mov dword ptr [rax], 0                ;; ai_flags
    mov dword ptr [rax+4], AF_INET
    mov dword ptr [rax+8], SOCK_STREAM
    invoke getaddrinfo, [rbx].hostname, [rbx].port, ht, addr [rbx].pai
    .if rax != 0
      invoke gai_strerror, eax
      invoke printf, CSTR("--> Gai_strerror returned: %s",10), rax
      mov rax, -1
      jmp _exit
    .endif
    mov rax, [rbx].pai
    mov edx, dword ptr [rax + 0XC]        ;; pai.ai_protocol
    mov ecx, dword ptr [rax + 8]          ;; pai.ai_socktype
    mov eax, dword ptr [rax + 4]          ;; pai.ai_family
    invoke socket, eax, ecx, edx
    .if rax == -1
      mov rax, -1
      jmp _exit
    .endif
    mov [rbx].sock, eax
    invoke printf, CSTR("--> Socket created as: %d",10), [rbx].sock
    mov rax, [rbx].pai
    mov edx, dword ptr [rax + 0x10]         ;; pai.ai_addrlen
    mov rcx, qword ptr [rax + 0x18]         ;; pai.ai_addr
    invoke connect, [rbx].sock, rcx, edx
    .if rax == -1
      invoke printf, CSTR("--> connect failed.. %i",10), rax
      mov rax, -1
      jmp _exit
    .endif
    mov rax, 0

    _exit:
      assume rbx:nothing
      ret
  ENDMETHOD

  METHOD socket_class, write, <dword>, <>, b:qword
    local tmp:qword

    mov rbx, thisPtr
    assume rbx:ptr socket_class
    mov rax, b
    mov tmp, rax
    invoke strlen, tmp
    invoke send, [rbx].sock, tmp, rax, 0
    .if eax == -1
      invoke printf, CSTR("--> Error in send..%d",10), rax
      ret
    .endif
    assume rbx:nothing
    ret
  ENDMETHOD

  METHOD socket_class, Destroy, <VOIDARG>, <>
    mov rbx, thisPtr
    assume rbx:ptr socket_class
    invoke close, [rbx].sock
    if @Platform eq windows64
      invoke WSACleanup, addr [rbx].wsa
    endif
    .if [rbx].pai != 0
      invoke freeaddrinfo, [rbx].pai
    .endif
    assume rbx:nothing
    ret
  ENDMETHOD
endif         ;; __SOCKET_CLASS__

.code
main proc
  local lpSocket:ptr socket_class

  mov lpSocket, _NEW(socket_class, CSTR("localhost"), CSTR("256"))
  lpSocket->conn()
  .if rax == -1
    invoke exit, 0
    ret
  .endif
  invoke printf, CSTR("-> Connected, sending data.",10)
  lpSocket->write(CSTR("Goodbye, socket world!",10))
  _DELETE(lpSocket)
  invoke exit, 0
  ret
main endp

end


from random import choice

def sleeping_beauty_experiment(repetitions):
    """
    Run the Sleeping Beauty Problem experiment `repetitions` times, checking to see
    how often we had heads on waking Sleeping Beauty.
    """
    gotheadsonwaking = 0
    wakenings = 0
    for _ in range(repetitions):
        coin_result = choice(["heads", "tails"])

        # On Monday, we check if we got heads.
        wakenings += 1
        if coin_result == "heads":
            gotheadsonwaking += 1

        # If tails, we do this again, but of course we will not add as if it was heads..
        if coin_result == "tails":
            wakenings += 1
            if coin_result == "heads":
                gotheadsonwaking += 1   # never done

    # Show the number of times she was wakened.
    print("Wakenings over", repetitions, "experiments:", wakenings)

    # Return the number of correct bets SB made out of the total number
    # of times she is awoken over all the experiments with that bet.
    return gotheadsonwaking / wakenings

CREDENCE = sleeping_beauty_experiment(1_000_000)
print("Results of experiment:  Sleeping Beauty should estimate a credence of:", CREDENCE)


  [ $ "bigrat.qky" loadfile ] now!

  [ say "Number of trials:  "
    dup echo cr
    0 ( heads count )
    0 ( sleeps count )
    rot times
      [ 1+
        2 random if
          [ 1+ dip 1+ ] ]
    say "Data: heads count: "
    over echo cr
    say "     sleeps count: "
    dup echo cr
    say "Credence of heads: "
    2dup 20 point$ echo$ cr
    say " or approximately: "
    10 round vulgar$ echo$ cr ] is trials ( n --> n/d )

    1000000 trials


beautyProblem <- function(n)
{
  wakeCount <- headCount <- 0
  for(i in seq_len(n))
  {
    wakeCount <- wakeCount + 1
    if(sample(c("H", "T"), 1) == "H") headCount <- headCount + 1 else wakeCount <- wakeCount + 1
  }
  headCount/wakeCount
}
print(beautyProblem(10000000))


sub sleeping-beauty ($trials) {
    my $gotheadsonwaking = 0;
    my $wakenings = 0;
    ^$trials .map: {
        given <Heads Tails>.roll {
            ++$wakenings;
            when 'Heads' { ++$gotheadsonwaking }
            when 'Tails' { ++$wakenings }
        }
    }
    say "Wakenings over $trials experiments: ", $wakenings;
    $gotheadsonwaking / $wakenings
}

say "Results of experiment:  Sleeping Beauty should estimate a credence of: ", sleeping-beauty(1_000_000);


Red ["Sleeping Beauty problem"]

experiments: 1'000'000
heads: awakenings: 0
loop experiments [
    awakenings: awakenings + 1
    either 1 = random 2 [heads: heads + 1] [awakenings: awakenings + 1]
]
print ["Awakenings over" experiments "experiments:" awakenings]
print ["Probability of heads on waking:" heads / awakenings]


var s=Network.TCPClientSocket.connectTo("localhost",256);
s.write("hello socket world");  //-->18
s.close();


zmodload zsh/net/tcp
ztcp localhost 256
print hello socket world >&$REPLY


/*REXX pgm uses a Monte Carlo estimate for the results for the Sleeping Beauty problem. */
parse arg n seed .                               /*obtain optional arguments from the CL*/
if n==''  |  n==","     then n= 1000000          /*Not specified?  Then use the default.*/
if datatype(seed, 'W')  then call random ,,seed  /*    Specified?  Then use as RAND seed*/
awake= 0                                         /*     "        "    "   "   awakened. */
           do #=0  for n                         /*perform experiment:  1 million times?*/
           if random(,1)  then awake= awake + 1  /*Sleeping Beauty  is   awoken.        */
                          else #= # + 1          /*   "        "   keeps sleeping.      */
           end   /*#*/                           /* [↑]  RANDOM returns:    0  or  1    */

say 'Wakenings over '     commas(n)     " repetitions: "      commas(#)
say 'The percentage probability of heads on awakening: '      (awake / # * 100)"%"
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg ?;  do jc=length(?)-3  to 1  by -3; ?=insert(',', ?, jc); end;  return ?


def sleeping_beauty_experiment(n)
  coin = [:heads, :tails]
  gotheadsonwaking = 0
  wakenings = 0
  n.times do
    wakenings += 1
    coin.sample == :heads ? gotheadsonwaking += 1 : wakenings += 1
  end
  puts "Wakenings over #{n} experiments: #{wakenings}"
  gotheadsonwaking / wakenings.to_f
end

puts "Results of experiment: Sleeping Beauty should estimate
a credence of: #{sleeping_beauty_experiment(1_000_000)}"


let experiments = 1000000
var heads = 0
var wakenings = 0
for _ in (1...experiments) {
    wakenings += 1
    switch (Int.random(in: 0...1)) {
    case 0:
        heads += 1
    default:
        wakenings += 1
    }
}
print("Wakenings over \(experiments) experiments: \(wakenings)")
print("Sleeping Beauty should estimate a credence of: \(Double(heads) / Double(wakenings))")


import rand
import rand.seed

fn sleeping_beauty(reps int) f64 {
    mut wakings := 0
    mut heads := 0
    for _ in 0..reps {
        coin := rand.intn(2) or {0} // heads = 0, tails = 1 say
        wakings++
        if coin == 0 {
            heads++
        } else {
            wakings++
        }
    }
    println("Wakings over $reps repetitions = $wakings")
    return f64(heads) / f64(wakings) * 100
}

fn main() {
    rand.seed(seed.time_seed_array(2))
    pc := sleeping_beauty(1000000)
    println("Percentage probability of heads on waking = $pc%")
}


import "random" for Random
import "/fmt" for Fmt

var rand = Random.new()

var sleepingBeauty = Fn.new { |reps|
    var wakings = 0
    var heads = 0
    for (i in 0...reps) {
        var coin = rand.int(2) // heads = 0, tails = 1 say
        wakings = wakings + 1
        if (coin == 0) {
            heads = heads + 1
        } else {
            wakings = wakings + 1
        }
    }
    Fmt.print("Wakings over $,d repetitions = $,d", reps, wakings)
    return heads/wakings * 100
}

var pc = sleepingBeauty.call(1e6)
Fmt.print("Percentage probability of heads on waking = $f\%", pc)


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

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

.equ NBELEMENTS,      100              // list size

/*******************************************/
/* Structures                               */
/********************************************/
/* structure linkedlist*/
    .struct  0
llist_next:                            // next element
    .struct  llist_next + 8
llist_value:                           // element value
    .struct  llist_value + 8
llist_fin:
/* Initialized data */
.data
szMessInitListe:         .asciz "List initialized.\n"
szCarriageReturn:        .asciz "\n"
/* datas error display */
szMessErreur:            .asciz "Error detected.\n"
/* datas message display */
szMessResult:            .asciz "Element No : @ value @ \n"

/* UnInitialized data */
.bss
lList1:              .skip llist_fin * NBELEMENTS    // list memory place
sZoneConv:           .skip 100
/*  code section */
.text
.global main
main:
    ldr x0,qAdrlList1
    mov x1,#0                           // list init
    str x1,[x0,#llist_next]
    ldr x0,qAdrszMessInitListe
    bl affichageMess
    ldr x0,qAdrlList1
    mov x1,#2
    bl insertElement                    // add element value 2
    ldr x0,qAdrlList1
    mov x1,#5
    bl insertElement                    // add element value 5
    //                                   // display elements of list
    ldr x3,qAdrlList1
    mov x2,#0                           // ident element
1:
    ldr x0,[x3,#llist_next]             // end list ?
    cmp x0,#0
    beq 100f                            // yes
    add x2,x2,#1
    mov x0,x2                           // display No element and value
    ldr x1,qAdrsZoneConv
    bl conversion10S
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc
    mov x5,x0                          // address of new string
    ldr x0,[x3,#llist_value]
    ldr x1,qAdrsZoneConv
    bl conversion10S
    mov x0,x5                          // new address of message
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc
    bl affichageMess
    ldr x3,[x3,#llist_next]             // next element
    b 1b                                // and loop
100:                                    // standard end of the program
    mov x8, #EXIT                       // request to exit program
    svc 0                               // perform system call
qAdrszMessInitListe:       .quad szMessInitListe
qAdrszMessErreur:          .quad szMessErreur
qAdrszCarriageReturn:      .quad szCarriageReturn
qAdrlList1:                .quad lList1
qAdrszMessResult:          .quad szMessResult
qAdrsZoneConv:             .quad sZoneConv

/******************************************************************/
/*     insert element at end of list                          */
/******************************************************************/
/* x0 contains the address of the list */
/* x1 contains the value of element  */
/* x0 returns address of element or - 1 if error */
insertElement:
    stp x1,lr,[sp,-16]!                   // save  registers
    stp x2,x3,[sp,-16]!                   // save  registers
    mov x2,#llist_fin * NBELEMENTS
    add x2,x2,x0                          // compute address end list
1:                                        // start loop
    ldr x3,[x0,#llist_next]               // load next pointer
    cmp x3,#0                             // = zero
    csel  x0,x3,x0,ne
    bne 1b                                // no -> loop with pointer
    add x3,x0,#llist_fin                  // yes -> compute next free address
    cmp x3,x2                             // > list end
    bge 99f                               // yes -> error
    str x3,[x0,#llist_next]               // store next address in current pointer
    str x1,[x0,#llist_value]              // store element value
    mov x1,#0
    str x1,[x3,#llist_next]               // init next pointer in next address
    b 100f
99:                                       // error
    mov x0,-1
100:
    ldp x2,x3,[sp],16                     // restaur  2 registers
    ldp x1,lr,[sp],16                     // restaur  2 registers
    ret                                   // return to address lr x30
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


(defun traverse (xs)
   (if (endp xs)
       (cw "End.~%")
       (prog2$ (cw "~x0~%" (first xs))
               (traverse (rest xs)))))


var A:Node;
//...
for(var i:Node = A; i != null; i = i.link)
{
	doStuff(i);
}


with Ada.Containers.Doubly_Linked_Lists;
with Ada.Text_Io; use Ada.Text_Io;

procedure Traversal_Example is
   package Int_List is new Ada.Containers.Doubly_Linked_Lists(Integer);
   use Int_List;
   procedure Print(Position : Cursor) is
   begin
      Put_Line(Integer'Image(Element(Position)));
   end Print;
   The_List : List;
begin
   for I in 1..10 loop
      The_List.Append(I);
   end loop;
   -- Traverse the list, calling Print for each value
   The_List.Iterate(Print'access);
end traversal_example;


MODE STRINGLIST = STRUCT(STRING value, REF STRINGLIST next);

STRINGLIST list := ("Big",
  LOC STRINGLIST := ("fjords",
    LOC STRINGLIST := ("vex",
      LOC STRINGLIST := ("quick",
        LOC STRINGLIST := ("waltz",
          LOC STRINGLIST := ("nymph",NIL))))));

REF STRINGLIST node := list;
WHILE node ISNT REF STRINGLIST(NIL) DO
  print((value OF node, space));
  node := next OF node
OD;
print(newline)


begin
    % record type to hold a singly linked list of integers                    %
    record ListI ( integer iValue; reference(ListI) next );

    % inserts a new value after the specified element of a list               %
    procedure insert( reference(ListI) value list
                    ; integer          value newValue
                    ) ;
        next(list) := ListI( newValue, next(list) );

    % declare variables to hold the list                                      %
    reference(ListI) head, pos;

    % create a list of integers                                               %
    head := ListI( 1701, ListI( 9000, ListI( 42, ListI( 90210, null ) ) ) );

    % insert a new value into the list                                        %
    insert( next(head), 4077 );

    % traverse the list                                                       %
    pos := head;

    while pos not = null do begin
        write( iValue(pos) );
        pos := next(pos);
    end;

end.


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

/* Constantes    */
.equ STDOUT, 1                           @ Linux output console
.equ EXIT,   1                           @ Linux syscall
.equ READ,   3
.equ WRITE,  4

.equ NBELEMENTS,      100              @ list size

/*******************************************/
/* Structures                               */
/********************************************/
/* structure linkedlist*/
    .struct  0
llist_next:                            @ next element
    .struct  llist_next + 4
llist_value:                           @ element value
    .struct  llist_value + 4
llist_fin:
/* Initialized data */
.data
szMessInitListe:         .asciz "List initialized.\n"
szCarriageReturn:        .asciz "\n"
/* datas error display */
szMessErreur:            .asciz "Error detected.\n"
/* datas message display */
szMessResult:            .ascii "Element No :"
sNumElement:             .space 12,' '
                         .ascii " value :  "
sValue:                  .space 12,' '
                         .asciz "\n"

/* UnInitialized data */
.bss
lList1:              .skip llist_fin * NBELEMENTS    @ list memory place
/*  code section */
.text
.global main
main:
    ldr r0,iAdrlList1
    mov r1,#0                           @ list init
    str r1,[r0,#llist_next]
    ldr r0,iAdrszMessInitListe
    bl affichageMess
    ldr r0,iAdrlList1
    mov r1,#2
    bl insertElement                    @ add element value 2
    ldr r0,iAdrlList1
    mov r1,#5
    bl insertElement                    @ add element value 5
    @                                   @ display elements of list
    ldr r3,iAdrlList1
    mov r2,#0                           @ ident element
1:
    ldr r0,[r3,#llist_next]             @ end list ?
    cmp r0,#0
    beq 100f                            @ yes
    add r2,#1
    mov r0,r2                           @ display No element and value
    ldr r1,iAdrsNumElement
    bl conversion10S
    ldr r0,[r3,#llist_value]
    ldr r1,iAdrsValue
    bl conversion10S
    ldr r0,iAdrszMessResult
    bl affichageMess
    ldr r3,[r3,#llist_next]             @ next element
    b 1b                                @ and loop
100:                                    @ standard end of the program
    mov r7, #EXIT                       @ request to exit program
    svc 0                               @ perform system call
iAdrszMessInitListe:       .int szMessInitListe
iAdrszMessErreur:          .int szMessErreur
iAdrszCarriageReturn:      .int szCarriageReturn
iAdrlList1:                .int lList1
iAdrszMessResult:          .int szMessResult
iAdrsNumElement:           .int sNumElement
iAdrsValue:                .int sValue

/******************************************************************/
/*     insert element at end of list                          */
/******************************************************************/
/* r0 contains the address of the list */
/* r1 contains the value of element  */
/* r0 returns address of element or - 1 if error */
insertElement:
    push {r1-r3,lr}                       @ save  registers
    mov r2,#llist_fin * NBELEMENTS
    add r2,r0                             @ compute address end list
1:                                        @ start loop
    ldr r3,[r0,#llist_next]               @ load next pointer
    cmp r3,#0                             @ = zero
    movne r0,r3                           @ no -> loop with pointer
    bne 1b
    add r3,r0,#llist_fin                  @ yes -> compute next free address
    cmp r3,r2                             @ > list end
    movge r0,#-1                          @ yes -> error
    bge 100f
    str r3,[r0,#llist_next]               @ store next address in current pointer
    str r1,[r0,#llist_value]              @ store element value
    mov r1,#0
    str r1,[r3,#llist_next]               @ init next pointer in next address

100:
    pop {r1-r3,lr}                        @ restaur registers
    bx lr                                 @ return
/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {r0,r1,r2,r7,lr}                       @ save  registers
    mov r2,#0                                   @ counter length */
1:                                              @ loop length calculation
    ldrb r1,[r0,r2]                             @ read octet start position + index
    cmp r1,#0                                   @ if 0 its over
    addne r2,r2,#1                              @ else add 1 in the length
    bne 1b                                      @ and loop
                                                @ so here r2 contains the length of the message
    mov r1,r0                                   @ address message in r1
    mov r0,#STDOUT                              @ code to write to the standard output Linux
    mov r7, #WRITE                              @ code call system "write"
    svc #0                                      @ call system
    pop {r0,r1,r2,r7,lr}                        @ restaur registers
    bx lr                                       @ return
/***************************************************/
/*  Converting a register to a signed decimal      */
/***************************************************/
/* r0 contains value and r1 area address    */
conversion10S:
    push {r0-r4,lr}       @ save registers
    mov r2,r1             @ debut zone stockage
    mov r3,#'+'           @ par defaut le signe est +
    cmp r0,#0             @ negative number ?
    movlt r3,#'-'         @ yes
    mvnlt r0,r0           @ number inversion
    addlt r0,#1
    mov r4,#10            @ length area
1:                        @ start loop
    bl divisionpar10U
    add r1,#48            @ digit
    strb r1,[r2,r4]       @ store digit on area
    sub r4,r4,#1          @ previous position
    cmp r0,#0             @ stop if quotient = 0
    bne 1b

    strb r3,[r2,r4]       @ store signe
    subs r4,r4,#1         @ previous position
    blt  100f             @ if r4 < 0 -> end

    mov r1,#' '           @ space
2:
    strb r1,[r2,r4]       @store byte space
    subs r4,r4,#1         @ previous position
    bge 2b                @ loop if r4 > 0
100:
    pop {r0-r4,lr}        @ restaur registers
    bx lr
/***************************************************/
/*   division par 10   unsigned                    */
/***************************************************/
/* r0 dividende   */
/* r0 quotient    */
/* r1 remainder   */
divisionpar10U:
    push {r2,r3,r4, lr}
    mov r4,r0                                          @ save value
    //mov r3,#0xCCCD                                   @ r3 <- magic_number lower  raspberry 3
    //movt r3,#0xCCCC                                  @ r3 <- magic_number higter raspberry 3
    ldr r3,iMagicNumber                                @ r3 <- magic_number    raspberry 1 2
    umull r1, r2, r3, r0                               @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
    mov r0, r2, LSR #3                                 @ r2 <- r2 >> shift 3
    add r2,r0,r0, lsl #2                               @ r2 <- r0 * 5
    sub r1,r4,r2, lsl #1                               @ r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10)
    pop {r2,r3,r4,lr}
    bx lr                                              @ leave function
iMagicNumber:  	.int 0xCCCCCCCD


(*------------------------------------------------------------------*)

(* The Rosetta Code linear list type can contain any [email protected]
   (The ‘@’ means it doesn’t have to be the size of a pointer.
   You can read {0 <= n} as ‘for all non-negative n’. *)
dataviewtype rclist_vt (vt : [email protected]+, n : int) =
| rclist_vt_nil (vt, 0)
| {0 <= n} rclist_vt_cons (vt, n + 1) of (vt, rclist_vt (vt, n))

(* A lemma one will need: lists never have negative lengths. *)
extern prfun {vt : [email protected]}
lemma_rclist_vt_param
          {n : int}
          (lst : !rclist_vt (vt, n)) :<prf> [0 <= n] void

(* Proof of the lemma. *)
primplement {vt}
lemma_rclist_vt_param lst =
  case+ lst of
  | rclist_vt_nil () => ()
  | rclist_vt_cons _ => ()

(*------------------------------------------------------------------*)

(* For simplicity, the Rosetta Code linear list traverse-and-print
   routine will be specifically for lists of ‘int’. *)

(* Some things that will be needed. *)
#include "share/atspre_staload.hats"

(* The list is passed by value and will be preserved with the same
   type. *)
extern fun
rclist_int_traverse_and_print
          {m   : int}                   (* ‘for all list lengths m’ *)
          (lst : !rclist_vt (int, m) >> (* ! = pass by value *)
                   (* The new type will be the same as the old
                      type. *)
                   rclist_vt (int, m)) : void

implement
rclist_int_traverse_and_print {m} (lst) =
  {
    (* A recursive nested function that traverses the list, printing
       elements along the way. *)
    fun
    traverse {k : int | 0 <= k}
             .<k>. (* Means: ‘k must uniformly decrease towards zero.’
                      If so, that is proof that ‘find’ terminates. *)
             (lst : !rclist_vt (int, k) >> rclist_vt (int, k)) :
        void =
      case+ lst of
      | rclist_vt_nil () => ()  (* End of list. *)
      | rclist_vt_cons (head, tail) =>
        begin
          println! (head);
          traverse tail
        end

    (* The following is needed to prove that the initial k above
       satisfies 0 <= k. *)
    prval _ = lemma_rclist_vt_param lst

    val _ = traverse lst
  }

(* Now let’s try it. *)

(* Some convenient notation. *)
#define NIL rclist_vt_nil ()
#define :: rclist_vt_cons
overload traverse_and_print with rclist_int_traverse_and_print

val A = 123
val B = 789
val C = 456

val lst = A :: C :: B :: NIL

val () = traverse_and_print lst

(*------------------------------------------------------------------*)

implement
main0 () = ()


a = 1
a_next = b
b = 2
b_next = c
c = 3

traverse("a")
return

traverse(element)
{
  MsgBox % element . "= " . %element%
  name := element . "_next"
  while, %name%
  {
  element := %name%
  msgbox % %name% . "= " . %element%
  name := %name% . "_next"
  }
}


LINK(L₁,1)→A
LINK(L₁+10,2)→B
LINK(L₁+50,3)→C

INSERT(A,B)
INSERT(A,C)

A→I
While I≠0
 Disp VALUE(I)▶Dec,i
 NEXT(I)→I
End


      DIM node{pNext%, iData%}
      DIM a{} = node{}, b{} = node{}, c{} = node{}

      a.pNext% = b{}
      a.iData% = 123
      b.iData% = 789
      c.iData% = 456

      PROCinsert(a{}, c{})

      PRINT "Traverse list:"
      pnode% = a{}
      REPEAT
        !(^node{}+4) = pnode%
        PRINT node.iData%
        pnode% = node.pNext%
      UNTIL pnode% = 0

      END

      DEF PROCinsert(here{}, new{})
      new.pNext% = here.pNext%
      here.pNext% = new{}
      ENDPROC


struct link *first;
// ...
struct link *iter;
for(iter = first; iter != NULL; iter = iter->next) {
  // access data, e.g. with iter->data
}


var current = [head of list to traverse]
while(current != null)
{
    // Do something with current.Value.

    current = current.Next;
}


#include <iostream>
#include <forward_list>

int main()
{
    std::forward_list<int> list{1, 2, 3, 4, 5};
    for (int e : list)
        std::cout << e << std::endl;
}


start:  LDA  load
        ADD  car   ; head of list
        STA  ldcar

        ADD  one
        STA  ldcdr

ldcar:  NOP
        STA  value

ldcdr:  NOP
        BRZ  done  ; 0 == NIL
        STA  car

        JMP  start

done:   LDA  value
        STP

load:   LDA  0
value:       0
car:         28    ; head of list
one:         1

20,21:       6, 0
22,23:       2, 26
24,25:       5, 20
26,27:       3, 30
28,29:       1, 22
30,31:       4, 24


struct SLinkedNode(T) {
    T data;
    typeof(this)* next;
}

void main() {
    import std.stdio;

    alias N = SLinkedNode!int;
    auto lh = new N(1, new N(2, new N(3, new N(4))));

    for (auto p = lh; p; p = p.next)
        write(p.data, " ");
    writeln();
}


uses system ;

type

   // declare the list pointer type
   plist = ^List ;

   // declare the list type, a generic data pointer prev and next pointers
   List = record
      data : pointer ;
      next : pList ;
   end;

// since this task is just showing the traversal I am not allocating the memory and setting up the root node etc.
// Note the use of the carat symbol for de-referencing the pointer.

begin

   // beginning to end
   while not (pList^.Next = NIL) do pList := pList^.Next ;

end;


type List = Cons(value, tail) or Nil()
    with Lookup

static func List.FromArray(xs) {
    var list = List.Nil()
    var len = xs.Length()

    for i in (len-1)^-1..0 {
        list = List.Cons(xs[i], list)
    }

    return list
}

func List.Iterate() {
    var xs = this
    do {
        match xs {
            Cons(value, tail) => {
                yield value
                xs = tail
            },
            Nil() => {
                yield break
            }
        }

    } while true
}

var xs = List.FromArray([1..10])

for x in xs {
    print(x)
}


var linkedList := [1, [2, [3, [4, [5, [6, [7, null]]]]]]]

while (linkedList =~ [value, next]) {
    println(value)
    linkedList := next
}


(define friends '( albert ludwig elvis 🌀))

(for-each write friends)→  albert ludwig elvis 🌀

; for loop
(for ((friend friends)) (write friend)) → albert ludwig elvis 🌀

; map a function
(map string-upcase friends)  → ("ALBERT" "LUDWIG" "ELVIS" "🌀")
(map string-randcase friends) → ("ALBerT" "LudWIG" "elVis" "🌀")

; recursive way
(define (rscan L)
    (unless (null? L)
        (write (first L))
         (rscan (rest L))))

(rscan friends)  →  albert ludwig elvis 🌀

; folding a list
; check that ∑ 1..n = n (n+1)/2

(define L (iota 1001))
(foldl + 0 L) → 500500 ; 1000 * 1001 / 2


traverse [] = []
traverse (x::xs) = x :: traverse xs


while(nil != current){
    console printLine(current.Item);
    current := current.Next
}


1> lists:map( fun erlang:is_integer/1, [1,2,3,a,b,c] ).
[true,true,true,false,false,false]
4> lists:foldl( fun erlang:'+'/2, 0, [1,2,3] ).
6


: list-each ( linked-list quot: ( data -- ) -- )
    [ [ data>> ] dip call ]
    [ [ next>> ] dip over [ list-each ] [ 2drop ] if ] 2bi ; inline recursive

SYMBOLS: A B C ;

A <linked-list>
[ C <linked-list> list-insert ] keep
[ B <linked-list> list-insert ] keep

[ . ] list-each


    // traverse the linked list
    Node? current := a
    while (current != null)
    {
      echo (current.value)
      current = current.successor
    }


: last ( list -- end )
  begin dup @ while @ repeat ;


subroutine traversal(list,proc)
   type(node), target    :: list
   type(node), pointer   :: current
   interface
      subroutine proc(node)
         real, intent(in) :: node
      end subroutine proc
   end interface
   current => list
   do while ( associated(current) )
      call proc(current%data)
      current => current%next
   end do
end subroutine traversal


#define NULL 0

function alloc_ll_int( n as integer ) as ll_int ptr
    dim as ll_int ptr ret = allocate(sizeof(ll_int))
    ret->n = n
    ret->nxt = NULL
    return ret
end function

sub traverse_ll_int( head as ll_int ptr )
    dim as ll_int ptr curr = head
    while curr <> NULL
        print curr->n
        curr = curr->nxt
    wend
end sub

dim as ll_int ptr curr, head = alloc_ll_int( 0 ), node
dim as integer i
curr=head
for i = 1 to 50
    'build a list to traverse. This is basically a traversal itself...
    node = alloc_ll_int( i )
    insert_ll_int( curr, node )
    curr = curr->nxt
next i

traverse_ll_int( head )


start := &Ele{"tacos", nil}
end := start.Append("burritos")
end = end.Append("fajitas")
end = end.Append("enchilatas")
for iter := start; iter != nil; iter = iter.Next {
    fmt.Println(iter)
}


map (>5) [1..10] -- [False,False,False,False,False,True,True,True,True,True]

map (++ "s") ["Apple", "Orange", "Mango", "Pear"] -- ["Apples","Oranges","Mangos","Pears"]

foldr (+) 0 [1..10] -- prints 55

traverse :: [a] -> [a]
traverse list = map func list
	where func a = -- ...do something with a


procedure main ()
  ns := Node(1, Node(2, Node (3)))
  until /ns do { # repeat until ns is null
    write (ns.value)
    ns := ns.successor
  }
end


LinkedList<Type> list = new LinkedList<Type>();

for(Type i: list){
  //each element will be in variable "i"
  System.out.println(i);
}


LinkedList.prototype.traverse = function(func) {
    func(this);
    if (this.next() != null)
        this.next().traverse(func);
}

LinkedList.prototype.print = function() {
    this.traverse( function(node) {print(node.value())} );
}

var head = createLinkedListFromArray([10,20,30,40]);
head.print();


# Produce a stream of the items in the input SLL.
def items:
  while(.; .next) | .item;

def to_singly_linked_list(s):
  reduce ([s]|reverse[]) as $item (null; {$item, next:.});

# If f evaluates to empty at any item, that item is removed;
# if f evaluates to more than one item, all are added separately.
def map_singly_linked_list(f): to_singly_linked_list( items | f );


Base.start(ll::LinkedList) = ll.head
Base.done(ll::LinkedList{T}, st::AbstractNode{T}) where T = st isa EmptyNode
Base.next(ll::LinkedList{T}, st::AbstractNode{T}) where T = st.data, st.next

lst = LinkedList{Int}()
push!(lst, 1)
push!(lst, 2)
push!(lst, 3)

for n in lst
    print(n, " ")
end


fun main(args: Array<String>) {
    val list = IntRange(1, 50).toList()

    // classic traversal:
    for (i in list) { print("%4d ".format(i)); if (i % 10 == 0) println() }

    // list iterator:
    list.asReversed().forEach { print("%4d ".format(it)); if (it % 10 == 1) println() }
}


implement Command;

include "sys.m";
sys: Sys;

include "draw.m";

include "sh.m";

init(nil: ref Draw->Context, nil: list of string)
{
	sys = load Sys Sys->PATH;

	l := list of {1, 2, 3, 4, 5};

	# the unary 'tl' operator gets the tail of a list
	for (; l != nil; l = tl l)
		sys->print("%d\n", hd l);
		# the unary 'hd' operator gets the head of a list
}


to last :list
  if empty? bf :list [output first :list]
  output last bf :list
end


:- object(singly_linked_list).

    :- public(show/0).

    show :-
        traverse([1,2,3]).

    traverse([]).
    traverse([Head| Tail]) :-
        write(Head), nl,
        traverse(Tail).

:- end_object.


Print /@ {"rosettacode", "kitten", "sitting", "rosettacode",  "raisethysword"}


list = 1:10;
    for k=1:length(list)
        printf('%i\n',list(k))
    end;


myList = [2, 4, 6, 8]
for i in myList
    print i
end for


first = new(link)
//
for (iter = first) (iter != null) (iter = iter.next)
        println iter.data
end


type Node[T] = ref object
  next: Node[T]
  data: T

proc newNode[T](data: T): Node[T] =
  Node[T](data: data)

var a = newNode 12
var b = newNode 13
var c = newNode 14

proc insertAppend(a, n: var Node) =
  n.next = a.next
  a.next = n

a.insertAppend(b)
b.insertAppend(c)

iterator items(a: Node) =
  var x = a
  while not x.isNil:
    yield x
    x = x.next

for item in a:
  echo item.data


for(node := head; node <> Nil; node := node->GetNext();) {
  node->GetValue()->PrintLine();
};


RCListElement *current;
for(current=first_of_the_list; current != nil; current = [current next] )
{
  // to get the "datum":
  // id dat_obj = [current datum];
}


# let li = ["big"; "fjords"; "vex"; "quick"; "waltz"; "nymph"] in
  List.iter print_endline li ;;
big
fjords
vex
quick
waltz
nymph
- : unit = ()


: testLink LinkedList new($A, null) dup add($B) dup add($C) ;
testLink apply(#println)


list=.list~of('A','B','X')
say "Manual list traversal"
index=list~first
loop while index \== .nil
    say list~at(index)
    index = list~next(index)
end

say
say "Do ... Over traversal"
do value over list
    say value
end


<@ LETCNSLSTLIT>public holidays|開國紀念日^和平紀念日^婦女節、兒童節合併假期^清明節^國慶日^春節^端午節^中秋節^農曆除夕</@>
<@ OMT>From First to Last</@>
<@ ITEFORSZELSTLIT>public holidays|
<@ SAYLST>...</@><@ ACTMOVFWDLST>...</@>
</@>
<@ OMT>From Last to First (pointer is still at end of list)</@>
<@ ITEFORSZELSTLIT>public holidays|
<@ SAYLST>...</@><@ ACTMOVBKWLST>...</@>
</@>


package SSL_Node;
use strict;
use Class::Tiny qw( val next );

sub BUILD {
    my $self = shift;
    exists($self->{val}) or die "Must supply 'val'";
    if (exists $self->{next}) {
        ref($self->{next}) eq 'SSL_Node'
            or die "If supplied, 'next' must be an SSL_Node";
    }
    return;
}

package main;
use strict;
# Construct an example list,
my @vals = 1 .. 10;
my $countdown = SSL_Node->new(val => shift(@vals));
while (@vals) {
    my $head = SSL_Node->new(val => shift(@vals), next => $countdown);
    $countdown = $head;
}
# ...then traverse it.
my $node = $countdown;
while ($node) {
    print $node->val, "... ";
    $node = $node->next;
}
print "\n";


with javascript_semantics
enum NEXT,DATA
constant empty_sll = {{1}}
sequence sll = deep_copy(empty_sll)

procedure insert_after(object data, integer pos=length(sll))
    sll = append(sll,{sll[pos][NEXT],data})
    sll[pos][NEXT] = length(sll)
end procedure

insert_after("ONE")
insert_after("TWO")
insert_after("THREE")

?sll

procedure show()
integer idx = sll[1][NEXT]
    while idx!=1 do
        ?sll[idx][DATA]
        idx = sll[idx][NEXT]
    end while
end procedure
show()


*process source attributes xref or(!);
 /*********************************************************************
 * 25.10.2013 Walter Pachl
 * 'set dd:in=d:\sll.txt,recsize(80)'
 * 'sll'
 *********************************************************************/
 sll: Proc Options(main);
 Dcl in       Record Input;
 Dcl sysprint Print;
 Dcl 1 elem Based(p),
      2 next Ptr Init(null()),
      2 value Char(20) Var;
 Dcl head Ptr;
 Dcl p    Ptr;
 Dcl prev Ptr;
 Dcl i    Bin Fixed(31);
 Dcl rec  Char(80) Var;
 Dcl null Builtin;
 On Endfile(in) goto show;
 Do i=1 By 1;
   Read File(in) Into(rec);
   alloc elem set(p);
   If i=1 Then Do;
     head=p;
     prev=head;
     value=rec;
     End;
   Else Do;
     prev->next=p;
     prev=p;
     value=rec;
     End;
   End;

 show:
   p=head;
   Do i=1 By 1 while(p^=null());
     Put Edit(i,p->value)(skip,f(3),x(1),a);
     p=p->next;
     End;
 End;


Procedure traverse(*node.MyData)
  While *node
    ;access data, i.e. PrintN(Str(*node\Value))
    *node = *node\next
  Wend
EndProcedure

;called using
traverse(*firstnode.MyData)


#lang racket

(define l (list 1 2 3))

;; scan the list and collect a list of function results
(map add1 l)

;; scan the list and run some function on each element for its side-effect
(for-each displayln l)

;; scan a list and sum up its elements
(foldl + 0 l)

;; same as the above three, using a more modern syntax that is often
;; more convenient
(for/list ([x (in-list l)]) (add1 x))
(for ([x (in-list l)]) (displayln x))
(for/fold ([sum 0]) ([x (in-list l)]) (+ x sum))

;; the same as the first, but make up a vector of results
(for/vector ([x (in-list l)]) (add1 x))

;; there is less support for mutable pairs, but it's still extensive
;; enough to cover all the basics
(require racket/mpair)
(define ml (mlist 1 2 3))
(mmap add1 ml)
(mfor-each displayln ml)
(for ([x (in-mlist ml)]) (displayln x))


head = ListNode.new("a", ListNode.new("b", ListNode.new("c")))
head.insertAfter("b", "b+")

# then:
head.each {|node| print node.value, ","}
puts

# or
current = head
begin
  print current.value, ","
end while current = current.succ
puts


list$ = "now is the time for all good men"
for lnk = 1 to 8
 print lnk;"->";word$(list$,lnk)
next lnk


//
//
// Iteration by value (simply empties the list as the caller now owns all values)
//
//
pub struct IntoIter<T>(List<T>);

impl<T> Iterator for IntoIter<T> {
    type Item = T;
    fn next(&mut self) -> Option<Self::Item> {
        self.0.head.take().map(|node| {
            let node = *node;
            self.0.head = node.next;
            node.elem
        })
    }
}

//
//
// Iteration by immutable reference
//
//

pub struct Iter<'a, T: 'a> {
    next: Option<&'a Node<T>>,
}

impl<'a, T> Iterator for Iter<'a, T> {
    type Item = &'a T;
    fn next(&mut self) -> Option<Self::Item> {
        self.next.take().map(|node| {
            self.next = node.next.as_ref().map(|node| &**node);
            &node.elem
        })
    }
}

//
//
// Iteration by mutable reference
//
//

pub struct IterMut<'a, T: 'a> {
    next: Option<&'a mut Node<T>>,
}

impl<'a, T> Iterator for IterMut<'a, T> {
    type Item = &'a mut T;
    fn next(&mut self) -> Option<Self::Item> {
        self.next.take().map(|node| {
            self.next = node.next.as_mut().map(|node| &mut **node);
            &mut node.elem
        })
    }
}

//
//
// Methods implemented for List<T>
//
//

impl<T> List<T> {
    pub fn into_iter(self) -> IntoIter<T> {
        IntoIter(self)
    }

    pub fn iter<'a>(&'a self) -> Iter<'a,T> {
        Iter { next: self.head.as_ref().map(|node| &**node) }
    }

    pub fn iter_mut(&mut self) -> IterMut<T> {
        IterMut { next: self.head.as_mut().map(|node| &mut **node) }
    }

}


/*
Here is a basic list definition

sealed trait List[+A]
case class Cons[+A](head: A, tail: List[A]) extends List[A]
case object Nil extends List[Nothing]
*/

def traverse[A](as: List[A]): Unit = as match {
  case Nil => print("End")
  case Cons(h, t) => {
    print(h + " ")
    traverse(t)
  }
}


(define (traverse seq func)
  (if (null? seq)
      '()
      (begin
        (func (car seq))
        (traverse (cdr seq) func))))


var list = 'a':'b':'c':nil;
#var list = ['a', ['b', ['c']]];
#var list = Pair.new('a', Pair.new('b', Pair.new('c', nil)));

for (var l = list; l != nil; l = l[1]) {
    say l[0];
}


oo::define List {
    method for {varName script} {
        upvar 1 $varName var
        set elem [self]
        while {$elem ne ""} {
            set var [$elem value]
            uplevel 1 $script
            set elem [$elem next]
        }
    }
}


Private Sub Iterate(ByVal list As LinkedList(Of Integer))
    Dim node = list.First
    Do Until node Is Nothing
        node = node.Next
    Loop
    End Sub


import "/llist" for LinkedList
import "/fmt" for Fmt

//create a new linked list and add the first 50 positive integers to it
var ll = LinkedList.new(1..50)

// traverse the linked list
for (i in ll) {
    Fmt.write("$4d ", i)
    if (i % 10 == 0) System.print()
}


def \Node\ Link, Data;          \linked list element definition
int Node, List;
[Node:= List;                   \traverse the linked list
while Node # 0 do
    Node:= Node(Link);          \move to next node
]


// Rosetta Code problem: http://rosettacode.org/wiki/Singly-linked_list/Element_insertion & removal & traverse
// by Galileo, 02/2022

FIL = 1 : DATO = 2 : LINK = 3
countNodes = 0 : Nodes = 10

dim list(Nodes, 3)

sub searchNode(node)
    local i, prevNode

    for i = 1 to countNodes
        if i = node break
        prevNode = list(prevNode, LINK)
    next

    return prevNode
end sub

sub insertNode(node, newNode, after)
    local prevNode, i

    prevNode = searchNode(node)

    if after prevNode = list(prevNode, LINK)

    for i = 1 to Nodes
        if not list(i, FIL) break
    next

    list(i, FIL) = true
    list(i, DATO) = newNode
    list(i, LINK) = list(prevNode, LINK)
    list(prevNode, LINK) = i

    countNodes = countNodes + 1
    if countNodes = Nodes then Nodes = Nodes + 10 : redim list(Nodes, 3) : end if
end sub

sub removeNode(n)
    local prevNode, node

    prevNode = searchNode(n)
    node = list(prevNode, LINK)
    list(prevNode, LINK) = list(node, LINK)
    list(node, FIL) = false
    countNodes = countNodes - 1
end sub

sub printNode(node)
    local prevNode

    prevNode = searchNode(node)
    node = list(prevNode, LINK)
    print list(node, DATO);
    print
end sub

sub traverseList()
    local i

    for i = 1 to countNodes
        printNode(i)
    next
end sub

insertNode(1, 1000, true)
insertNode(1, 2000, true)
insertNode(1, 3000, true)

traverseList()

removeNode(2)

print
traverseList()


const std = @import("std");

pub fn main() anyerror!void {
    var l1 = LinkedList(i32).init();

    try l1.add(1);
    try l1.add(2);
    try l1.add(4);
    try l1.add(3);

    var h = l1.head;

    while (h) |head| : (h = head.next) {
        std.log.info("> {}", .{ head.value });
    }
}


foreach n in (List(1,2,3) {...}
List(1,2,3).pump(...) // traverse and munge elements, generalized apply/map
List(1,2,3).filter(...)
List(1,2,3).filter22(...) // partition list
List(1,2,3).reduce(...)
List(1,2,3).apply(...)
List(1,2,3).sum()
List(1,2,3).run()  // treat each element as f, perform f()
List(1,2,3).enumerate()
List(1,2,3).reverse()
List(1,2,3).concat()
List(1,2,3).shuffle()


-- This code is a basic implementation of snake in Ada using the command prompt
-- feel free to improve it!

-- Snake.ads
with Ada.Containers; use Ada.Containers;
with Ada.Containers.Vectors;

package Snake is

   -- copy from 2048 game (
   -- Keyboard management
   type directions is (Up, Down, Right, Left, Quit, Restart, Invalid);

   -- Redefining this standard procedure as function to allow Get_Keystroke as an expression function
   function Get_Immediate return Character;

   Arrow_Prefix : constant Character := Character'Val(224); -- works for windows

   function Get_Keystroke return directions;
   -- )

   -- The container for game data
   type gameBoard is array (Natural range <>, Natural range <>) of Character;

   -- Initilize the board
   procedure init;

   -- Run the game
   procedure run;

   -- Displaying the board
   procedure Display_Board;
   -- Clear the board from content
   procedure ClearBoard;

   -- coordinates data structure
   type coord is tagged record
      X,Y : Integer;
   end record;

   -- list of coordinate (one coordinate for each body part of the snake)
   package snakeBody is new Ada.Containers.Vectors (Natural, coord);
   use snakeBody;

   -- update snake's part depending on the snakeDirection and checking colicion (with borders and snak's part)
   function moveSnake return Boolean;

   -- generate food if it was eaten
   procedure generateFood;

   -- Add snake and food to the board
   procedure addDataToBoard;

   -- generate random integer between 1 and upperBound to generate random food position
   function getRandomInteger(upperBound : Integer) return Integer;

private

   width, height : Positive := 10;
   board : gameBoard := (0 .. (width+1) => (0 .. (height+1) => ' '));
   snake : Vector := (1,1) & (2,1) & (3,1);
   snakeDirection : directions := Right;

   food : coord := (5,5);

end Snake;

-- Snake.adb

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Discrete_Random;

package body Snake is

   -----------------------------------------------------------------------------
   -- Redefining this standard procedure as function to allow Get_Keystroke as an expression function (copy from 2048 game)
   function Get_Immediate return Character is
   begin
      return Answer : Character do Ada.Text_IO.Get_Immediate(Answer);
      end return;
   end Get_Immediate;

   -----------------------------------------------------------------------------
   -- (copy from 2048 game)
   function Get_Keystroke return directions is
     (case Get_Immediate is
         when 'Q' | 'q' => Quit,
         when 'R' | 'r' => Restart,
         when 'W' | 'w' => Left,
         when 'A' | 'a' => Up,
         when 'S' | 's' => Down,
         when 'D' | 'd' => Right,
         -- Windows terminal
         when Arrow_Prefix => (case Character'Pos(Get_Immediate) is
                                  when 72 => Up,
                                  when 75 => Left,
                                  when 77 => Right,
                                  when 80 => Down,
                                  when others => Invalid),
         -- Unix escape sequences
         when ASCII.ESC => (case Get_Immediate is
                               when '[' => (case Get_Immediate is
                                               when 'A' => Up,
                                               when 'B' => Down,
                                               when 'C' => Right,
                                               when 'D' => Left,
                                               when others => Invalid),
                               when others => Invalid),
         when others => Invalid);

   -----------------------------------------------------------------------------
   procedure init is
   begin

      for Row in 0 .. width+1 loop
         for Column in 0 .. height+1 loop

            if Row = 0 or Row = width+1 then
               board(Row,Column) := '#';
               --  Insert(board(Row,0), Column, '#');
            else
               if Column = 0 or Column = height+1 then
                  board(Row,Column) := '#';
                  --  Insert(board, board(Row, Column), "#");
               else
                  board(Row,Column) := ' ';
                  --  Insert(board, board(Row, Column), " ");
               end if;
            end if;

         end loop;
      end loop;
   end;

   -----------------------------------------------------------------------------
   procedure run is

      task T;
      task body T is
      begin
         loop
            snakeDirection := Get_Keystroke;
         end loop;
      end T;

   begin

      init;
      loop
         exit when snakeDirection = Quit;

         if moveSnake = False then
            Put_Line("GAME OVER!!!");
            Put_Line("Your score is:" & Length(snake)'Image);
            exit;
         end if;

         Display_Board;
         delay 0.7;

      end loop;
   end run;

   -----------------------------------------------------------------------------
   procedure Display_Board is
   begin

      for Row in 0 .. width+1 loop
         for Column in 0 .. height+1 loop
            Put(board(Row, Column));
         end loop;
         New_Line;
      end loop;

   end Display_Board;

   -----------------------------------------------------------------------------
   procedure ClearBoard is
   begin

      for Row in 1 .. width loop
         for Column in 1 .. height loop
            board(Row, Column) := ' ';
         end loop;
      end loop;

   end ClearBoard;

   -----------------------------------------------------------------------------
   function moveSnake return Boolean is
      colision : Boolean := False;
      headCoord : coord := Snake.First_Element;
      addSnakePart : Boolean := False;
   begin

      case snakeDirection is
         when Up => headCoord.X := headCoord.X - 1;
         when Down => headCoord.X := headCoord.X + 1;
         when Right => headCoord.Y := headCoord.Y + 1;
         when Left => headCoord.Y := headCoord.Y - 1;
         when others => null;
      end case;

      if headCoord.Y = height+1 then
         return False;
      end if;

      if headCoord.Y = 0 then
         return False;
      end if;

      if headCoord.X = width+1 then
         return False;
      end if;

      if headCoord.X = 0 then
         return False;
      end if;

      for index in snake.Iterate loop
         if headCoord = snake(To_Index(index)) then
            return False;
         end if;
      end loop;

      snake.Prepend(headCoord);

      if headCoord /= food then
         snake.Delete_Last;
      else
         food := (0,0);
         generateFood;
      end if;

      addDataToBoard;

      return True;
   end moveSnake;

   -----------------------------------------------------------------------------
   procedure generateFood is
   begin
      if food.X = 0 or food.Y = 0 then
         food := (getRandomInteger(width), getRandomInteger(height));
      end if;
   end generateFood;

   -----------------------------------------------------------------------------
   procedure addDataToBoard is
   begin
      ClearBoard;

      board(food.X, food.Y) := '*';

      for index in snake.Iterate loop
         board(snake(To_Index(index)).X, snake(To_Index(index)).Y) := 'o';
      end loop;

   end addDataToBoard;

   -----------------------------------------------------------------------------
   function getRandomInteger(upperBound : Integer) return Integer is

      subtype Random_Range is Integer range 1 .. upperBound;

      package R is new
        Ada.Numerics.Discrete_Random (Random_Range);
      use R;

      G : Generator;
   begin
      Reset (G);
      return Random (G);
   end getRandomInteger;

end Snake;

-- main.adb

with Snake;

procedure Main is
begin
   Snake.run;
end;


/* Snake */
/* Implementing this task in Hopper-FLOW-MATIC++ */
/* The snake must catch a bite before time runs out, which decreases by
   10 points every 800 milliseconds.
   The remaining time will be added to your total score. */

#include <flow.h>
#include <flow-term.h>
#include <keys.h>

#enum  1,N,E,S,W
#enum  1,SPACE,FOOD,BORDER

DEF-MAIN(argv, argc)
   BREAK-ON
   STACK 16
   CLR-SCR
   MSET(C, quit, nHead, dir, Size, SCORE, counter, T,TPlay,ConsPrey )
   SET( symbol, " [email protected]" )

   SET( w, 50 ) //50
   SET( h, 28 ) // 24
   SET( TIME, 100 )
   LET( Size :=  MUL(w,h) )
   SET( TLimit := 100 )
   VOID( big number, numL1, numL2, numL3 )
   GOSUB( set score )

   DIM( Size ) AS-ONES( board )
   HIDE-CURSOR

   GOSUB( put titles )
   GOSUB( start )
   GOSUB( show )
   GOSUB( ready ), SLEEP(3)
   TIC( T ), TIC( TPlay )
   WHILE( NOT (quit) )
      DEVIATE-IF( TLimit ~= TPlay ){
         GOSUB( show )
         WHEN( KEY-PRESSED? ){
            SCAN-CODE( C )
            SWITCH( C )
               CASE( K_UP )   { dir = N, EXIT }
               CASE( K_RIGHT ){ dir = E, EXIT }
               CASE( K_DOWN ) { dir = S, EXIT }
               CASE( K_LEFT ) { dir = W, EXIT }
               CASE( K_ESC )  { quit = 1, EXIT }
               CASE( 32 )  { PAUSE, EXIT }
            SWEND
         }
         GOSUB( step )
      }
      DEVIATE-IF( 800 ~= T ) {
         TIME-=10, CLAMP(0,100,TIME)
         {TIME, 12, 52} GOSUB( put time )
      }
   WEND
   GOSUB(you lost),   SLEEP(1)
   GOSUB(game over ), SLEEP(2)
   LOCATE(ADD(h,1),1) PRNL
   SHOW-CURSOR
   PRNL
END

RUTINES

// initialize the board, plant a very first food item
DEF-FUN( start )
   SET( i,1 )

   [1:w]                               {BORDER} CPUT(board)  // top
   [ SUB(MUL(h,w),MINUS-ONE(w)) : end] {BORDER} CPUT(board) // bottom
   [1:w:end]                           {BORDER} CPUT(board)  // left

   SET(i, 1)
   FOR( LE?(i, h), ++i )
      [ MUL(i, w )]                    {BORDER} PUT(board)  // right
   NEXT
   LET( nHead := MUL( w, SUB( SUB( h, 1 ), MOD(h,2) )) DIV-INTO(2) )
   [ nHead ] {-5} CPUT( board )
   LET( dir := N )
   SRAND( ~SECONDS)
   GOSUB( plant )
RET

DEF-FUN( you lost )
   SET(i,1), SET(k,0), SET(n,1)
   LOCATE(1,1)
   FOR( LE?(i, h), ++i)
      SET(j,1)
      FOR( LE?(j, w), ++j)
         LET( k := [ n ] GET(board) )
         COND( IS-NEG?( k ))
             LOCATE(i,j)
             PRNL("\033[38;15;3m\033[48;5;9m~\OFF")
         CEND
         ++n
      NEXT
   NEXT
RET

DEF-FUN( show )
   SET(i,1)
   MSET(j, k)

   SET(n,1)
   LOCATE(1,1)
   FOR( LE?(i, h), ++i)
      SET(j,1),
      FOR( LE?(j, w), ++j)
         LET( k := [ n ] GET(board) )
         COND( IS-NEG?( k ))
            PRN("\033[38;5;3m\033[48;5;15m~\OFF")
         ELS-COND( {k} IS-EQ?(BORDER))
               {"\033[38;5;4m\033[48;5;2m"}
               PRN( [k] GET(symbol),"\OFF")
         ELS-COND( {k}IS-EQ?(FOOD) )
               {"\033[38;5;15m\033[48;5;9m"}
               PRN( [k] GET(symbol),"\OFF")
         ELS
               {"\033[48;5;28m"}
               PRN( [k] GET(symbol),"\OFF")
         CEND
         ++n
      NEXT
      PRNL
   NEXT
RET

// negative values denote the snake (a negated time-to-live in given cell)

// reduce a time-to-live, effectively erasing the tail
DEF-FUN( age )

   MSET( r, jAge, jR )
   CART( IS-NEG?( board ) ) »» (r), SET-RANGE(r)

   GET( board ) PLUS(1) »» (jAge)
  // this is necessary, because Hopper arrays begining in 1
   CART( IS-ZERO?(jAge) ) »» (jR)
   COND( IS-ARRAY?(jR) )
      SET-RANGE(jR), SET(jAge, 1), SET-RANGE(r)
   CEND
  // ******
   {jAge} PUT(board), CLR-RANGE
RET

DEF-FUN( step )
   SET(len,0)
   LET( len := [nHead] GET(board) )
   SWITCH(dir)
      CASE (N){ nHead -= w, EXIT }
      CASE (S){ nHead += w, EXIT }
      CASE (W){ --nHead, EXIT }
      CASE (E){ ++nHead, EXIT }
   SWEND
   SWITCH( [nHead]CGET(board))
      CASE (SPACE){
          --len, LET( len := IF( IS-ZERO?(len), 1, len) )
          [nHead] { len }, CPUT(board) // keep in mind len is negative
          GOSUB( age )
          EXIT
      }
      CASE (FOOD){
          --len, LET( len := IF( IS-ZERO?(len), 1, len) )
          [nHead] { len }, CPUT(board)
          GOSUB( plant )
          ADD(SCORE,TIME), MOVE-TO(SCORE)

          {SCORE, 4, 52} GOSUB( put score )
          LET( TIME := 100 )
          ++counter, COND( GT?( counter, 5 ) )
                        LET( TLimit := SUB( TLimit,5 ))
                        CLAMP(30,100,TLimit)
                        LET( counter := 0 )
                     CEND
          ++ConsPrey
          COLOR-FG(10)
          LOCATE(20,52) PRNL("SPEED: ")
          LOC-ROW(21),  SET-ROUND(2)
                        PRNL( MUL(INV(TLimit),100), " M/S" )
                        SET-ROUND(-1)
          LOC-ROW(23)   PRNL("CONSUMED PREY:")
          LOC-ROW(24)   PRNL(ConsPrey,"\OFF")

          TIC( T ),{TIME, 12, 52} GOSUB( put time )
          EXIT
      }
      LET( quit := 1 )

   SWEND
RET

// put a piece of food at random empty position
DEF-FUN( plant )
   SET(r, 0)
   LOOP( search position )
      LET( r := MOD( CEIL(RAND(MINUS-ONE(Size))), Size ) )
   BACK-IF-NOT-EQ( [r] GET(board), SPACE, search position)
   [r] {FOOD} CPUT( board )
RET

DEF-FUN( put titles )
   LOCATE(2,52)   PRNL("\033[38;5;15mSCORE\OFF")
   {SCORE, 4, 52} GOSUB( put score )
   LOCATE(10,52)  PRNL("\033[38;5;11mTIME\OFF")
   {TIME, 12, 52} GOSUB( put time )

   COLOR-FG(15)
   LOCATE(26,52) SET-ITALIC, PRNL("  S P E E D")
   LOC-ROW(27)               PRNL("S N A K E!\OFF")
RET

DEF-FUN( put time, B, posx, posy )
   MSET( i,j,x )
   MSET( sb, lsb,nB, p4 )
   SET( k,1 )

   LOCATE (posx, posy) FILL-BOX(" ",5,20)
   LET( sb := STR(B) )
   LET( lsb := LEN(sb) )
   SET( rx, posy )
   LET( p4 := ADD( posx, 4 ))

   {"\033[38;5;11m\ENF"}
   PERF-UP(k, lsb, 1)
      LET( nB := VAL( MID( 1, k, sb )) )
      SET(x, 1), SET( i, posx )
      FOR( LE?(i, p4), ++i )
         SET( j, rx )
         FOR( LE?(j, ADD( rx, 2 ) ), ++j )
            LOCATE(i, j) PRNL( STR-TO-UTF8(CHAR( [ PLUS-ONE(nB), x] CGET(big number) MUL-BY(219) )))
            ++x
         NEXT
       NEXT
       rx += 4
   NEXT
   PRNL("\OFF")
RET

DEF-FUN( put score, SCORE, posx, posy )
    MSET( ln,s, sp )

    LET( sp := STR( SCORE ))
    LET( ln := LEN(sp))

    LOCATE ( posx, posy ) FILL-BOX(" ",4,20)
    SET(i, 1)
    {"\033[38;5;15m"}
    PERF-UP( i, ln, 1)
       LET( s := VAL( MID( 1, i, sp )) )
       [ PLUS-ONE(s) ]   // set interval to read element of arrays
       LOCATE( posx, posy )
       PRNL ( STR-TO-UTF8( GET(numL1) ))
       LOCATE( PLUS-ONE(posx),posy )
       PRNL ( STR-TO-UTF8( GET(numL2) ))
       LOCATE( PLUS-TWO(posx),posy )
       PRNL ( STR-TO-UTF8( GET(numL3) ))
       posy += 2
    NEXT
    PRNL("\OFF")
RET

DEF-FUN( set score )

   {"┌┐"," ┐","┌┐","┌┐","┐┐","┌┐","┌┐","┌┐","┌┐","┌┐"} APND-LST(numL1)
   {"││"," │","┌┘"," ┤","└┤","└┐","├┐"," │","├┤","└┤"} APND-LST(numL2)
   {"└┘"," ┴","└┘","└┘"," ┘","└┘","└┘"," ┴","└┘","└┘"} APND-LST(numL3)

   {1,1,1,1,0,1,1,0,1,1,0,1,1,1,1} APND-ROW( big number )
   {1,1,0,0,1,0,0,1,0,0,1,0,1,1,1} APND-ROW( big number )
   {1,1,1,0,0,1,1,1,1,1,0,0,1,1,1} APND-ROW( big number )
   {1,1,1,0,0,1,0,1,1,0,0,1,1,1,1} APND-ROW( big number )
   {1,0,1,1,0,1,1,1,1,0,0,1,0,0,1} APND-ROW( big number )
   {1,1,1,1,0,0,1,1,1,0,0,1,1,1,1} APND-ROW( big number )
   {1,0,0,1,0,0,1,1,1,1,0,1,1,1,1} APND-ROW( big number )
   {1,1,1,0,0,1,0,0,1,0,0,1,0,0,1} APND-ROW( big number )
   {1,1,1,1,0,1,1,1,1,1,0,1,1,1,1} APND-ROW( big number )
   {1,1,1,1,0,1,1,1,1,0,0,1,0,0,1} APND-ROW( big number )

RET

DEF-FUN( ready )
   {"\033[38;5;4m\033[48;5;11m"}
   LOC-COL(16)
   LOC-ROW(13); PRNL( STR-TO-UTF8("  ▄   ▄▄  ▄  ▄▄  ▄ ▄ "))
   LOC-ROW(14); PRNL( STR-TO-UTF8(" █▄▀ █▀  █▄█ █ █ ▀▄▀ "))
   LOC-ROW(15); PRNL( STR-TO-UTF8(" ▀ ▀  ▀▀ ▀ ▀ ▀▄▀  ▀  "))
   PRNL("\OFF")
RET

DEF-FUN( game over )
    {"\033[38;5;15m\033[48;5;9m"}
    LOC-COL(17)
    LOC-ROW(12); PRNL( STR-TO-UTF8("  ▄▄  ▄   ▄ ▄   ▄▄ "))
    LOC-ROW(13); PRNL( STR-TO-UTF8(" █ ▄ █▄█ █ █ █ █▀  "))
    LOC-ROW(14); PRNL( STR-TO-UTF8("  ▀▀ ▀ ▀ ▀ ▀ ▀  ▀▀ "))
    LOC-ROW(15); PRNL( STR-TO-UTF8("   ▄  ▄ ▄  ▄▄  ▄   "))
    LOC-ROW(16); PRNL( STR-TO-UTF8("  █ █ █ █ █▀  █▄▀  "))
    LOC-ROW(17); PRNL( STR-TO-UTF8("   ▀   ▀   ▀▀ ▀ ▀  "))
    PRNL("\OFF")
RET


gosub Init
Gui, +AlwaysOnTop
Gui, font, s12, consolas
Gui, add, Edit, vEditGrid x10 y10 ReadOnly, % grid2Text(oGrid)
Gui, add, Text, vScore x10 y+10 w200 ReadOnly, % "Your Score = " Score
Gui, show,, Snake
GuiControl, Focus, Score
return
;-----------------------------------------
Init:
Width := 100, Height := 30			; set grid size
tail := 20, step := 10
Timer := 75
item := 0, direction := ""
oTrail := [], Score := 0
xx := generateGrid(width, Height)
oGrid := xx.1
row := xx.2, col := xx.3
return
;-----------------------------------------
Move:
if !item
{
	loop
	{
		Random, itemC, 3, % width-2
		Random, itemR, 3, % Height-2
	}
	until, !oGrid[itemR, itemC]
	oGrid[itemR, itemC] := "@"
	item := true
}
gosub, crawl
return
;-----------------------------------------
#IfWinActive, Snake
left::
Right::
up::
Down::
if ((A_ThisHotkey = "right") 	&& (Direction = "left"))
|| ((A_ThisHotkey = "left") 	&& (Direction = "right"))
|| ((A_ThisHotkey = "up") 		&& (Direction = "Down"))
|| ((A_ThisHotkey = "Down") 	&& (Direction = "up"))
|| ((A_ThisHotkey = "right") 	&& (Direction = "right"))
|| ((A_ThisHotkey = "left") 	&& (Direction = "left"))
|| ((A_ThisHotkey = "up") 		&& (Direction = "up"))
|| ((A_ThisHotkey = "Down") 	&& (Direction = "Down"))
	return

Direction := A_ThisHotkey
gosub, crawl
return
#IfWinActive
;-----------------------------------------
crawl:
switch, Direction
{
	case "left"	:	oGrid[row  , col--] := 1
	case "Right"	:	oGrid[row  , col++] := 1
	case "up" 	:	oGrid[row--, col  ] := 1
	case "Down"	:	oGrid[row++, col  ] := 1
}

; out of bounds or snake eats itself
if oGrid[row, col] = 1 || col < 1 || col > width || row < 1 || row > height
	gosub, YouLose

; snake eats item
if (oGrid[row, col] = "@")
{
	item := false
	tail += step
	GuiControl,, Score, % "Your Score = " ++Score
}

; snake advances
oGrid[row, col] := 2
oTrail.Push(row "," col)
if (oTrail.count() >= tail)
	x := StrSplit(oTrail.RemoveAt(1), ","),		oGrid[x.1, x.2] := false

GuiControl,, EditGrid, % grid2Text(oGrid)
SetTimer, Move, % 0-Timer
return
;-----------------------------------------
YouLose:
SetTimer, Move, Off
MsgBox, 262180, ,% "Your Score is " Score "`nPlay Again?"
IfMsgBox, No
	ExitApp

gosub Init
GuiControl,, EditGrid, % grid2Text(oGrid)
return
;-----------------------------------------
grid2Text(oGrid){
	for row, obj in oGrid	{
		for col, val in obj		; @=item, 2=Head, 1=tail
			text .=  val = "@" ? "@" : val =2 ? "█" : val = 1 ? "▓" : " "
		text .= "`n"
	}
	return trim(text, "`n")
}
;-----------------------------------------
generateGrid(width, Height){
	global oTrail
	oGrid := []
	loop, % width
	{
		col := A_Index
		loop, % Height
			row := A_Index, oGrid[row, col] := false
	}
	Random, col, 3, % width-2
	Random, row, 3, % Height-2
	oGrid[row, col] := 2
	oTrail.Push(row "," col)
	return [oGrid, row, col]
}
;-----------------------------------------


REM Snake

#define EXTCHAR Chr(255)

Dim Shared As Integer puntos, contar, longitud, posX, posY, oldhi = 0
Dim Shared As Integer x(500), y(500)
For contar = 1 To 500
    x(contar) = 0 : y(contar) = 0
Next contar
Dim Shared As Byte fruitX, fruitY, convida
Dim Shared As Single delay
Dim Shared As String direccion, usuario

Sub Intro
    Cls
    Color 15, 0
    Print "              _    _    _    _               "
    Print "             / \  / \  / \  / \              "
    Print " ___________/  _\/  _\/  _\/  _\____________ "
    Print " __________/  /_/  /_/  /_/  /______________ "
    Print "           | /\   /\   /\   / \ \___         "
    Print "           |/  \_/  \_/  \_/   \   "+Chr(248)+"\        "
    Print "                                \___/--<     "
    Color 14, 0
    Locate 10, 28: Print "---SNAKE---"
    Locate 12, 4: Print "Para jugar, usa las teclas de flecha para moverte."
    Locate 13, 4: Print "Pulsa <1-3> para velocidad, o <Esc> para salir."
    If puntos > oldhi Then oldhi = puntos
    Locate 14, 4: Print "M xima puntuaci¢n: "; oldhi
    usuario = ""
    While usuario = ""
        usuario = Inkey
    Wend
    If usuario = Chr(27) Then End 'ESC
    delay = .14
    If usuario = "1" Then delay = .26
    If usuario = "3" Then delay = .08
    Cls
    longitud = 9
    puntos = 0
    posX = 40 : posY = 10
    direccion = "derecha"
    convida = true
    fruitX = Int(Rnd * 79) + 1
    fruitY = Int(Rnd * 20) + 1
    Locate 22, 1
    For contar = 1 To 80
        Print Chr(196); ''"-";
    Next contar
End Sub

Sub MenuPrincipal
    Dim As Integer num, oldX, oldY
    Dim As Single tm, tm2

    Color 10
    Locate 23, 2: Print "SNAKE - <Esc> salir - Puntos: "; puntos
    If posX = fruitX And posY = fruitY Then
        longitud += 1
        puntos += 1
        fruitX = Int(Rnd * 79) + 1
        fruitY = Int(Rnd * 21) + 1
    End If
    Locate fruitY, fruitX : Color 12: Print Chr(01) : Color 10'"@"
    x(0) = posX : y(0) = posY

    For contar = 1 To 499
        num = 500 - contar
        x(num) = x(num - 1)
        y(num) = y(num - 1)
    Next contar

    oldX = x(longitud) : oldY = y(longitud)
    If oldX > 0 And oldY > 0 Then Locate oldY, oldX : Print " "

    Locate posY, posX: Print Chr(219) '"Û"
    tm = Timer
    tm2 = tm + delay
    While tm < tm2
        tm = Timer
        usuario = Inkey
        If usuario = EXTCHAR & "H" Then direccion = "arriba"
        If usuario = EXTCHAR & "P" Then direccion = "abajo"
        If usuario = EXTCHAR & "K" Then direccion = "izquierda"
        If usuario = EXTCHAR & "M" Then direccion = "derecha"
        If usuario = Chr(27) Then Intro
    Wend
    If direccion = "derecha" Then posX += 1
    If posX > 80 Then convida = false
    If direccion = "izquierda" Then posX -= 1
    If posX < 1 Then convida = false
    If direccion = "arriba" Then posY -= 1
    If posY < 1 Then convida = false
    If direccion = "abajo" Then posY += 1
    If posY > 21 Then convida = false

    For contar = 0 To longitud
        If posX = x(contar) And posY = y(contar) Then convida = false
    Next contar

    If convida = false Then
        Cls : Locate 11, 19: Print "Pulsa <space>..."
        Locate 10, 18: Print "Has muerto! Con"; puntos; " puntos." : Sleep
        While Inkey = "": Wend
        Intro
    End If
    MenuPrincipal
End Sub

'--- Programa Principal ---
Randomize Timer
Intro
MenuPrincipal
End
'--------------------------


// Snake

// The problem with implementing this task in C is, the language standard
// does not cover some details essential for interactive games:
// a nonblocking keyboard input, a positional console output,
// a and millisecond-precision timer: these things are all system-dependent.

// Therefore the program is split in two pieces, a system-independent
// game logic, and a system-dependent UI, separated by a tiny API:
char nonblocking_getch();
void positional_putch(int x, int y, char ch);
void millisecond_sleep(int n);
void init_screen();
void update_screen();
void close_screen();

// The implementation of a system-dependent part.
// Requires POSIX IEEE 1003.1-2008 compliant system and ncurses library.
#ifdef __linux__
#define _POSIX_C_SOURCE 200809L
#include <time.h> // nanosleep
#include <ncurses.h> // getch, mvaddch, and others
char nonblocking_getch() { return getch(); }
void positional_putch(int x, int y, char ch) { mvaddch(x, y, ch); }
void millisecond_sleep(int n) {
	struct timespec t = { 0, n * 1000000 };
	nanosleep(&t, 0);
	// for older POSIX standards, consider usleep()
}
void update_screen() { refresh(); }
void init_screen() {
	initscr();
	noecho();
	cbreak();
	nodelay(stdscr, TRUE);
}
void close_screen() { endwin(); }
#endif

// An implementation for some other system...
#ifdef _WIN32
#error "not implemented"
#endif

// The game logic, system-independent
#include <time.h> // time
#include <stdlib.h> // rand, srand

#define w 80
#define h 40

int board[w * h];
int head;
enum Dir { N, E, S, W } dir;
int quit;

enum State { SPACE=0, FOOD=1, BORDER=2 };
// negative values denote the snake (a negated time-to-live in given cell)

// reduce a time-to-live, effectively erasing the tail
void age() {
        int i;
	for(i = 0; i < w * h; ++i)
		if(board[i] < 0)
			++board[i];
}

// put a piece of food at random empty position
void plant() {
	int r;
	do
		r = rand() % (w * h);
	while(board[r] != SPACE);
	board[r] = FOOD;
}

// initialize the board, plant a very first food item
void start(void) {
        int i;
	for(i = 0; i < w; ++i)
		board[i] = board[i + (h - 1) * w] = BORDER;
	for(i = 0; i < h; ++i)
		board[i * w] = board[i * w + w - 1] = BORDER;
	head = w * (h - 1 - h % 2) / 2; // screen center for any h
	board[head] = -5;
	dir = N;
	quit = 0;
	srand(time(0));
	plant();
}

void step() {
	int len = board[head];
	switch(dir) {
		case N: head -= w; break;
		case S: head += w; break;
		case W: --head; break;
		case E: ++head; break;
	}
	switch(board[head]) {
		case SPACE:
			board[head] = len - 1; // keep in mind len is negative
			age();
			break;
		case FOOD:
			board[head] = len - 1;
			plant();
			break;
		default:
			quit = 1;
	}
}

void show() {
	const char * symbol = " @.";
        int i;
	for(i = 0; i < w * h; ++i)
		positional_putch(i / w, i % w,
			board[i] < 0 ? '#' : symbol[board[i]]);
	update_screen();
}

int main (int argc, char * argv[]) {
	init_screen();
	start();
	do {
		show();
		switch(nonblocking_getch()) {
			case 'i': dir = N; break;
			case 'j': dir = W; break;
			case 'k': dir = S; break;
			case 'l': dir = E; break;
			case 'q': quit = 1; break;
		}
		step();
		millisecond_sleep(100); // beware, this approach
		// is not suitable for anything but toy projects like this
	}
	while(!quit);
	millisecond_sleep(999);
	close_screen();
	return 0;
}


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

const int WID = 60, HEI = 30, MAX_LEN = 600;
enum DIR { NORTH, EAST, SOUTH, WEST };

class snake {
public:
    snake() {
        console = GetStdHandle( STD_OUTPUT_HANDLE ); SetConsoleTitle( "Snake" );
        COORD coord = { WID + 1, HEI + 2 }; SetConsoleScreenBufferSize( console, coord );
        SMALL_RECT rc = { 0, 0, WID, HEI + 1 }; SetConsoleWindowInfo( console, TRUE, &rc );
        CONSOLE_CURSOR_INFO ci = { 1, false }; SetConsoleCursorInfo( console, &ci );
    }
    void play() {
        std::string a;
        while( 1 ) {
            createField(); alive = true;
            while( alive ) { drawField(); readKey(); moveSnake(); Sleep( 50 ); }
            COORD c = { 0, HEI + 1 }; SetConsoleCursorPosition( console, c );
            SetConsoleTextAttribute( console, 0x000b );
            std::cout << "Play again [Y/N]? "; std::cin >> a;
            if( a.at( 0 ) != 'Y' && a.at( 0 ) != 'y' ) return;
        }
    }
private:
    void createField() {
        COORD coord = { 0, 0 }; DWORD c;
        FillConsoleOutputCharacter( console, ' ', ( HEI + 2 ) * 80, coord, &c );
        FillConsoleOutputAttribute( console, 0x0000, ( HEI + 2 ) * 80, coord, &c );
        SetConsoleCursorPosition( console, coord );
        int x = 0, y = 1; for( ; x < WID * HEI; x++ ) brd[x] = 0;
        for( x = 0; x < WID; x++ ) {
            brd[x] = brd[x + WID * ( HEI - 1 )] = '+';
        }
        for( ; y < HEI; y++ ) {
            brd[0 + WID * y] = brd[WID - 1 + WID * y] = '+';
        }
        do {
            x = rand() % WID; y = rand() % ( HEI >> 1 ) + ( HEI >> 1 );
        } while( brd[x + WID * y] );
        brd[x + WID * y] = '@';
        tailIdx = 0; headIdx = 4; x = 3; y = 2;
        for( int c = tailIdx; c < headIdx; c++ ) {
            brd[x + WID * y] = '#';
            snk[c].X = 3 + c; snk[c].Y = 2;
        }
        head = snk[3]; dir = EAST; points = 0;
    }
    void readKey() {
        if( GetAsyncKeyState( 39 ) & 0x8000 ) dir = EAST;
        if( GetAsyncKeyState( 37 ) & 0x8000 ) dir = WEST;
        if( GetAsyncKeyState( 38 ) & 0x8000 ) dir = NORTH;
        if( GetAsyncKeyState( 40 ) & 0x8000 ) dir = SOUTH;
    }
    void drawField() {
        COORD coord; char t;
        for( int y = 0; y < HEI; y++ ) {
            coord.Y = y;
            for( int x = 0; x < WID; x++ ) {
                t = brd[x + WID * y]; if( !t ) continue;
                coord.X = x; SetConsoleCursorPosition( console, coord );
                if( coord.X == head.X && coord.Y == head.Y ) {
                    SetConsoleTextAttribute( console, 0x002e );
                    std::cout << 'O'; SetConsoleTextAttribute( console, 0x0000 );
                    continue;
                }
                switch( t ) {
                    case '#': SetConsoleTextAttribute( console, 0x002a ); break;
                    case '+': SetConsoleTextAttribute( console, 0x0019 ); break;
                    case '@': SetConsoleTextAttribute( console, 0x004c ); break;
                }
                std::cout << t; SetConsoleTextAttribute( console, 0x0000 );
            }
        }
        std::cout << t; SetConsoleTextAttribute( console, 0x0007 );
        COORD c = { 0, HEI }; SetConsoleCursorPosition( console, c );
        std::cout << "Points: " << points;
    }
    void moveSnake() {
        switch( dir ) {
            case NORTH: head.Y--; break;
            case EAST: head.X++; break;
            case SOUTH: head.Y++; break;
            case WEST: head.X--; break;
        }
        char t = brd[head.X + WID * head.Y];
        if( t && t != '@' ) { alive = false; return; }
        brd[head.X + WID * head.Y] = '#';
        snk[headIdx].X = head.X; snk[headIdx].Y = head.Y;
        if( ++headIdx >= MAX_LEN ) headIdx = 0;
        if( t == '@' ) {
            points++; int x, y;
            do {
                x = rand() % WID; y = rand() % ( HEI >> 1 ) + ( HEI >> 1 );
            } while( brd[x + WID * y] );
            brd[x + WID * y] = '@'; return;
        }
        SetConsoleCursorPosition( console, snk[tailIdx] ); std::cout << ' ';
        brd[snk[tailIdx].X + WID * snk[tailIdx].Y] = 0;
        if( ++tailIdx >= MAX_LEN ) tailIdx = 0;
    }
    bool alive; char brd[WID * HEI];
    HANDLE console; DIR dir; COORD snk[MAX_LEN];
    COORD head; int tailIdx, headIdx, points;
};
int main( int argc, char* argv[] ) {
    srand( static_cast<unsigned>( time( NULL ) ) );
    snake s; s.play(); return 0;
}


unit SnakeGame;

interface

uses
  Winapi.Windows, System.SysUtils,
  System.Classes, Vcl.Graphics, Vcl.Forms, Vcl.Dialogs,
  System.Generics.Collections, Vcl.ExtCtrls;

type
  TSnakeApp = class(TForm)
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DoFrameStep(Sender: TObject);
    procedure Reset;
  private
    { Private declarations }
    FrameTimer: TTimer;
  public
    { Public declarations }
  end;

  TSnake = class
    len: Integer;
    alive: Boolean;
    pos: TPoint;
    posArray: TList<TPoint>;
    dir: Byte;
  private
    function Eat(Fruit: TPoint): Boolean;
    function Overlap: Boolean;
    procedure update;
  public
    procedure Paint(Canvas: TCanvas);
    procedure Reset;
    constructor Create;
    destructor Destroy; override;
  end;

  TFruit = class
    FruitTime: Boolean;
    pos: TPoint;
    constructor Create;
    procedure Reset;
    procedure Paint(Canvas: TCanvas);
  private
    procedure SetFruit;
  end;

const
  L = 1;
  R = 2;
  D = 4;
  U = 8;

var
  SnakeApp: TSnakeApp;
  block: Integer = 24;
  wid: Integer = 30;
  hei: Integer = 20;
  fruit: TFruit;
  snake: TSnake;

implementation

{$R *.dfm}

function Rect(x, y, w, h: Integer): TRect;
begin
  Result := TRect.Create(x, y, x + w, y + h);
end;

{ TSnake }

constructor TSnake.Create;
begin
  posArray := TList<TPoint>.Create;
  Reset;
end;

procedure TSnake.Paint(Canvas: TCanvas);
var
  pos: TPoint;
  i, l: Integer;
  r: TRect;
begin
  with Canvas do
  begin
    Brush.Color := rgb(130, 190, 0);

    i := posArray.count - 1;
    l := posArray.count;
    while True do
    begin
      pos := posArray[i];
      dec(i);
      r := rect(pos.x * block, pos.y * block, block, block);
      FillRect(r);
      dec(l);
      if l = 0 then
        Break;
    end;
  end;
end;

procedure TSnake.Reset;
begin
  alive := true;
  pos := Tpoint.Create(1, 1);
  posArray.Clear;
  posArray.Add(Tpoint.Create(pos));
  len := posArray.Count;
  dir := r;
end;

destructor TSnake.Destroy;
begin
  posArray.Free;
  inherited;
end;

function TSnake.Eat(Fruit: TPoint): Boolean;
begin
  result := (pos.X = Fruit.X) and (pos.y = Fruit.y);
  if result then
  begin
    inc(len);
    if len > 5000 then
      len := 500;
  end;
end;

function TSnake.Overlap: Boolean;
var
  aLen: Integer;
  tp: TPoint;
  i: Integer;
begin
  aLen := posArray.count - 1;

  for i := 0 to aLen - 1 do
  begin
    tp := posArray[i];
    if (tp.x = pos.x) and (tp.y = pos.y) then
      Exit(True);
  end;
  Result := false;
end;

procedure TSnake.update;
begin
  if not alive then
    exit;
  case dir of
    l:
      begin
        dec(pos.X);
        if pos.X < 1 then
          pos.x := wid - 2
      end;
    r:
      begin
        inc(pos.x);
        if (pos.x > (wid - 2)) then
          pos.x := 1;
      end;
    U:
      begin
        dec(pos.y);

        if (pos.y < 1) then
          pos.y := hei - 2
      end;
    D:
      begin
        inc(pos.y);

        if (pos.y > hei - 2) then
          pos.y := 1;
      end;
  end;
  if Overlap then
    alive := False
  else
  begin
    posArray.Add(TPoint(pos));

    if len < posArray.Count then
      posArray.Delete(0);
  end;
end;

{ TFruit }

constructor TFruit.Create;
begin
  Reset;
end;

procedure TFruit.Paint(Canvas: TCanvas);
var
  r: TRect;
begin
  with Canvas do
  begin
    Brush.Color := rgb(200, 50, 20);

    r := Rect(pos.x * block, pos.y * block, block, block);

    FillRect(r);
  end;
end;

procedure TFruit.Reset;
begin
  fruitTime := true;
  pos := Tpoint.Create(0, 0);
end;

procedure TFruit.SetFruit;
begin
  pos.x := Trunc(Random(wid - 2) + 1);
  pos.y := Trunc(Random(hei - 2) + 1);
  fruitTime := false;
end;

procedure TSnakeApp.DoFrameStep(Sender: TObject);
begin
  Invalidate;
end;

procedure TSnakeApp.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FrameTimer.Free;
  snake.Free;
  Fruit.Free;
end;

procedure TSnakeApp.FormCreate(Sender: TObject);
begin
  Canvas.pen.Style := psClear;
  ClientHeight := block * hei;
  ClientWidth := block * wid;
  DoubleBuffered := True;
  KeyPreview := True;

  OnClose := FormClose;
  OnKeyDown := FormKeyDown;
  OnPaint := FormPaint;

  snake := TSnake.Create;
  Fruit := TFruit.Create();
  FrameTimer := TTimer.Create(nil);
  FrameTimer.Interval := 250;
  FrameTimer.OnTimer := DoFrameStep;
  FrameTimer.Enabled := True;
end;

procedure TSnakeApp.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

  function ValidDir(value: Byte): Byte;
  var
    combination: Byte;
  begin
    combination := (value or snake.dir);
    if (combination = 3) or (combination = 12) then
      Result := snake.dir
    else
      Result := value;
  end;

begin
  case Key of
    VK_LEFT:
      snake.dir := ValidDir(l);
    VK_RIGHT:
      snake.dir := ValidDir(r);
    VK_UP:
      snake.dir := ValidDir(U);
    VK_DOWN:
      snake.dir := ValidDir(D);
    VK_ESCAPE:
      Reset;
  end;
end;

procedure TSnakeApp.FormPaint(Sender: TObject);
var
  i: Integer;
  r: TRect;
  frameR: Double;
begin
  with Canvas do
  begin
    Brush.Color := rgb(0, $22, 0);
    FillRect(ClipRect);
    Brush.Color := rgb(20, 50, 120);

    for i := 0 to wid - 1 do
    begin
      r := rect(i * block, 0, block, block);
      FillRect(r);
      r := rect(i * block, ClientHeight - block, block, block);
      FillRect(r);
    end;

    for i := 1 to hei - 2 do
    begin
      r := Rect(1, i * block, block, block);
      FillRect(r);
      r := Rect(ClientWidth - block, i * block, block, block);
      FillRect(r);
    end;

    if (Fruit.fruitTime) then
    begin
      Fruit.setFruit();
      frameR := FrameTimer.Interval * 0.95;
      if frameR < 30 then
        frameR := 30;
      FrameTimer.Interval := trunc(frameR);
    end;

    Fruit.Paint(Canvas);
    snake.update();

    if not snake.alive then
    begin
      FrameTimer.Enabled := False;
      Application.ProcessMessages;
      ShowMessage('Game over');
      Reset;
      exit;
    end;

    if (snake.eat(Fruit.pos)) then
      Fruit.fruitTime := true;
    snake.Paint(Canvas);

    Brush.Style := bsClear;
    Font.Color := rgb(200, 200, 200);
    Font.Size := 18;
    TextOut(50, 0, (snake.len - 1).ToString);
  end;
end;

procedure TSnakeApp.Reset;
begin
  snake.Reset;
  Fruit.Reset;
  FrameTimer.Interval := 250;
  FrameTimer.Enabled := True;
end;
end.