tritValues = .array~of(.trit~true, .trit~false, .trit~maybe)
tab = '09'x

say "not operation (\)"
loop a over tritValues
    say "\"a":" (\a)
end

say
say "and operation (&)"
loop aa over tritValues
    loop bb over tritValues
        say (aa" & "bb":" (aa&bb))
    end
end

say
say "or operation (|)"
loop aa over tritValues
    loop bb over tritValues
        say (aa" | "bb":" (aa|bb))
    end
end

say
say "implies operation (&&)"
loop aa over tritValues
    loop bb over tritValues
        say (aa" && "bb":" (aa&&bb))
    end
end

say
say "equals operation (=)"
loop aa over tritValues
    loop bb over tritValues
        say (aa" = "bb":" (aa=bb))
    end
end

::class trit
-- making this a private method so we can control the creation
-- of these.  We only allow 3 instances to exist
::method new class private
  forward class(super)

::method init class
  expose true false maybe
  -- delayed creation
  true = .nil
  false = .nil
  maybe = .nil

-- read only attribute access to the instances.
-- these methods create the appropriate singleton on the first call
::attribute true class get
  expose true
  if true == .nil then true = self~new("True")
  return true

::attribute false class get
  expose false
  if false == .nil then false = self~new("False")
  return false

::attribute maybe class get
  expose maybe
  if maybe == .nil then maybe = self~new("Maybe")
  return maybe

-- create an instance
::method init
  expose value
  use arg value

-- string method to return the value of the instance
::method string
  expose value
  return value

-- "and" method using the operator overload
::method "&"
  use strict arg other
  if self == .trit~true then return other
  else if self == .trit~maybe then do
      if other == .trit~false then return .trit~false
      else return .trit~maybe
  end
  else return .trit~false

-- "or" method using the operator overload
::method "|"
  use strict arg other
  if self == .trit~true then return .trit~true
  else if self == .trit~maybe then do
      if other == .trit~true then return .trit~true
      else return .trit~maybe
  end
  else return other

-- implies method...using the XOR operator for this
::method "&&"
  use strict arg other
  if self == .trit~true then return other
  else if self == .trit~maybe then do
      if other == .trit~true then return .trit~true
      else return .trit~maybe
  end
  else return .trit~true

-- "not" method using the operator overload
::method "\"
  if self == .trit~true then return .trit~false
  else if self == .trit~maybe then return .trit~maybe
  else return .trit~true

-- "equals" using the "=" override.  This makes a distinction between
-- the "==" operator, which is real equality and the "=" operator, which
-- is trinary equality.
::method "="
  use strict arg other
  if self == .trit~true then return other
  else if self == .trit~maybe then return .trit~maybe
  else return \other


Program TernaryLogic (output);

type
  trit = (terTrue, terMayBe, terFalse);

function terNot (a: trit): trit;
  begin
    case a of
      terTrue:  terNot := terFalse;
      terMayBe: terNot := terMayBe;
      terFalse: terNot := terTrue;
    end;
  end;

function terAnd (a, b: trit): trit;
  begin
    terAnd := terMayBe;
    if (a = terFalse) or (b = terFalse) then
      terAnd := terFalse
    else
      if (a = terTrue) and (b = terTrue) then
        terAnd := terTrue;
  end;

function terOr (a, b: trit): trit;
  begin
    terOr := terMayBe;
    if (a = terTrue) or (b = terTrue) then
      terOr := terTrue
    else
      if (a = terFalse) and (b = terFalse) then
        terOr := terFalse;
  end;

function terEquals (a, b: trit): trit;
  begin
    if a = b then
      terEquals := terTrue
    else
      if a <> b then
        terEquals := terFalse;
    if (a = terMayBe) or (b = terMayBe) then
      terEquals := terMayBe;
  end;

function terIfThen (a, b: trit): trit;
  begin
    terIfThen := terMayBe;
    if (a = terTrue) or (b = terFalse)  then
      terIfThen := terTrue
    else
      if (a = terFalse) and (b = terTrue) then
        terIfThen := terFalse;
  end;

function terToStr(a: trit): string;
  begin
    case a of
      terTrue:  terToStr := 'True ';
      terMayBe: terToStr := 'Maybe';
      terFalse: terToStr := 'False';
    end;
  end;

begin
  writeln('Ternary logic test:');
  writeln;
  writeln('NOT ', ' True ', ' Maybe', ' False');
  writeln('     ', terToStr(terNot(terTrue)), ' ', terToStr(terNot(terMayBe)), ' ', terToStr(terNot(terFalse)));
  writeln;
  writeln('AND   ', ' True ', ' Maybe', ' False');
  writeln('True   ', terToStr(terAnd(terTrue,terTrue)),  ' ', terToStr(terAnd(terMayBe,terTrue)),  ' ', terToStr(terAnd(terFalse,terTrue)));
  writeln('Maybe  ', terToStr(terAnd(terTrue,terMayBe)), ' ', terToStr(terAnd(terMayBe,terMayBe)), ' ', terToStr(terAnd(terFalse,terMayBe)));
  writeln('False  ', terToStr(terAnd(terTrue,terFalse)), ' ', terToStr(terAnd(terMayBe,terFalse)), ' ', terToStr(terAnd(terFalse,terFalse)));
  writeln;
  writeln('OR    ', ' True ', ' Maybe', ' False');
  writeln('True   ', terToStr(terOR(terTrue,terTrue)),  ' ', terToStr(terOR(terMayBe,terTrue)),  ' ', terToStr(terOR(terFalse,terTrue)));
  writeln('Maybe  ', terToStr(terOR(terTrue,terMayBe)), ' ', terToStr(terOR(terMayBe,terMayBe)), ' ', terToStr(terOR(terFalse,terMayBe)));
  writeln('False  ', terToStr(terOR(terTrue,terFalse)), ' ', terToStr(terOR(terMayBe,terFalse)), ' ', terToStr(terOR(terFalse,terFalse)));
  writeln;
  writeln('IFTHEN', ' True ', ' Maybe', ' False');
  writeln('True   ', terToStr(terIfThen(terTrue,terTrue)),  ' ', terToStr(terIfThen(terMayBe,terTrue)),  ' ', terToStr(terIfThen(terFalse,terTrue)));
  writeln('Maybe  ', terToStr(terIfThen(terTrue,terMayBe)), ' ', terToStr(terIfThen(terMayBe,terMayBe)), ' ', terToStr(terIfThen(terFalse,terMayBe)));
  writeln('False  ', terToStr(terIfThen(terTrue,terFalse)), ' ', terToStr(terIfThen(terMayBe,terFalse)), ' ', terToStr(terIfThen(terFalse,terFalse)));
  writeln;
  writeln('EQUAL ', ' True ', ' Maybe', ' False');
  writeln('True   ', terToStr(terEquals(terTrue,terTrue)),  ' ', terToStr(terEquals(terMayBe,terTrue)),  ' ', terToStr(terEquals(terFalse,terTrue)));
  writeln('Maybe  ', terToStr(terEquals(terTrue,terMayBe)), ' ', terToStr(terEquals(terMayBe,terMayBe)), ' ', terToStr(terEquals(terFalse,terMayBe)));
  writeln('False  ', terToStr(terEquals(terTrue,terFalse)), ' ', terToStr(terEquals(terMayBe,terFalse)), ' ', terToStr(terEquals(terFalse,terFalse)));
  writeln;
end.


enum T, M, F
type ternary(integer t) return find(t,{T,M,F}) end type

function t_not(ternary a)
    return F+1-a
end function

function t_and(ternary a, ternary b)
    return iff(a=T and b=T?T:iff(a=F or b=F?F:M))
end function

function t_or(ternary a, ternary b)
    return iff(a=T or b=T?T:iff(a=F and b=F?F:M))
end function

function t_xor(ternary a, ternary b)
    return iff(a=M or b=M?M:iff(a=b?F:T))
end function

function t_implies(ternary a, ternary b)
    return iff(a=F or b=T?T:iff(a=T and b=F?F:M))
end function

function t_equal(ternary a, ternary b)
    return iff(a=M or b=M?M:iff(a=b?T:F))
end function

function t_string(ternary a)
    return iff(a=T?"T":iff(a=M?"?":"F"))
end function

procedure show_truth_table(integer rid, integer unary, string name)
    printf(1,"%-3s |%s\n",{name,iff(unary?"":" T | ? | F")})
    printf(1,"----+---%s\n",{iff(unary?"":"+---+---")})
    for x=T to F do
        printf(1," %s ",{t_string(x)})
        if unary then
            printf(1," | %s",{t_string(rid(x))})
        else
            for y=T to F do
                printf(1," | %s",{t_string(rid(x,y))})
            end for
        end if
        printf(1,"\n")
    end for
    printf(1,"\n")
end procedure

show_truth_table(t_not,1,"not")
show_truth_table(t_and,0,"and")
show_truth_table(t_or,0,"or")
show_truth_table(t_xor,0,"xor")
show_truth_table(t_implies,0,"imp")
show_truth_table(t_equal,0,"eq")


#!/usr/bin/php
<?php

# defined as numbers, so I can use max() and min() on it
if (! define('triFalse',0))  trigger_error('Unknown error defining!', E_USER_ERROR);
if (! define('triMaybe',1))  trigger_error('Unknown error defining!', E_USER_ERROR);
if (! define('triTrue', 2))  trigger_error('Unknown error defining!', E_USER_ERROR);

$triNotarray = array(triFalse=>triTrue, triMaybe=>triMaybe, triTrue=>triFalse);

# output helper
function triString ($tri) {
    if ($tri===triFalse) return 'false  ';
    if ($tri===triMaybe) return 'unknown';
    if ($tri===triTrue)  return 'true   ';
    trigger_error('triString: parameter not a tri value', E_USER_ERROR);
}

function triAnd() {
    if (func_num_args() < 2)
       trigger_error('triAnd needs 2 or more parameters', E_USER_ERROR);
    return min(func_get_args());
}

function triOr() {
    if (func_num_args() < 2)
       trigger_error('triOr needs 2 or more parameters', E_USER_ERROR);
    return max(func_get_args());
}

function triNot($t) {
    global $triNotarray; # using result table
    if (in_array($t, $triNotarray)) return $triNotarray[$t];
    trigger_error('triNot: Parameter is not a tri value', E_USER_ERROR);
}

function triImplies($a, $b) {
    if ($a===triFalse || $b===triTrue)  return triTrue;
    if ($a===triMaybe || $b===triMaybe) return triMaybe;
    # without parameter type check I just would return triFalse here
    if ($a===triTrue &&  $b===triFalse) return triFalse;
    trigger_error('triImplies: parameter type error', E_USER_ERROR);
}

function triEquiv($a, $b) {
    if ($a===triTrue)  return $b;
    if ($a===triMaybe) return $a;
    if ($a===triFalse) return triNot($b);
    trigger_error('triEquiv: parameter type error', E_USER_ERROR);
}

# data sampling

printf("--- Sample output for a equivalent b ---\n\n");

foreach ([triTrue,triMaybe,triFalse] as $a) {
    foreach ([triTrue,triMaybe,triFalse] as $b) {
        printf("for a=%s and b=%s a equivalent b is %s\n",
               triString($a), triString($b), triString(triEquiv($a, $b)));
    }
}


main =>
  (show_op1('!') ; true),
  nl,
  foreach(Op in ['/\\','\\/','->','=='])
     (show_op2(Op) ; nl,true)
  end.

ternary(true,'!') = false.
ternary(maybe,'!') = maybe.
ternary(false,'!') = true.

ternary(Cond,'!') = Res =>
  C1 = cond(Cond == maybe,maybe,cond(Cond,true,false)),
  Res = ternary(C1,'!').

ternary(true,'/\\',A)   = A.
ternary(maybe,'/\\',A)  = cond(A==false,false,maybe).
ternary(false,'/\\',_A) = false.

ternary(true,'\\/',_A) = true.
ternary(maybe,'\\/',A) = cond(A==true,true, maybe).
ternary(false,'\\/',A) = A.

ternary(true,'->',A)  = A.
ternary(maybe,'->',A) = cond(A==true,true,maybe).
ternary(false,'->',_) = true.

ternary(true,'==',A)  = A.
ternary(maybe,'==',_) = maybe.
ternary(false,'==',A) = ternary(A,'!').

ternary(Cond1,Op,Cond2) = Res =>
  C1 = cond(Cond1 == maybe,maybe,cond(Cond1,true,false)),
  C2 = cond(Cond2 == maybe,maybe,cond(Cond2,true,false)),
  Res = ternary(C1,Op,C2).

show_op1(Op) =>
  println(Op),
  println(['_' : _ in 1..11]),
  foreach(V1 in [true,maybe,false])
    V2 = ternary(V1,Op),
    printf("%5w %5w \n",V1,V2)
  end,
  nl.

show_op2(Op) =>
  Vs = [true,maybe,false],
  printf("%2w      %5w %5w %5w\n",Op,Vs[1],Vs[2],Vs[3]),
  println(['_' : _ in 1..25]),
  foreach(V1 in Vs)
    printf("%-5w | ", V1),
    foreach(V2 in Vs)
      C = ternary(V1,Op,V2),
      printf("%5w ",C)
    end,
    nl
  end,
  nl.


DataSection
  TLogic:
  Data.i -1,0,1
  TSymb:
  Data.s "F","?","T"
EndDataSection

Structure TL
  F.i
  M.i
  T.i
EndStructure

Structure SYM
  TS.s{2}[3]
EndStructure

*L.TL=?TLogic
*S.SYM=?TSymb

Procedure.i NOT3(*x.TL)
  ProcedureReturn -*x
EndProcedure

Procedure.i AND3(*x.TL,*y.TL)
  If *x>*y : ProcedureReturn *y : Else : ProcedureReturn *x : EndIf
EndProcedure

Procedure.i OR3(*x.TL,*y.TL)
  If *x<*y : ProcedureReturn *y : Else : ProcedureReturn *x : EndIf
EndProcedure

Procedure.i EQV3(*x.TL,*y.TL)
  ProcedureReturn *x * *y
EndProcedure

Procedure.i IMP3(*x.TL,*y.TL)
  If -*y>*x : ProcedureReturn -*y : Else : ProcedureReturn *x : EndIf
EndProcedure

If OpenConsole("")
  PrintN("     (AND)      ( OR)      (EQV)      (IMP)     (NOT)")
  PrintN("     F ? T      F ? T      F ? T      F ? T          ")
  PrintN("    -------------------------------------------------")
  For *i.TL=*L\F To *L\T
    rs$=" "+*S\TS[*i+1]+" | "
    rs$+*S\TS[AND3(*L\F,*i)+1]+" "+*S\TS[AND3(*L\M,*i)+1]+" "+*S\TS[AND3(*L\T,*i)+1]
    rs$+"      "
    rs$+*S\TS[OR3(*L\F,*i)+1] +" "+*S\TS[OR3(*L\M,*i)+1] +" "+*S\TS[OR3(*L\T,*i)+1]
    rs$+"      "
    rs$+*S\TS[EQV3(*L\F,*i)+1]+" "+*S\TS[EQV3(*L\M,*i)+1]+" "+*S\TS[EQV3(*L\T,*i)+1]
    rs$+"      "
    rs$+*S\TS[IMP3(*L\F,*i)+1]+" "+*S\TS[IMP3(*L\M,*i)+1]+" "+*S\TS[IMP3(*L\T,*i)+1]
    rs$+"      "+*S\TS[NOT3(*i)+1]
    PrintN(rs$)
  Next
EndIf
Input()


class Trit(int):
    def __new__(cls, value):
        if value == 'TRUE':
            value = 1
        elif value == 'FALSE':
            value = 0
        elif value == 'MAYBE':
            value = -1
        return super(Trit, cls).__new__(cls, value // (abs(value) or 1))

    def __repr__(self):
        if self > 0:
            return 'TRUE'
        elif self == 0:
            return 'FALSE'
        return 'MAYBE'

    def __str__(self):
        return repr(self)

    def __bool__(self):
        if self > 0:
            return True
        elif self == 0:
            return False
        else:
            raise ValueError("invalid literal for bool(): '%s'" % self)

    def __or__(self, other):
        if isinstance(other, Trit):
            return _ttable[(self, other)][1]
        else:
            try:
                return _ttable[(self, Trit(bool(other)))][1]
            except:
                return NotImplemented

    def __ror__(self, other):
        if isinstance(other, Trit):
            return _ttable[(self, other)][1]
        else:
            try:
                return _ttable[(self, Trit(bool(other)))][1]
            except:
                return NotImplemented

    def __and__(self, other):
        if isinstance(other, Trit):
            return _ttable[(self, other)][0]
        else:
            try:
                return _ttable[(self, Trit(bool(other)))][0]
            except:
                return NotImplemented

    def __rand__(self, other):
        if isinstance(other, Trit):
            return _ttable[(self, other)][0]
        else:
            try:
                return _ttable[(self, Trit(bool(other)))][0]
            except:
                return NotImplemented

    def __xor__(self, other):
        if isinstance(other, Trit):
            return _ttable[(self, other)][2]
        else:
            try:
                return _ttable[(self, Trit(bool(other)))][2]
            except:
                return NotImplemented

    def __rxor__(self, other):
        if isinstance(other, Trit):
            return _ttable[(self, other)][2]
        else:
            try:
                return _ttable[(self, Trit(bool(other)))][2]
            except:
                return NotImplemented

    def __invert__(self):
        return _ttable[self]

    def __getattr__(self, name):
        if name in ('_n', 'flip'):
            # So you can do x._n == x.flip; the inverse of x
            # In Python 'not' is strictly boolean so we can't write `not x`
            # Same applies to keywords 'and' and 'or'.
            return _ttable[self]
        else:
            raise AttributeError

TRUE, FALSE, MAYBE = Trit(1), Trit(0), Trit(-1)

_ttable = {
    #    A: -> flip_A
         TRUE: FALSE,
        FALSE:  TRUE,
        MAYBE: MAYBE,
    #     (A, B): -> (A_and_B, A_or_B, A_xor_B)
        (MAYBE, MAYBE): (MAYBE, MAYBE, MAYBE),
        (MAYBE, FALSE): (FALSE, MAYBE, MAYBE),
        (MAYBE,  TRUE): (MAYBE,  TRUE, MAYBE),
        (FALSE, MAYBE): (FALSE, MAYBE, MAYBE),
        (FALSE, FALSE): (FALSE, FALSE, FALSE),
        (FALSE,  TRUE): (FALSE,  TRUE,  TRUE),
        ( TRUE, MAYBE): (MAYBE,  TRUE, MAYBE),
        ( TRUE, FALSE): (FALSE,  TRUE,  TRUE),
        ( TRUE,  TRUE): ( TRUE,  TRUE, FALSE),
    }

values = ('FALSE', 'TRUE ', 'MAYBE')

print("\nTrit logical inverse, '~'")
for a in values:
    expr = '~%s' % a
    print('  %s = %s' % (expr, eval(expr)))

for op, ophelp in (('&', 'and'), ('|', 'or'), ('^', 'exclusive-or')):
    print("\nTrit logical %s, '%s'" % (ophelp, op))
    for a in values:
        for b in values:
            expr = '%s %s %s' % (a, op, b)
            print('  %s = %s' % (expr, eval(expr)))


[ 2 ]                                       is maybe      (     --> t )

[ table 2 0 1 ]                             is jiggle     (   t --> n )

[ jiggle 1+ ]this[ swap peek do ]done[ ]    is 1-trit     (   t --> t )

[ swap jiggle 1+ ]this[
  swap peek
  swap jiggle peek do ]done[ ]              is 2-trits    ( t t --> t )

[ 1-trit $ "true" $ "maybe" $ "false" ]     is trit$      (   t --> $ )

[ trit$ echo$ ]                             is echotrit   (   t -->   )

[ dup echotrit true = if sp ]               is paddedtrit (   t -->   )

          ( true  maybe false )
[ 1-trit    false maybe true  ]             is t.not      (   t --> t )

                    ( true  maybe false )
[ 2-trits ( true  ) [ false maybe true  ]
          ( maybe ) [ maybe maybe true  ]
          ( false ) [ true  true  true  ] ] is t.nand     ( t t --> t )

                    ( true  maybe false )
[ 2-trits ( true  ) [ true  maybe false ]
          ( maybe ) [ maybe maybe false ]
          ( false ) [ false false false ] ] is t.and      ( t t --> t )

                    ( true  maybe false )
[ 2-trits ( true  ) [ true  true  true  ]
          ( maybe ) [ true  maybe maybe ]
          ( false ) [ true  maybe false ] ] is t.or       ( t t --> t )

                    ( true  maybe false )
[ 2-trits ( true  ) [ false maybe true  ]
          ( maybe ) [ maybe maybe maybe ]
          ( false ) [ true  maybe false ] ] is t.xor      ( t t --> t )

( Quackery does not have operators for material implication
  (if a then b, a implies b) or material equivalence
  (a ≣ b, A <=> b). However, The Book of Quackery notes that they
  can be defined as:
    "[ swap not or ] is implies ( a b --> c )"
    "[ xor not ]     is <=>     ( a b --> c )"
  so we will adapt these to test some of the ternary operators. )

[ swap t.not t.or ]                         is t.implies  ( t t --> t )

[ t.xor t.not ]                             is t.<=>      ( t t --> t )

cr
say " t.not     | true  | maybe | false"             cr
say " ---------------------------------"             cr
say "           | " true  t.not paddedtrit           sp
say            "| " maybe t.not paddedtrit           sp
say            "| " false t.not paddedtrit           cr
cr
say " t.and     | true  | maybe | false"             cr
say " ---------------------------------"             cr
say "   true    | " true  true  t.and paddedtrit     sp
say            "| " true  maybe t.and paddedtrit     sp
say            "| " true  false t.and paddedtrit     cr
say "   maybe   | " maybe true  t.and paddedtrit     sp
say            "| " maybe maybe t.and paddedtrit     sp
say            "| " maybe false t.and paddedtrit     cr
say "   false   | " false true  t.and paddedtrit     sp
say            "| " false maybe t.and paddedtrit     sp
say            "| " false false t.and paddedtrit     cr
cr
say " t.or      | true  | maybe | false"             cr
say " ---------------------------------"             cr
say "   true    | " true  true   t.or paddedtrit     sp
say            "| " true  maybe  t.or paddedtrit     sp
say            "| " true  false  t.or paddedtrit     cr
say "   maybe   | " maybe true   t.or paddedtrit     sp
say            "| " maybe maybe  t.or paddedtrit     sp
say            "| " maybe false  t.or paddedtrit     cr
say "   false   | " false true   t.or paddedtrit     sp
say            "| " false maybe  t.or paddedtrit     sp
say            "| " false false  t.or paddedtrit     cr
cr
say " t.implies | true  | maybe | false"             cr
say " ---------------------------------"             cr
say "   true    | " true  true  t.implies paddedtrit sp
say            "| " true  maybe t.implies paddedtrit sp
say            "| " true  false t.implies paddedtrit cr
say "   maybe   | " maybe true  t.implies paddedtrit sp
say            "| " maybe maybe t.implies paddedtrit sp
say            "| " maybe false t.implies paddedtrit cr
say "   false   | " false true  t.implies paddedtrit sp
say            "| " false maybe t.implies paddedtrit sp
say            "| " false false t.implies paddedtrit cr
cr
say " t.<=>     | true  | maybe | false"             cr
say " ---------------------------------"             cr
say "   true    | " true  true  t.<=> paddedtrit     sp
say            "| " true  maybe t.<=> paddedtrit     sp
say            "| " true  false t.<=> paddedtrit     cr
say "   maybe   | " maybe true  t.<=> paddedtrit     sp
say            "| " maybe maybe t.<=> paddedtrit     sp
say            "| " maybe false t.<=> paddedtrit     cr
say "   false   | " false true  t.<=> paddedtrit     sp
say            "| " false maybe t.<=> paddedtrit     sp
say            "| " false false t.<=> paddedtrit     cr


#lang typed/racket

; to avoid the hassle of adding a maybe value that is as special as
; the two standard booleans, we'll use symbols to make our own
(define-type trit (U 'true 'false 'maybe))

(: not (trit -> trit))
(define (not a)
  (case a
    [(true) 'false]
    [(maybe) 'maybe]
    [(false) 'true]))

(: and (trit trit -> trit))
(define (and a b)
  (case a
    [(false) 'false]
    [(maybe) (case b
               [(false) 'false]
               [else 'maybe])]
    [(true) (case b
              [(true) 'true]
              [(maybe) 'maybe]
              [(false) 'false])]))

(: or (trit trit -> trit))
(define (or a b)
  (case a
    [(true) 'true]
    [(maybe) (case b
               [(true) 'true]
               [else 'maybe])]
    [(false) (case b
               [(true) 'true]
               [(maybe) 'maybe]
               [(false) 'false])]))

(: ifthen (trit trit -> trit))
(define (ifthen a b)
  (case b
    [(true) 'true]
    [(maybe) (case a
               [(false) 'true]
               [else 'maybe])]
    [(false) (case a
               [(true) 'false]
               [(maybe) 'maybe]
               [(false) 'true])]))

(: iff (trit trit -> trit))
(define (iff a b)
  (case a
    [(maybe) 'maybe]
    [(true) b]
    [(false) (not b)]))

(for: : Void ([a (in-list '(true maybe false))])
      (printf "~a ~a = ~a~n" (object-name not) a (not a)))
(for: : Void ([proc (in-list (list and or ifthen iff))])
  (for*: : Void ([a (in-list '(true maybe false))]
                 [b (in-list '(true maybe false))])
         (printf "~a ~a ~a = ~a~n" a (object-name proc) b (proc a b))))


# Implementation:
enum Trit <Foo Moo Too>;

sub prefix:<¬> (Trit $a) { Trit(1-($a-1)) }

sub infix:<∧> (Trit $a, Trit $b) is equiv(&infix:<*>) { $a min $b }
sub infix:<∨> (Trit $a, Trit $b) is equiv(&infix:<+>) { $a max $b }

sub infix:<⇒> (Trit $a, Trit $b) is equiv(&infix:<..>) { ¬$a max $b }
sub infix:<≡> (Trit $a, Trit $b) is equiv(&infix:<eq>) { Trit(1 + ($a-1) * ($b-1)) }

# Testing:
say '¬';
say "Too {¬Too}";
say "Moo {¬Moo}";
say "Foo {¬Foo}";

sub tbl (&op,$name) {
    say '';
    say "$name   Too Moo Foo";
    say "   ╔═══════════";
    say "Too║{op Too,Too} {op Too,Moo} {op Too,Foo}";
    say "Moo║{op Moo,Too} {op Moo,Moo} {op Moo,Foo}";
    say "Foo║{op Foo,Too} {op Foo,Moo} {op Foo,Foo}";
}

tbl(&infix:<∧>, '∧');
tbl(&infix:<∨>, '∨');
tbl(&infix:<⇒>, '⇒');
tbl(&infix:<≡>, '≡');

say '';
say 'Precedence tests should all print "Too":';
say ~(
    Foo ∧ Too ∨ Too ≡ Too,
    Foo ∧ (Too ∨ Too) ≡ Foo,
    Too ∨ Too ∧ Foo ≡ Too,
    (Too ∨ Too) ∧ Foo ≡ Foo,

    ¬Too ∧ Too ∨ Too ≡ Too,
    ¬Too ∧ (Too ∨ Too) ≡ ¬Too,
    Too ∨ Too ∧ ¬Too ≡ Too,
    (Too ∨ Too) ∧ ¬Too ≡ ¬Too,

    Foo ∧ Too ∨ Foo ⇒ Foo ≡ Too,
    Foo ∧ Too ∨ Too ⇒ Foo ≡ Foo,
);


Red ["Ternary logic"]

		; define trits as a set of 3 Red words: 'oui, 'non and 'bof
		; ('bof is a French teenager word expressing indifference)
trits: [oui bof non]

		; set the value of each word to itself
		; so the expression " oui " will evaluate to word 'oui
foreach t trits [set t to-lit-word t]

		; utility function to test if a word is a trit
trit?: function [t] [not none? find trits t]

		; ------ prefix operators ------
		; unary operator
tnot: !: function [a][
	select [oui non oui bof bof] a
]
		; binary (prefix) operators
tand: function [a b][
	either all [a = oui b = oui][oui][
		either any [a = non b = non][non][bof]
]]
tor: function [a b][
	either any [a = oui b = oui][oui][
		either all [a = non b = non][non][bof]
]]
timp: function [a b][
	either a = oui [b][
		either a = non [oui][
			either b = oui [oui][bof]
]]]
teq: function [a b][
	either any [a = bof b = bof][bof][
		either a = b [oui][non]
]]
		; ------ infix operators ------
&:   make op! :tand
|:   make op! :tor
=>:  make op! :timp
<=>: make op! :teq

		; some examples
probe init: [
a: oui
b: bof
c: non]
do init
foreach s [[! (! a)] [a & b] [a | (b & (oui | non))]
		[! ((a | b) | b & c)] [(a & b) | c]][
	print rejoin [pad mold s 25 " " do s]
]


/*REXX program displays a ternary truth table  [true, false, maybe]   for the variables */
/*──── and one or more expressions.                                                     */
/*──── Infix notation is supported with one character propositional constants.          */
/*──── Variables (propositional constants) allowed:    A ──► Z,     a ──► z   except  u.*/
/*──── All propositional constants are case insensative  (except lowercase  v).         */
parse arg $express                               /*obtain optional argument from the CL.*/
if $express\=''  then do                         /*Got one?  Then show user's expression*/
                      call truthTable $express   /*display the user's truth table──►term*/
                      exit                       /*we're all done with the truth table. */
                      end

call truthTable  "a & b ; AND"
call truthTable  "a | b ; OR"
call truthTable  "a ^ b ; XOR"
call truthTable  "a ! b ; NOR"
call truthTable  "a ¡ b ; NAND"
call truthTable  "a xnor b ; XNOR"               /*XNOR  is the same as  NXOR.          */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
truthTable: procedure; parse arg $ ';' comm 1 $o;        $o=strip($o)
      $=translate(strip($), '|', "v");                   $u=$;        upper $u
      $u=translate($u, '()()()', "[]{}«»");              $$.=0;       PCs=;        hdrPCs=
      @abc= 'abcdefghijklmnopqrstuvwxyz';                @[email protected];  upper @abcU
      @= 'ff'x                                         /*─────────infix operators───────*/
      op.=                                             /*a single quote (') wasn't      */
                                                       /*     implemented for negation. */
      op.0  = 'false  boolFALSE'                       /*unconditionally  FALSE         */
      op.1  = 'and    and & *'                         /* AND, conjunction              */
      op.2  = 'naimpb NaIMPb'                          /*not A implies B                */
      op.3  = 'boolb  boolB'                           /*B  (value of)                  */
      op.4  = 'nbimpa NbIMPa'                          /*not B implies A                */
      op.5  = 'boola  boolA'                           /*A  (value of)                  */
      op.6  = 'xor    xor && % ^'                      /* XOR, exclusive OR             */
      op.7  = 'or     or | + v'                        /*  OR, disjunction              */
      op.8  = 'nor    nor ! ↓'                         /* NOR, not OR, Pierce operator  */
      op.9  = 'xnor   xnor nxor'                       /*NXOR, not exclusive OR, not XOR*/
      op.10 = 'notb   notB'                            /*not B (value of)               */
      op.11 = 'bimpa  bIMPa'                           /*    B implies A                */
      op.12 = 'nota   notA'                            /*not A (value of)               */
      op.13 = 'aimpb  aIMPb'                           /*    A implies B                */
      op.14 = 'nand   nand ¡ ↑'                        /*NAND, not AND, Sheffer operator*/
      op.15 = 'true   boolTRUE'                        /*unconditionally   TRUE         */
                                                       /*alphabetic names need changing.*/
      op.16 = '\   NOT ~ ─ . ¬'                        /* NOT, negation                 */
      op.17 = '>   GT'                                 /*conditional greater than       */
      op.18 = '>=  GE ─> => ──> ==>' "1a"x             /*conditional greater than or eq.*/
      op.19 = '<   LT'                                 /*conditional less than          */
      op.20 = '<=  LE <─ <= <── <=='                   /*conditional less then or equal */
      op.21 = '\=  NE ~= ─= .= ¬='                     /*conditional not equal to       */
      op.22 = '=   EQ EQUAL EQUALS =' "1b"x            /*biconditional  (equals)        */
      op.23 = '0   boolTRUE'                           /*TRUEness                       */
      op.24 = '1   boolFALSE'                          /*FALSEness                      */

      op.25 = 'NOT NOT NEG'                            /*not, neg  (negative)           */

        do jj=0  while  op.jj\=='' | jj<16             /*change opers──►what REXX likes.*/
        new=word(op.jj,1)
          do kk=2  to words(op.jj)                     /*handle each token separately.  */
          _=word(op.jj, kk);     upper _
          if wordpos(_, $u)==0   then iterate          /*no such animal in this string. */
          if datatype(new, 'm')  then [email protected]           /*expresion needs transcribing.  */
                                 else new!=new
          $u=changestr(_, $u, new!)                    /*transcribe the function (maybe)*/
          if [email protected]  then $u=changeFunc($u, @, new)   /*use the internal boolean name. */
          end   /*kk*/
        end     /*jj*/

      $u=translate($u, '()', "{}")                     /*finish cleaning up transcribing*/
            do jj=1  for length(@abcU)                 /*see what variables are used.   */
            _=substr(@abcU, jj, 1)                     /*use available upercase alphabet*/
            if pos(_,$u)==0  then iterate              /*found one?   No, keep looking. */
            $$.jj=2                                    /*found:  set upper bound for it.*/
            PCs=PCs _                                  /*also, add to propositional cons*/
            hdrPCs=hdrPCS  center(_, length('false'))  /*build a propositional cons hdr.*/
            end   /*jj*/
      $u=PCs  '('$u")"                                 /*sep prop. cons. from expression*/
      ptr='_────►_'                                    /*a pointer for the truth table. */
      hdrPCs=substr(hdrPCs,2)                          /*create a header for prop. cons.*/
      say hdrPCs left('', length(ptr) -1)   $o         /*show prop cons hdr +expression.*/
      say copies('───── ', words(PCs))   left('', length(ptr)-2)   copies('─', length($o))
                                                       /*Note: "true"s:  right─justified*/
              do a=0  to $$.1
               do b=0  to $$.2
                do c=0  to $$.3
                 do d=0  to $$.4
                  do e=0  to $$.5
                   do f=0  to $$.6
                    do g=0  to $$.7
                     do h=0  to $$.8
                      do i=0  to $$.9
                       do j=0  to $$.10
                        do k=0  to $$.11
                         do l=0  to $$.12
                          do m=0  to $$.13
                           do n=0  to $$.14
                            do o=0  to $$.15
                             do p=0  to $$.16
                              do q=0  to $$.17
                               do r=0  to $$.18
                                do s=0  to $$.19
                                 do t=0  to $$.20
                                  do u=0  to $$.21
                                   do !=0  to $$.22
                                    do w=0  to $$.23
                                     do x=0  to $$.24
                                      do y=0  to $$.25
                                       do z=0  to $$.26
                                       interpret '_=' $u             /*evaluate truth T.*/
                                       _=changestr(0, _, 'false')    /*convert 0──►false*/
                                       _=changestr(1, _, '_true')    /*convert 1──►_true*/
                                       _=changestr(2, _, 'maybe')    /*convert 2──►maybe*/
                                       _=insert(ptr, _, wordindex(_, words(_)) -1) /*──►*/
                                       say translate(_, , '_')       /*display truth tab*/
                                       end   /*z*/
                                      end    /*y*/
                                     end     /*x*/
                                    end      /*w*/
                                   end       /*v*/
                                  end        /*u*/
                                 end         /*t*/
                                end          /*s*/
                               end           /*r*/
                              end            /*q*/
                             end             /*p*/
                            end              /*o*/
                           end               /*n*/
                          end                /*m*/
                         end                 /*l*/
                        end                  /*k*/
                       end                   /*j*/
                      end                    /*i*/
                     end                     /*h*/
                    end                      /*g*/
                   end                       /*f*/
                  end                        /*e*/
                 end                         /*d*/
                end                          /*c*/
               end                           /*b*/
              end                            /*a*/
      say
      return
/*──────────────────────────────────────────────────────────────────────────────────────*/
scan: procedure; parse arg x,at;    L=length(x);    t=L;     lp=0;     apost=0;    quote=0
      if at<0  then do;   t=1;   x= translate(x, '()', ")(");    end

                      do j=abs(at)  to t  by sign(at);  _=substr(x,j,1);  __=substr(x,j,2)
                      if quote           then do; if _\=='"'  then iterate
                                              if __=='""'     then do; j=j+1; iterate; end
                                              quote=0;  iterate
                                              end
                      if apost           then do; if _\=="'"  then iterate
                                              if __=="''"     then do; j=j+1; iterate; end
                                              apost=0;  iterate
                                              end
                      if _=='"'          then do;  quote=1;                   iterate; end
                      if _=="'"          then do;  apost=1;                   iterate; end
                      if _==' '          then iterate
                      if _=='('          then do;  lp=lp+1;                   iterate; end
                      if lp\==0          then do;  if _==')'  then lp=lp-1;   iterate; end
                      if datatype(_,'U') then return j - (at<0)
                      if at<0            then return j + 1
                      end   /*j*/
      return min(j,L)
/*──────────────────────────────────────────────────────────────────────────────────────*/
changeFunc: procedure;  parse arg z,fC,newF;       funcPos= 0
            do forever
            funcPos= pos(fC, z, funcPos + 1);      if funcPos==0  then return z
            origPos= funcPos
                  z= changestr(fC, z, ",'"newF"',")
            funcPos= funcPos + length(newF) + 4
              where= scan(z, funcPos)     ;        z= insert(    '}',  z,  where)
              where= scan(z, 1 - origPos) ;        z= insert('trit{',  z,  where)
            end   /*forever*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
trit: procedure; arg a,$,b;   v= \(a==2 | b==2);    o= (a==1 | b==1);     z= (a==0 | b==0)
            select
            when $=='FALSE'   then            return 0
            when $=='AND'     then if v  then return a & b;      else return 2
            when $=='NAIMPB'  then if v  then return \(\a & \b); else return 2
            when $=='BOOLB'   then            return b
            when $=='NBIMPA'  then if v  then return \(\b & \a); else return 2
            when $=='BOOLA'   then            return a
            when $=='XOR'     then if v  then return a && b    ; else return 2
            when $=='OR'      then if v  then return a | b     ; else  if o  then return 1
                                                                             else return 2
            when $=='NOR'     then if v  then return \(a | b)  ; else return 2
            when $=='XNOR'    then if v  then return \(a && b) ; else return 2
            when $=='NOTB'    then if v  then return \b        ; else return 2
            when $=='NOTA'    then if v  then return \a        ; else return 2
            when $=='AIMPB'   then if v  then return \(a & \b) ; else return 2
            when $=='NAND'    then if v  then return \(a &  b) ; else  if z  then return 1
                                                                             else return 2
            when $=='TRUE'    then           return   1
            otherwise                        return -13       /*error, unknown function.*/
            end   /*select*/


# trit.rb - ternary logic
# http://rosettacode.org/wiki/Ternary_logic

require 'singleton'

# MAYBE, the only instance of MaybeClass, enables a system of ternary
# logic using TrueClass#trit, MaybeClass#trit and FalseClass#trit.
#
#  !a.trit      # ternary not
#  a.trit & b   # ternary and
#  a.trit | b   # ternary or
#  a.trit ^ b   # ternary exclusive or
#  a.trit == b  # ternary equal
#
# Though +true+ and +false+ are internal Ruby values, +MAYBE+ is not.
# Programs may want to assign +maybe = MAYBE+ in scopes that use
# ternary logic. Then programs can use +true+, +maybe+ and +false+.
class MaybeClass
  include Singleton

  #  maybe.to_s  # => "maybe"
  def to_s; "maybe"; end
end

MAYBE = MaybeClass.instance

class TrueClass
  TritMagic = Object.new
  class << TritMagic
    def index; 0; end
    def !; false; end
    def & other; other; end
    def | other; true; end
    def ^ other; [false, MAYBE, true][other.trit.index]; end
    def == other; other; end
  end

  # Performs ternary logic. See MaybeClass.
  #  !true.trit        # => false
  #  true.trit & obj   # => obj
  #  true.trit | obj   # => true
  #  true.trit ^ obj   # => false, maybe or true
  #  true.trit == obj  # => obj
  def trit; TritMagic; end
end

class MaybeClass
  TritMagic = Object.new
  class << TritMagic
    def index; 1; end
    def !; MAYBE; end
    def & other; [MAYBE, MAYBE, false][other.trit.index]; end
    def | other; [true, MAYBE, MAYBE][other.trit.index]; end
    def ^ other; MAYBE; end
    def == other; MAYBE; end
  end

  # Performs ternary logic. See MaybeClass.
  #  !maybe.trit        # => maybe
  #  maybe.trit & obj   # => maybe or false
  #  maybe.trit | obj   # => true or maybe
  #  maybe.trit ^ obj   # => maybe
  #  maybe.trit == obj  # => maybe
  def trit; TritMagic; end
end

class FalseClass
  TritMagic = Object.new
  class << TritMagic
    def index; 2; end
    def !; true; end
    def & other; false; end
    def | other; other; end
    def ^ other; other; end
    def == other; [false, MAYBE, true][other.trit.index]; end
  end

  # Performs ternary logic. See MaybeClass.
  #  !false.trit        # => true
  #  false.trit & obj   # => false
  #  false.trit | obj   # => obj
  #  false.trit ^ obj   # => obj
  #  false.trit == obj  # => false, maybe or true
  def trit; TritMagic; end
end


testFalse	= 0  ' F
testDoNotKnow	= 1  ' ?
testTrue	= 2  ' T

print "Short and long names for ternary logic values"
for i = testFalse to testTrue
    print shortName3$(i);" ";longName3$(i)
next i
print

print "Single parameter functions"
print "x";" ";"=x";"  ";"not(x)"
for i = testFalse to testTrue
    print shortName3$(i);"  ";shortName3$(i);"    ";shortName3$(not3(i))
next
print

print "Double  parameter fuctions"
html "

x	y	x AND y	x OR y	x EQ y	x XOR y
"
for a	= testFalse to testTrue
    for b	= testFalse to testTrue
      html "
"
      html shortName3$(a);        "	";shortName3$(b);        "	"
      html shortName3$(and3(a,b));"	";shortName3$(or3(a,b)); "	"
      html shortName3$(eq3(a,b)); "	";shortName3$(xor3(a,b));"
"
    next
next
html "
"
function and3(a,b)
    and3	= min(a,b)
end function

function or3(a,b)
    or3	= max(a,b)
end function

function eq3(a,b)
    eq3 	= testFalse
    if a	= tDontKnow or b	= tDontKnow then eq3	= tDontKnow
    if a	= b then eq3	= testTrue
end function

function xor3(a,b)
    xor3	= not3(eq3(a,b))
end function

function not3(b)
    not3	= 2-b
end function

'------------------------------------------------
function shortName3$(i)
   shortName3$	= word$("F ? T", i+1)
end function

function longName3$(i)
    longName3$	= word$("False,Don't know,True", i+1, ",")
end function


use std::{ops, fmt};

#[derive(Copy, Clone, Debug)]
enum Trit {
    True,
    Maybe,
    False,
}

impl ops::Not for Trit {
    type Output = Self;
    fn not(self) -> Self {
        match self {
            Trit::True => Trit::False,
            Trit::Maybe => Trit::Maybe,
            Trit::False => Trit::True,
        }
    }
}

impl ops::BitAnd for Trit {
    type Output = Self;
    fn bitand(self, other: Self) -> Self {
        match (self, other) {
            (Trit::True, Trit::True) => Trit::True,
            (Trit::False, _) | (_, Trit::False) => Trit::False,
            _ => Trit::Maybe,
        }
    }
}

impl ops::BitOr for Trit {
    type Output = Self;
    fn bitor(self, other: Self) -> Self {
        match (self, other) {
            (Trit::True, _) | (_, Trit::True) => Trit::True,
            (Trit::False, Trit::False) => Trit::False,
            _ => Trit::Maybe,
        }
    }
}

impl Trit {
    fn imp(self, other: Self) -> Self {
        match self {
            Trit::True => other,
            Trit::Maybe => {
                if let Trit::True = other {
                    Trit::True
                } else {
                    Trit::Maybe
                }
            }
            Trit::False => Trit::True,
        }
    }

    fn eqv(self, other: Self) -> Self {
        match self {
            Trit::True => other,
            Trit::Maybe => Trit::Maybe,
            Trit::False => !other,
        }
    }
}

impl fmt::Display for Trit {
    fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
        write!(
            f,
            "{}",
            match self {
                Trit::True => 'T',
                Trit::Maybe => 'M',
                Trit::False => 'F',
            }
        )
    }
}

static TRITS: [Trit; 3] = [Trit::True, Trit::Maybe, Trit::False];

fn main() {
    println!("not");
    println!("-------");
    for &t in &TRITS {
        println!(" {}  | {}", t, !t);
    }

    table("and", |a, b| a & b);
    table("or", |a, b| a | b);
    table("imp", |a, b| a.imp(b));
    table("eqv", |a, b| a.eqv(b));
}

fn table(title: &str, f: impl Fn(Trit, Trit) -> Trit) {
    println!();
    println!("{:3} | T  M  F", title);
    println!("-------------");
    for &t1 in &TRITS {
        print!(" {}  | ", t1);
        for &t2 in &TRITS {
            print!("{}  ", f(t1, t2));
        }
        println!();
    }
}


sealed trait Trit { self =>
  def nand(that:Trit):Trit=(this,that) match {
    case (TFalse, _) => TTrue
    case (_, TFalse) => TTrue
    case (TMaybe, _) => TMaybe
    case (_, TMaybe) => TMaybe
    case _ => TFalse
  }

  def nor(that:Trit):Trit = this.or(that).not()
  def and(that:Trit):Trit = this.nand(that).not()
  def or(that:Trit):Trit = this.not().nand(that.not())
  def not():Trit = this.nand(this)
  def imply(that:Trit):Trit = this.nand(that.not())
  def equiv(that:Trit):Trit = this.and(that).or(this.nor(that))
}
case object TTrue extends Trit
case object TMaybe extends Trit
case object TFalse extends Trit

object TernaryLogic extends App {
  val v=List(TTrue, TMaybe, TFalse)
  println("- NOT -")
  for(a<-v) println("%6s => %6s".format(a, a.not))
  println("\n- AND -")
  for(a<-v; b<-v) println("%6s : %6s => %6s".format(a, b, a and b))
  println("\n- OR -")
  for(a<-v; b<-v) println("%6s : %6s => %6s".format(a, b, a or b))
  println("\n- Imply -")
  for(a<-v; b<-v) println("%6s : %6s => %6s".format(a, b, a imply b))
  println("\n- Equiv -")
  for(a<-v; b<-v) println("%6s : %6s => %6s".format(a, b, a equiv b))
}


$ include "seed7_05.s7i";

const type: trit is new enum
    False, Maybe, True
  end enum;

# Enum types define comparisons (=, <, >, <=, >=, <>) and
# the conversions ord and conv.

const func string: str (in trit: aTrit) is
  return [] ("False", "Maybe", "True")[succ(ord(aTrit))];

enable_output(trit);  # Allow writing trit values

const array trit: tritNot is [] (True, Maybe, False);
const array array trit: tritAnd is [] (
    [] (False, False, False),
    [] (False, Maybe, Maybe),
    [] (False, Maybe, True ));
const array array trit: tritOr is [] (
    [] (False, Maybe, True ),
    [] (Maybe, Maybe, True ),
    [] (True,  True,  True ));
const array array trit: tritXor is [] (
    [] (False, Maybe, True ),
    [] (Maybe, Maybe, Maybe),
    [] (True,  Maybe, False));
const array array trit: tritImplies is [] (
    [] (True,  True,  True ),
    [] (Maybe, Maybe, True ),
    [] (False, Maybe, True ));
const array array trit: tritEquiv is [] (
    [] (True,  Maybe, False),
    [] (Maybe, Maybe, Maybe),
    [] (False, Maybe, True ));

const func trit: not (in trit: aTrit) is
  return tritNot[succ(ord(aTrit))];

const func trit: (in trit: aTrit1) and (in trit: aTrit2) is
  return tritAnd[succ(ord(aTrit1))][succ(ord(aTrit2))];

const func trit: (in trit: aTrit1) and (ref func trit: aTrit2) is func
  result
    var trit: res is False;
  begin
    if aTrit1 = True then
      res := aTrit2;
    elsif aTrit1 = Maybe and aTrit2 <> False then
      res := Maybe;
    end if;
  end func;

const func trit: (in trit: aTrit1) or (in trit: aTrit2) is
  return tritOr[succ(ord(aTrit1))][succ(ord(aTrit2))];

const func trit: (in trit: aTrit1) or (ref func trit: aTrit2) is func
  result
    var trit: res is True;
  begin
    if aTrit1 = False then
      res := aTrit2;
    elsif aTrit1 = Maybe and aTrit2 <> True then
      res := Maybe;
    end if;
  end func;

$ syntax expr: .().xor.() is -> 15;
const func trit: (in trit: aTrit1) xor (in trit: aTrit2) is
  return tritImplies[succ(ord(aTrit1))][succ(ord(aTrit2))];

const func trit: (in trit: aTrit1) -> (in trit: aTrit2) is
  return tritImplies[succ(ord(aTrit1))][succ(ord(aTrit2))];

const func trit: (in trit: aTrit1) == (in trit: aTrit2) is
  return tritEquiv[succ(ord(aTrit1))][succ(ord(aTrit2))];

const func trit: rand (in trit: low, in trit: high) is
  return trit conv (rand(ord(low), ord(high)));

# Begin of test code

var trit: operand1 is False;
var trit: operand2 is False;

const proc: writeTable (ref func trit: tritExpr, in string: name) is func
  begin
    writeln;
    writeln(" " <& name rpad 7 <& " | False  Maybe  True");
    writeln("---------+---------------------");
    for operand1 range False to True do
      write(" " <& operand1 rpad 7 <& " | ");
      for operand2 range False to True do
        write(tritExpr rpad 7);
      end for;
      writeln;
    end for;
  end func;

const proc: main is func
  begin
    writeln(" not" rpad 8 <& " | False  Maybe  True");
    writeln("---------+---------------------");
    write("         | ");
    for operand1 range False to True do
      write(not operand1 rpad 7);
    end for;
    writeln;
    writeTable(operand1 and operand2, "and");
    writeTable(operand1 or operand2,  "or");
    writeTable(operand1 xor operand2, "xor");
    writeTable(operand1 -> operand2,  "->");
    writeTable(operand1 == operand2,  "==");
  end func;


package require Tcl 8.5
namespace eval ternary {
    # Code generator
    proc maketable {name count values} {
	set sep ""
	for {set i 0; set c 97} {$i<$count} {incr i;incr c} {
	    set v [format "%c" $c]
	    lappend args $v; append key $sep "$" $v
	    set sep ","
	}
	foreach row [split $values \n] {
	    if {[llength $row]>1} {
		lassign $row from to
		lappend table $from [list return $to]
	    }
	}
	proc $name $args \
	    [list ckargs $args]\;[concat [list switch -glob --] $key [list $table]]
	namespace export $name
    }
    # Helper command to check argument syntax
    proc ckargs argList {
	foreach var $argList {
	    upvar 1 $var v
	    switch -exact -- $v {
		true - maybe - false {
		    continue
		}
		default {
		    return -level 2 -code error "bad ternary value \"$v\""
		}
	    }
	}
    }

    # The "truth" tables; “*” means “anything”
    maketable not 1 {
	true false
	maybe maybe
	false true
    }
    maketable and 2 {
	true,true true
	false,* false
	*,false false
	* maybe
    }
    maketable or 2 {
	true,* true
	*,true true
	false,false false
	* maybe
    }
    maketable implies 2 {
	false,* true
	*,true true
	true,false false
	* maybe
    }
    maketable equiv 2 {
	*,maybe maybe
	maybe,* maybe
	true,true true
	false,false true
	* false
    }
}


FUNCTION and3(a, b)
    IF a < b then LET and3 = a else LET and3 = b
END FUNCTION

FUNCTION eq3(a, b)
    IF a =  tDontknow or b = tDontKnow then
       LET eq3 = tdontknow
    ELSEIF a = b then
       LET eq3 = ttrue
    ELSE
       LET eq3 = tfalse
    END IF
END FUNCTION

FUNCTION longname3$(i)
    SELECT CASE i
    CASE 1
         LET longname3$ = "Don't know"
    CASE 2
         LET longname3$ = "True"
    CASE else
         LET longname3$ = "False"
    END SELECT
END FUNCTION

FUNCTION not3(b)
    LET not3 = 2-b
END FUNCTION

FUNCTION or3(a, b)
    IF a > b then LET or3 = a else LET or3 = b
END FUNCTION

FUNCTION shortname3$(i)
    LET shortname3$ = ("F?T")[i+1:i+1+1-1]
END FUNCTION

FUNCTION xor3(a, b)
    LET xor3 = not3(eq3(a,b))
END FUNCTION

LET tfalse = 0
LET tdontknow = 1
LET ttrue = 2

PRINT "Nombres cortos y largos para valores lógicos ternarios:"
FOR i = tfalse to ttrue
    PRINT shortname3$(i); "  "; longname3$(i)
NEXT i
PRINT
PRINT "Funciones de parámetro único"
PRINT "x"; " "; "=x"; "  "; "not(x)"
FOR i = tfalse to ttrue
    PRINT shortname3$(i); "  "; shortname3$(i); "    "; shortname3$(not3(i))
NEXT i
PRINT
PRINT "Funciones de doble parámetro"
PRINT "x"; " "; "y"; "  "; "x AND y"; "  "; "x OR y"; "  "; "x EQ y"; "  "; "x XOR y"
FOR a = tfalse to ttrue
    FOR b = tfalse to ttrue
        PRINT shortname3$(a); " "; shortname3$(b); "     ";
        PRINT shortname3$(and3(a,b)); "       "; shortname3$(or3(a,b)); "       ";
        PRINT shortname3$(eq3(a,b)); "        "; shortname3$(xor3(a,b))
    NEXT b
NEXT a
END


var False = -1
var Maybe =  0
var True  =  1
var Chrs  = ["F", "M", "T"]

class Trit {
    construct new(v) {
        if (v != False && v != Maybe && v != True) Fiber.abort("Invalid argument.")
        _v = v
    }

    v { _v }

    ! { Trit.new(-_v) }

    &(other)  { (_v < other.v) ? this : other }

    |(other)  { (_v > other.v) ? this : other }

    >>(other) { (-_v > other.v) ? !this : other }

    ==(other) { Trit.new(_v * other.v) }

    toString { Chrs[_v + 1] }
}

var trits = [Trit.new(True), Trit.new(Maybe), Trit.new(False)]

System.print("not")
System.print("-------")
for (t in trits) System.print(" %(t) | %(!t)")

System.print("\nand | T  M  F")
System.print("-------------")
for (t in trits) {
    System.write(" %(t)  | ")
    for (u in trits) System.write("%(t & u)  ")
    System.print()
}

System.print("\nor  | T  M  F")
System.print("-------------")
for (t in trits) {
    System.write(" %(t)  | ")
    for (u in trits) System.write("%(t | u)  ")
    System.print()
}

System.print("\nimp | T  M  F")
System.print("-------------")
for (t in trits) {
    System.write(" %(t)  | ")
    for (u in trits) System.write("%(t >> u)  ")
    System.print()
}

System.print("\neqv | T  M  F")
System.print("-------------")
for (t in trits) {
    System.write(" %(t)  | ")
    for (u in trits) System.write("%(t == u)  ")
    System.print()
}


tFalse = 0
tDontKnow = 1
tTrue = 2

sub not3(b)
	return 2-b
end sub

sub and3(a,b)
	return min(a,b)
end sub

sub or3(a,b)
	return max(a,b)
end sub

sub eq3(a,b)
    if a = tDontKnow or b = tDontKnow then
       return tDontKnow
    elsif a = b then
       return tTrue
    else
       return tFalse
    end if
end sub

sub xor3(a,b)
    return not3(eq3(a,b))
end sub

sub shortName3$(i)
    return mid$("F?T", i+1, 1)
end sub

sub longName3$(i)
    switch i
        case 1
            return "Don't know"
        case 2
            return "True"
        default
            return "False"
    end switch
end sub

print "Nombres cortos y largos para valores logicos ternarios:"
for i = tFalse to tTrue
    print shortName3$(i), "  ", longName3$(i)
next i
print

print "Funciones de parametro unico"
print "x", " ", "=x", "  ", "not(x)"
for i = tFalse to tTrue
    print shortName3$(i), "  ", shortName3$(i), "    ", shortName3$(not3(i))
next i
print

print "Funciones de doble parametro"
print "x"," ","y","  ","x AND y","  ","x OR y","  ","x EQ y","  ","x XOR y"
for a = tFalse to tTrue
    for b = tFalse to tTrue
        print shortName3$(a), " ", shortName3$(b), "     ";
        print shortName3$(and3(a,b)), "       ", shortName3$(or3(a,b)), "       ";
        print shortName3$(eq3(a,b)), "        ", shortName3$(xor3(a,b))
    next b
next a
end


PROC Main()
  BYTE CHBAS=$02F4 ;Character Base Register

  CHBAS=$CC ;set the international character set
  Position(2,2)
  Put(8) ;print the GBP currency sign
RETURN


with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters.Latin_1;

procedure Pound is
begin
   Put(Ada.Characters.Latin_1.Pound_Sign);
end Pound;


' Display extended character, pound sterling
LET c$ = UTF8$(0xA3)
PRINT c$


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

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

 /*******************************************/
/* Initialized data                         */
/*******************************************/
.data
szMessStartPgm:            .asciz "Program start \n"
szMessEndPgm:              .asciz "Program normal end.\n"
szMessMovePos:             .asciz "\033[6;3HHello\n"
szCarriageReturn:          .asciz "\n"
szCleax1:                  .byte 0x1B
                           .byte 'c'           // other console clear
                           .byte 0
/*******************************************/
/* UnInitialized data                      */
/*******************************************/
.bss
/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:

    ldr x0,qAdrszMessStartPgm                   // display start message
    bl affichageMess
    ldr x0,qAdrszCleax1
    bl affichageMess
    ldr x0,qAdrszMessMovePos
    bl affichageMess

    ldr x0,qAdrszMessEndPgm                     // display end message
    bl affichageMess

100:                                            // standard end of the program
    mov x0,0                                    // return code
    mov x8,EXIT                                 // request to exit program
    svc 0                                       // perform system call
qAdrszMessStartPgm:        .quad szMessStartPgm
qAdrszMessEndPgm:          .quad szMessEndPgm
qAdrszCarriageReturn:      .quad szCarriageReturn
qAdrszCleax1:              .quad szCleax1
qAdrszMessMovePos:         .quad szMessMovePos
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


PROC Main()
  Position(3,6)
  Print("Hello")
RETURN


with Ada.Text_IO;

procedure Cursor_Pos is

begin
   Ada.Text_IO.Set_Line(6);
   Ada.Text_IO.Set_Col(3);
   Ada.Text_IO.Put("Hello");
end Cursor_Pos;


#include <stdio.h>

int
main()
{
	puts("£");
	puts("\302\243"); /* if your terminal is utf-8 */
	return 0;
}


class Program
{
    static void Main()
    {
        System.Console.WriteLine("£");
    }
}


#include <iostream>

int main()
{
    std::cout << static_cast<char>(163); // pound sign
    return 0;
}


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

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

/* Initialized data */
.data
szMessStartPgm:            .asciz "Program start \n"
szMessEndPgm:              .asciz "Program normal end.\n"
szMessMovePos:             .asciz "\033[6;3HHello\n"
szCarriageReturn:          .asciz "\n"
szClear1:                  .byte 0x1B
                           .byte 'c'           @ other console clear
                           .byte 0
/* UnInitialized data */
.bss

/*  code section */
.text
.global main
main:

    ldr r0,iAdrszMessStartPgm                   @ display start message
    bl affichageMess
    ldr r0,iAdrszClear1
    bl affichageMess
    ldr r0,iAdrszMessMovePos
    bl affichageMess

    ldr r0,iAdrszMessEndPgm                     @ display end message
    bl affichageMess

100:                                            @ standard end of the program
    mov r0, #0                                  @ return code
    mov r7, #EXIT                               @ request to exit program
    svc 0                                       @ perform system call
iAdrszMessStartPgm:        .int szMessStartPgm
iAdrszMessEndPgm:          .int szMessEndPgm
iAdrszCarriageReturn:      .int szCarriageReturn
iAdrszClear1:              .int szClear1
iAdrszMessMovePos:         .int szMessMovePos

/******************************************************************/
/*     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


DllCall( "AllocConsole" ) ; create a console if not launched from one
hConsole := DllCall( "GetStdHandle", int, STDOUT := -11 )

DllCall("SetConsoleCursorPosition", UPtr, hConsole, UInt, (6 << 16) | 3)
WriteConsole(hConsole, "Hello")

MsgBox

WriteConsole(hConsole, text){
	VarSetCapacity(out, 16)
	If DllCall( "WriteConsole", UPtr, hConsole, Str, text, UInt, StrLen(text)
				  , UPtrP, out, uint, 0 )
		return out
	return 0
}


       IDENTIFICATION DIVISION.
       PROGRAM-ID. Display-Pound.

       PROCEDURE DIVISION.
       DISPLAY "£"

       GOBACK
       .


(format t "札幌~%")
(format t "~C~%" (code-char #x00A3))


import std.stdio;

void main() {
    writeln('\u00A3');
}


;; simplest
(display "£")
;; unicode character
(display "\u00a3")
;; HTML special character
(display "£")
;; CSS enhancement
(display "£" "color:blue;font-size:2em")


' Cursor positioning, requires ANSI compliant terminal
GOTOXY 3,6
PRINT "Hello"


# This will display a message at a specific position on the terminal screen
.begin
cursor 6,3
display "Hello!"
return
# This is the end of the script


#include <stdio.h>
int main()
{
	printf("\033[6;3HHello\n");
	return 0;
}


static void Main(string[] args)
{
    Console.SetCursorPosition(3, 6);
    Console.Write("Hello");
}


       IDENTIFICATION DIVISION.
       PROGRAM-ID. cursor-positioning.

       PROCEDURE DIVISION.
           DISPLAY "Hello" AT LINE 6, COL 3

           GOBACK
           .


package main

import "fmt"

func main() {
    fmt.Println("£")
}


module Main where
main = do
        putStrLn "£"
        putStrLn "札幌"


procedure main ()
  write ("£ " || char (163)) # £
end


   '£'
£
   '札幌'
札幌


import java.io.PrintStream;
import java.io.UnsupportedEncodingException;

public class Main
{
    public static void main(String[] args) throws UnsupportedEncodingException
    {
        PrintStream writer = new PrintStream(System.out, true, "UTF-8");
        writer.println("£");
        writer.println("札幌");
    }
}


println("£")
println("\302\243"); # works if your terminal is utf-8


(defun cursor-positioning ()
  (with-screen (scr :input-blocking t :input-echoing nil :cursor-visible nil)
      (move scr 5 2)
      (princ "Hello" scr)
      (refresh scr)
      ;; wait for keypress
      (get-char scr)))


Position the Cursor:
 \033[<L>;<C>H
    or
 \033[<L>;<C>f
puts the cursor at line L and column C.


public program()
{
    console.setCursorPosition(3,6).write("Hello")
}


open System

Console.SetCursorPosition(3, 6)
Console.Write("Hello")


program textposition
    use kernel32
    implicit none
    integer(HANDLE) :: hConsole
    integer(BOOL) :: q

    hConsole = GetStdHandle(STD_OUTPUT_HANDLE)
    q = SetConsoleCursorPosition(hConsole, T_COORD(3, 6))
    q = WriteConsole(hConsole, loc("Hello"), 5, NULL, NULL)
end program


// version 1.1.2

fun main(args:Array<String>) = println("£")


/* NetRexx */
options replace format comments java crossref symbols binary

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
  GBP = '\u00a3' -- unicode code point
  say GBP
  GBP = '£' -- if the editor's up to it
  say GBP
  GBP = 16x00a3 -- yet another way
  say (Rexx GBP).d2c
  return


echo "£"
echo "札幌"

import unicode
echo Rune(0xa3)


class Program {
  function : Main(args : String[]) ~ Nil {
    "£"->PrintLine();
  }
}


program pound;
uses crt;
begin
  write(chr( 163 ));
end.


package main

import (
    "bytes"
    "fmt"
    "os"
    "os/exec"
)

func main() {
    cmd := exec.Command("tput", "-S")
    cmd.Stdin = bytes.NewBufferString("clear\ncup 5 2")
    cmd.Stdout = os.Stdout
    cmd.Run()
    fmt.Println("Hello")
}


procedure main()
    writes(CUP(6,3), "Hello")
end

procedure CUP(i,j)
    writes("\^[[",i,";",j,"H")
    return
end


const ESC = "\u001B"

gotoANSI(x, y) = print("$ESC[$(y);$(x)H")

gotoANSI(3, 6)
println("Hello")


// version 1.1.2

fun main(args: Array<String>) {
    print("\u001Bc") // clear screen first
    println("\u001B[6;3HHello")
}


local(esc = decode_base64('Gw=='))

stdout( #esc + '[6;3HHello')


use feature 'say';

# OK as is
say '￡';

# these need 'binmode needed to surpress warning about 'wide' char
binmode STDOUT, ":utf8";
say "\N{FULLWIDTH POUND SIGN}";
say "\x{FFE1}";
say chr 0xffe1;


go =>
  println("£"),
  println(chr(163)),
  println("太極拳"), % Tàijíquán
  nl.


(prinl (char 26413) (char 24140))  # Sapporo


   declare pound character (1) static initial ('9c'x);
   put skip list (pound);


say '￡';
say "\x[FFE1]";
say "\c[FULLWIDTH POUND SIGN]";
0xffe1.chr.say;


import terminal
setCursorPos(3, 6)
echo "Hello"


#load "unix.cma"
#directory "+ANSITerminal"
#load "ANSITerminal.cma"

module Trm = ANSITerminal

let () =
  Trm.erase Trm.Screen;
  Trm.set_cursor 3 6;
  Trm.print_string [] "Hello";
;;


program cursor_pos;
uses crt;
begin
  gotoxy(6,3);
  write('Hello');
end.


use Term::Cap;

my $t = Term::Cap->Tgetent;
print $t->Tgoto("cm", 2, 5); # 0-based
print "Hello";


/*REXX program demonstrates  displaying an extended character  (glyph)  to the terminal.*/
                   /* [↓]  this  SAY will display the £ glyph (if the term supports it).*/
say '£'            /*this assumes the pound sign glyph is displayable on the terminal.  */
                   /*this program can execute correctly on an  EBCDIC or ASCII  machine.*/
                                                 /*stick a fork in it,  we're all done. */


# Project : Terminal control/Display an extended character

see "£"


#encoding: UTF-8  #superfluous in Ruby > 1.9.3
puts "£"


object ExtendedCharacter extends App {
  println("£")
  println("札幌")
}


$ include "seed7_05.s7i";
  include "console.s7i";

const proc: main is func
  local
    var text: console is STD_NULL;
  begin
    console := open(CONSOLE);
    write(console, "£");
    # Terminal windows often restore the previous
    # content, when a program is terminated. Therefore
    # the program waits until Return/Enter is pressed.
    readln;
  end func;


say '￡';
say "\x{FFE1}";
say "\N{FULLWIDTH POUND SIGN}";
say 0xffe1.chr;


module main;
  initial begin
      $display("£");
    end
endmodule


xidel -s -e 'parse-html("£ or &#xa3")'
£ or £


without js -- position
position(6,3)
puts(1,"Hello")


echo "\033[".$x.",".$y."H"; // Position line $y and column $x.
echo "\033[".$n."A"; // Up $n lines.
echo "\033[".$n."B"; // Down $n lines.
echo "\033[".$n."C"; // Forward $n columns.
echo "\033[".$n."D"; // Backward $n columns.
echo "\033[2J"; // Clear the screen, move to (0,0).


$Host.UI.RawUI.CursorPosition = New-Object System.Management.Automation.Host.Coordinates 2,5
$Host.UI.Write('Hello')


  [ number$ swap number$
    $ 'print("\033[' rot join
    char ; join
    swap join
    $ 'H", end="")' join
    python ]                   is cursor-at ( x y --> )

  3 6 cursor-at say "Hello"


#lang racket
(require (planet neil/charterm:3:0))
(with-charterm
 (charterm-clear-screen)
 (charterm-cursor 3 6)
 (displayln "Hello World"))


code ChOut=8;
ChOut(0, $9C)             \code for IBM PC's extended (OEM) character set


with console'
: hello 3 6 at-xy "Hello" puts ;


/*REXX program demonstrates moving the cursor position and writing of text to same place*/

call cursor  3,6                                 /*move the cursor to  row 3, column 6. */
say 'Hello'                                      /*write the text at that location.     */

call scrwrite 30,50,'Hello.'                     /*another method,  different location. */

call scrwrite 40,60,'Hello.',,,14                /*another method  ...  in yellow.      */
exit 0                                           /*stick a fork in it,  we're all done. */


# Project : Terminal control/Cursor positioning

for n = 1 to 5
     see nl
next
see "  Hello"


require 'curses'

Curses.init_screen
begin
  Curses.setpos(6, 3)  # column 6, row 3
  Curses.addstr("Hello")

  Curses.getch  # Wait until user presses some key.
ensure
  Curses.close_screen
end


object Main extends App {
    print("\u001Bc") // clear screen first
    println("\u001B[6;3HHello")
}


$ include "seed7_05.s7i";
  include "console.s7i";

const proc: main is func
  local
    var text: console is STD_NULL;
  begin
    console := open(CONSOLE);
    setPos(console, 6, 3);
    write(console, "Hello");
    # Terminal windows often restore the previous
    # content, when a program is terminated. Therefore
    # the program waits until Return/Enter is pressed.
    readln;
  end func;


exec tput cup 5 2 >/dev/tty
puts "Hello"


# The tput utility numbers from zero, so we have subtracted 1 from row and column
# number to obtain correct positioning.
tput cup 5 2


include c:\cxpl\codes;  \intrinsic 'code' declarations

[Cursor(2, 5);          \3rd column, 6th row
Text(0, "Hello");       \upper-left corner is coordinate 0, 0
]


System.write("\e[2J")        // clear the terminal
System.print("\e[6;3HHello") // move to (6, 3) and print 'Hello'


ld hl,&0603   ;6 = ROW, 3 = COLUMN
call &BB75              ;set text cursor according to HL

ld hl,Message
call PrintString

ret  ;return to basic

Message:
byte "Hello",0

PrintString:
ld a,(hl)   ;read a byte from the string
or a        ;check equality to zero
ret z       ;if equal to zero, we're done
call &BB5A  ;print accumulator as an ascii char to screen
inc hl      ;next char
jr PrintString


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

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

.equ TIOCGWINSZ,   0x5413
.equ IOCTL,        0x1D  // Linux syscall
/*******************************************/
/* Structures                               */
/********************************************/
/* structure terminal size */
    .struct  0
term_s_lines:                    // input modes
    .struct  term_s_lines + 2
term_s_cols:                    // output modes
    .struct  term_s_cols + 2
term_s_filler:                    // control modes
    .struct  term_s_filler + 12
term_fin:
/*******************************************/
/* Initialized data                        */
/*******************************************/
.data
szMessStartPgm:            .asciz "Program start \n"
szMessEndPgm:              .asciz "Program normal end.\n"
szMessResult:              .asciz "Terminal lines : @  cols : @ \n"
szMessErreur:              .asciz "\033[31mError IOCTL.\n"
szCarriageReturn:          .asciz "\n"
/*******************************************/
/* UnInitialized data                      */
/*******************************************/
.bss
.align 4
sZoneConv:         .skip 24
stTerminal:        .skip term_fin      // structure terminal
/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:
    ldr x0,qAdrszMessStartPgm                   //display start message
    bl affichageMess

     /* read terminal dimensions */
    mov x0,STDIN                   // input console
    mov x1,TIOCGWINSZ              // code IOCTL
    ldr x2,qAdrstTerminal          // structure address
    mov x8,IOCTL                   // call system Linux
    svc 0
    cbnz x0,98f                    // error ?

    ldr x2,qAdrstTerminal
    ldrh w0,[x2,term_s_lines]      // load two bytes
    ldr x1,qAdrsZoneConv
    bl conversion10                // and decimal conversion
    ldr x0,qAdrszMessResult
    bl strInsertAtChar             // and insertion in message
    mov x5,x0                      // save address of new message
    ldrh w0,[x2,term_s_cols]       // load two bytes
    ldr x1,qAdrsZoneConv
    bl conversion10                // and decimal conversion
    mov x0,x5                      // restaur address of message
    bl strInsertAtChar             // and insertion in message
    bl affichageMess

    ldr x0,qAdrszMessEndPgm        //display end message
    bl affichageMess
    b 100f
 98:                               // error display
    ldr x0,qAdrszMessErreur
    bl affichageMess
    mov x0,-1
100:                                            //standard end of the program
    mov x0,0                                    //return code
    mov x8,EXIT                                 //request to exit program
    svc 0                                       //perform system call
qAdrszMessStartPgm:        .quad szMessStartPgm
qAdrszMessEndPgm:          .quad szMessEndPgm
qAdrszMessErreur:          .quad szMessErreur
qAdrszCarriageReturn:      .quad szCarriageReturn
qAdrstTerminal:            .quad stTerminal
qAdrszMessResult:          .quad szMessResult
qAdrsZoneConv:             .quad sZoneConv
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


PROC Main()
  BYTE ROWCRS=$0054 ;Current cursor row
  CARD COLCRS=$0055 ;Current cursor column
  CARD width
  BYTE height

  Graphics(0)
  Position(0,0) ;go to the top-left corner
  Put(28) Put(30) ;go up and left - the bottom-right corner
  width=COLCRS+1
  height=ROWCRS+1

  Position(2,1)
  PrintF("Number of colums: %U%E",width)
  PrintF("Number of rows: %B%E",height)
RETURN


WIDTH = PEEK(33)
HEIGHT = PEEK(35) - PEEK(34)


print ["Terminal width:" terminal\width]
print ["Terminal height:" terminal\height]


DllCall( "AllocConsole" ) ; create a console if not launched from one
hConsole := DllCall( "GetStdHandle", int, STDOUT := -11 )

MsgBox Resize the console...

VarSetCapacity(csbi, 22) ; CONSOLE_SCREEN_BUFFER_INFO structure
DllCall("GetConsoleScreenBufferInfo", UPtr, hConsole, UPtr, &csbi)
Left   := NumGet(csbi, 10, "short")
Top    := NumGet(csbi, 12, "short")
Right  := NumGet(csbi, 14, "short")
Bottom := NumGet(csbi, 16, "short")

columns	:= right - left + 1
rows	:= bottom - top + 1
MsgBox %columns% columns and %rows% rows


' ANSI terminal dimensions
X = COLUMNS
Y = ROWS

PRINT "X,Y: ", X, ",", Y


@echo off

for /f "tokens=1,2 delims= " %%A in ('mode con') do (
	if "%%A"=="Lines:" set line=%%B
	if "%%A"=="Columns:" set cols=%%B
)

echo Lines: %line%
echo Columns: %cols%
exit /b 0


      dx% = @vdu.tr%[email protected]% : REM Width of text viewport in pixels
      dy% = @vdu.tb%[email protected]% : REM Height of text viewport in pixels


#include <sys/ioctl.h>	/* ioctl, TIOCGWINSZ */
#include <err.h>	/* err */
#include <fcntl.h>	/* open */
#include <stdio.h>	/* printf */
#include <unistd.h>	/* close */

int
main()
{
	struct winsize ws;
	int fd;

	/* Open the controlling terminal. */
	fd = open("/dev/tty", O_RDWR);
	if (fd < 0)
		err(1, "/dev/tty");

	/* Get window size of terminal. */
	if (ioctl(fd, TIOCGWINSZ, &ws) < 0)
		err(1, "/dev/tty");

	printf("%d rows by %d columns\n", ws.ws_row, ws.ws_col);
	printf("(%d by %d pixels)\n", ws.ws_xpixel, ws.ws_ypixel);

	close(fd);
	return 0;
}


static void Main(string[] args)
{
    int bufferHeight = Console.BufferHeight;
    int bufferWidth = Console.BufferWidth;
    int windowHeight = Console.WindowHeight;
    int windowWidth = Console.WindowWidth;

    Console.Write("Buffer Height: ");
    Console.WriteLine(bufferHeight);
    Console.Write("Buffer Width: ");
    Console.WriteLine(bufferWidth);
    Console.Write("Window Height: ");
    Console.WriteLine(windowHeight);
    Console.Write("Window Width: ");
    Console.WriteLine(windowWidth);
    Console.ReadLine();
}


       IDENTIFICATION DIVISION.
       PROGRAM-ID. terminal-dimensions.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  num-lines PIC 9(3).
       01  num-cols  PIC 9(3).

       SCREEN SECTION.
       01  display-screen.
           03  LINE 01 COL 01 PIC 9(3) FROM num-lines.
           03  LINE 01 COL 05 VALUE "rows by " .
           03  LINE 01 COL 13 PIC 9(3) FROM num-cols.
           03  LINE 01 COL 16 VALUE " columns.".

       PROCEDURE DIVISION.
           ACCEPT num-lines FROM LINES
           ACCEPT num-cols FROM COLUMNS

           DISPLAY display-screen

      *    This pauses the program, as ncurses will immediately revert
      *    back to the console when the program ends.
           CALL "C$SLEEP" USING BY CONTENT 3

           GOBACK
           .


(defun screen-dimensions ()
  (with-screen (scr :input-blocking t :input-echoing nil :cursor-visible nil)
    (let ((width (width scr))
          (height (height scr)))
      (format scr "The current terminal screen is ~A lines high, ~A columns wide.~%~%" height width)
      (refresh scr)
      ;; wait for keypress
      (get-char scr))))


include graphics.e

sequence vc
integer term_height, term_width

vc = video_config()

term_height = vc[VC_LINES]
term_width  = vc[VC_COLUMNS]

printf(1,"Terminal height is %d\n",term_height)
printf(1,"Terminal width is %d\n",term_width)


open System

let bufferHeight = Console.BufferHeight
let bufferWidth = Console.BufferWidth
let windowHeight = Console.WindowHeight
let windowWidth = Console.WindowWidth

Console.Write("Buffer Height: ")
Console.WriteLine(bufferHeight)
Console.Write("Buffer Width: ")
Console.WriteLine(bufferWidth)
Console.Write("Window Height: ")
Console.WriteLine(windowHeight)
Console.Write("Window Width: ")
Console.WriteLine(windowWidth)
Console.ReadLine()


variable term-width
variable term-height

s" gforth" environment? [if]
  2drop form ( height width )
[else]  \ SwiftForth
  get-size ( width height ) swap
[then]
term-width ! term-height !


Dim As Integer w, h, p, bpp, tasa
Dim driver_name As String
Screeninfo w, h, p, bpp, , tasa

Print !"Informaci¢n sobre el escritorio (terminal):\n"
Print " Ancho de la terminal: "; w; " (pixel)"
Print "Altura de la terminal: "; h; " (pixel)"
Print " Profundidad de color: "; p; " (bits)"
Print "     Tasa de refresco: "; tasa; " (Hz)"

' Sets screen mode 13 (640*480, 8bpp)
Screen 12
Screeninfo w, h, p, bpp, , tasa, driver_name

Print !"Informaci¢n sobre el modo gr fico:\n"
Print " Ancho de la pantalla: "; w; " (pixel)"
Print "Altura de la pantalla: "; h; " (pixel)"
Print " Profundidad de color: "; p; " (bits)"
Print "      Bytes por pixel: "; bpp
Print "     Tasa de refresco: "; tasa; " (Hz)"
Print "    Nombre del driver: "; driver_name
Sleep


package main

import (
    "fmt"
    "os"

    "golang.org/x/crypto/ssh/terminal"
)

func main() {
    w, h, err := terminal.GetSize(int(os.Stdout.Fd()))
    if err != nil {
        fmt.Println(err)
        return
    }
    fmt.Println(h, w)
}


julia> using Gtk

julia> screen_size()
(3840, 1080)

julia>


// version 1.1.2

/*
    I needed to execute the terminal command: 'export COLUMNS LINES'
    before running this program for it to work (returned 'null' sizes otherwise).
*/

fun main(args: Array<String>) {
    val lines = System.getenv("LINES")
    val columns = System.getenv("COLUMNS")
    println("Lines   = $lines")
    println("Columns = $columns")
}


WIDTH=RunThrough["tput cols", ""];
HEIGHT=RunThrough["tput lines", ""];


import terminal

let (width, height) = terminalSize()

echo "Terminal width: ", width
echo "Terminal height: ", height


$ ocaml unix.cma -I +ANSITerminal ANSITerminal.cma

# let width, height = ANSITerminal.size () ;;
val width : int = 126
val height : int = 47


use Term::Size;

($cols, $rows) = Term::Size::chars;
print "The terminal has $cols columns and $rows lines\n";


without js -- (video_config)
sequence vc = video_config()
printf(1,"Terminal buffer height is %d\n",vc[VC_LINES])
printf(1,"Terminal buffer width is %d\n",vc[VC_COLUMNS])
printf(1,"Terminal screen height is %d\n",vc[VC_SCRNLINES])
printf(1,"Terminal screen width is %d\n",vc[VC_SCRNCOLS])


(setq
   Width (in '(tput cols) (read))
   Height (in '(tput lines) (read)) )


Macro ConsoleHandle()
  GetStdHandle_( #STD_OUTPUT_HANDLE )
EndMacro

Procedure ConsoleWidth()
  Protected CBI.CONSOLE_SCREEN_BUFFER_INFO
  Protected hConsole = ConsoleHandle()
  GetConsoleScreenBufferInfo_( hConsole, @CBI )
  ProcedureReturn CBI\srWindow\right - CBI\srWindow\left + 1
EndProcedure

Procedure ConsoleHeight()
  Protected CBI.CONSOLE_SCREEN_BUFFER_INFO
  Protected hConsole = ConsoleHandle()
  GetConsoleScreenBufferInfo_( hConsole, @CBI )
  ProcedureReturn CBI\srWindow\bottom - CBI\srWindow\top + 1
EndProcedure

If OpenConsole()
  x$=Str(ConsoleWidth())
  y$=Str(ConsoleHeight())
  PrintN("This window is "+x$+"x"+y$+ " chars.")
  ;
  Print(#CRLF$+"Press ENTER to exit"):Input()
EndIf


import os

def get_windows_terminal():
    from ctypes import windll, create_string_buffer
    h = windll.kernel32.GetStdHandle(-12)
    csbi = create_string_buffer(22)
    res = windll.kernel32.GetConsoleScreenBufferInfo(h, csbi)

    #return default size if actual size can't be determined
    if not res: return 80, 25

    import struct
    (bufx, bufy, curx, cury, wattr, left, top, right, bottom, maxx, maxy)\
    = struct.unpack("hhhhHhhhhhh", csbi.raw)
    width = right - left + 1
    height = bottom - top + 1

    return width, height

def get_linux_terminal():
    width = os.popen('tput cols', 'r').readline()
    height = os.popen('tput lines', 'r').readline()

    return int(width), int(height)

print get_linux_terminal() if os.name == 'posix' else get_windows_terminal()


#lang racket
(require (planet neil/charterm:3:0))
(with-charterm
 (charterm-screen-size))


my $stty = qx[stty -a];
my $lines = $stty.match(/ 'rows '    <( \d+/);
my $cols  = $stty.match(/ 'columns ' <( \d+/);
say "$lines $cols";


-3 5 out wait 5 in !cw
-4 5 out wait 5 in !ch


width = 'tput'( 'cols' )
height = 'tput'( 'lines' )

say 'The terminal is' width 'characters wide'
say 'and has' height 'lines'


def winsize
  # Ruby 1.9.3 added 'io/console' to the standard library.
  require 'io/console'
  IO.console.winsize
rescue LoadError
  # This works with older Ruby, but only with systems
  # that have a tput(1) command, such as Unix clones.
  [Integer(`tput li`), Integer(`tput co`)]
end

rows, cols = winsize
printf "%d rows by %d columns\n", rows, cols


  /*
     First execute the terminal command: 'export COLUMNS LINES'
     before running this program for it to work (returned 'null' sizes otherwise).
 */

    val (lines, columns)  = (System.getenv("LINES"), System.getenv("COLUMNS"))
    println(s"Lines   = $lines, Columns = $columns")


$ include "seed7_05.s7i";
  include "console.s7i";

const proc: main is func
  local
    var text: console is STD_NULL;
  begin
    console := open(CONSOLE);
    writeln(console, "height: " <& height(console) lpad 3);
    writeln(console, "width:  " <& width(console) lpad 3);
    # Terminal windows often restore the previous
    # content, when a program is terminated. Therefore
    # the program waits until Return/Enter is pressed.
    readln;
  end func;


var stty = `stty -a`;
var lines = stty.match(/\brows\h+(\d+)/);
var cols  = stty.match(/\bcolumns\h+(\d+)/);
say "#{lines} #{cols}";


set width [exec tput cols]
set height [exec tput lines]
puts "The terminal is $width characters wide and has $height lines"


#!/bin/sh
WIDTH=`tput cols`
HEIGHT=`tput lines`
echo "The terminal is $WIDTH characters wide and has $HEIGHT lines."


Module Module1

    Sub Main()
        Dim bufferHeight = Console.BufferHeight
        Dim bufferWidth = Console.BufferWidth
        Dim windowHeight = Console.WindowHeight
        Dim windowWidth = Console.WindowWidth

        Console.Write("Buffer Height: ")
        Console.WriteLine(bufferHeight)
        Console.Write("Buffer Width: ")
        Console.WriteLine(bufferWidth)
        Console.Write("Window Height: ")
        Console.WriteLine(windowHeight)
        Console.Write("Window Width: ")
        Console.WriteLine(windowWidth)
    End Sub

End Module


/* terminal_control_dimensions.wren */

class C {
    foreign static terminalWidth
    foreign static terminalHeight
}

var w = C.terminalWidth
var h = C.terminalHeight
System.print("The dimensions of the terminal are:")
System.print("   Width  = %(w)")
System.print("   Height = %(h)")


include c:\cxpl\codes;
int W, H;
[W:= Peek($40, $4A);            \IBM-PC BIOS data
 H:= Peek($40, $84) + 1;
Text(0, "Terminal width and height = ");
IntOut(0, W);  ChOut(0, ^x);  IntOut(0, H);
]


clear screen
w = peek("screenwidth")
h = peek("screenheight")
print "Informaci¢n sobre el escritorio (terminal):"
print " Ancho de la terminal: ", w, " (pixel)"
print "Altura de la terminal: ", h, " (pixel)"

open window 640,480
w = peek("winheight")
h = peek("winwidth")
print "\n\nInformaci¢n sobre el modo gr fico:"
print " Ancho de la pantalla: ", w, " (pixel)"
print "Altura de la pantalla: ", h, " (pixel)\n"
close window


h,w:=System.popen("stty size","r").readln().split();
println(w," x ",h);


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

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

/* Initialized data */
.data
szMessStartPgm:            .asciz "Program start \n"
szMessEndPgm:              .asciz "Program normal end.\n"
szMessColorRed:            .asciz "Color red.\n"
szCodeInit:                .asciz "\033[0m"                    // color reinit
szCodeRed:                 .asciz "\033[31m"                   // color red
szCodeBlue:                .asciz "\033[34m"                   // color blue
szMessMove:                .asciz "\033[A\033[6CBlue Message up and 6 location right."
szMessMoveDown:            .asciz "\033[31m\033[BRed text location down"
szMessTopLeft:             .asciz "\033[;HTOP LEFT"
szCarriageReturn:          .asciz "\n"

/* UnInitialized data */
.bss

/*  code section */
.text
.global main
main:

    ldr x0,qAdrszMessStartPgm                   // display start message
    bl affichageMess
    ldr x0,qAdrszCodeRed                        // color red
    bl affichageMess
    ldr x0,qAdrszMessColorRed
    bl affichageMess
    ldr x0,qAdrszCodeBlue
    bl affichageMess
    ldr x0,qAdrszMessMove
    bl affichageMess
    ldr x0,qAdrszMessMoveDown                   // move pointer down
    bl affichageMess
    ldr x0,qAdrszMessTopLeft
    bl affichageMess
    ldr x0,qAdrszCarriageReturn                 // start next line
    bl affichageMess
    ldr x0,qAdrszCodeInit                       // color reinitialize
    bl affichageMess
    ldr x0,qAdrszMessEndPgm                     // display end message
    bl affichageMess

100:                                            // standard end of the program
    mov x0,0                                    // return code
    mov x8,EXIT                                 // request to exit program
    svc 0                                       // perform system call
qAdrszMessStartPgm:        .quad szMessStartPgm
qAdrszMessEndPgm:          .quad szMessEndPgm
qAdrszCodeInit:            .quad szCodeInit
qAdrszCodeRed:             .quad szCodeRed
qAdrszCodeBlue:            .quad szCodeBlue
qAdrszMessColorRed:        .quad szMessColorRed
qAdrszMessMove:            .quad szMessMove
qAdrszCarriageReturn:      .quad szCarriageReturn
qAdrszMessMoveDown:        .quad szMessMoveDown
qAdrszMessTopLeft:         .quad szMessTopLeft
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


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

PROC Main()
  BYTE
    d=[50],
    CH=$02FC, ;Internal hardware value for last key pressed
    ROWCRS=$0054 ;Current cursor row
  CARD COLCRS=$0055 ;Current cursor column

  Graphics(0)
  Position(2,2)
  Print("Press any key to start demonstration.")
  Position(20,10)
  Put(28) Put(29) ;trick to show the new cursor pos
  DO UNTIL CH#$FF OD
  CH=$FF

  Wait(d) Put(30) ;move cursor left
  Wait(d) Put(31) ;move cursor right
  Wait(d) Put(28) ;move cursor up
  Wait(d) Put(29) ;move cursor down

  Wait(d) Position(0,ROWCRS) ;move to the beginning of the line
  Put(28) Put(29) ;trick to show the new cursor pos

  Wait(d) Position(39,ROWCRS) ;move to the end of the line
  Put(28) Put(29) ;trick to show the new cursor pos

  Wait(d) Position(0,0) ;move to the top-left corner
  Put(28) Put(29) ;trick to show the new cursor pos

  Wait(d) Position(39,23) ;move to the bottom-right corner
  Put(29) Put(28) ;trick to show the new cursor pos

  Wait(d)
RETURN


with Ada.Text_Io;

with Ansi;

procedure Movement is
   use Ada.Text_Io;
begin
   Put (Ansi.Store);
   Put (Ansi.Position (Row => 20, Column => 40));

   for A in 1 .. 15 loop
      Put (Ansi.Back);
      delay 0.020;
   end loop;

   for A in 1 .. 15 loop
      Put (Ansi.Up);
      delay 0.050;
   end loop;

   for A in 1 .. 15 loop
      Put (Ansi.Forward);
      delay 0.020;
   end loop;

   for A in 1 .. 15 loop
      Put (Ansi.Down);
      delay 0.050;
   end loop;

   delay 1.000;
   Put (Ansi.Horizontal (Column => 1));
   delay 2.000;
   Put (Ansi.Position (1, 1));
   delay 2.000;
   Put (Ansi.Restore);
end Movement;


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

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

/* Initialized data */
.data
szMessStartPgm:            .asciz "Program start \n"
szMessEndPgm:              .asciz "Program normal end.\n"
szMessColorRed:            .asciz "Color red.\n"
szCodeInit:                .asciz "\033[0m"                    @ color reinit
szCodeRed:                 .asciz "\033[31m"                   @ color red
szCodeBlue:                .asciz "\033[34m"                   @ color blue
szMessMove:                .asciz "\033[A\033[6CBlue Message up and 6 location right."
szMessMoveDown:            .asciz "\033[31m\033[BRed text location down"
szMessTopLeft:             .asciz "\033[;HTOP LEFT"
szCarriageReturn:          .asciz "\n"

/* UnInitialized data */
.bss

/*  code section */
.text
.global main
main:

    ldr r0,iAdrszMessStartPgm                   @ display start message
    bl affichageMess
    ldr r0,iAdrszCodeRed                        @ color red
    bl affichageMess
    ldr r0,iAdrszMessColorRed
    bl affichageMess
    ldr r0,iAdrszCodeBlue
    bl affichageMess
    ldr r0,iAdrszMessMove
    bl affichageMess
    ldr r0,iAdrszMessMoveDown                   @ move pointer down
    bl affichageMess
    ldr r0,iAdrszMessTopLeft
    bl affichageMess
    ldr r0,iAdrszCarriageReturn                 @ start next line
    bl affichageMess
    ldr r0,iAdrszCodeInit                       @ color reinitialize
    bl affichageMess
    ldr r0,iAdrszMessEndPgm                     @ display end message
    bl affichageMess

100:                                            @ standard end of the program
    mov r0, #0                                  @ return code
    mov r7, #EXIT                               @ request to exit program
    svc 0                                       @ perform system call
iAdrszMessStartPgm:        .int szMessStartPgm
iAdrszMessEndPgm:          .int szMessEndPgm
iAdrszCodeInit:            .int szCodeInit
iAdrszCodeRed:             .int szCodeRed
iAdrszCodeBlue:            .int szCodeBlue
iAdrszMessColorRed:        .int szMessColorRed
iAdrszMessMove:            .int szMessMove
iAdrszCarriageReturn:      .int szCarriageReturn
iAdrszMessMoveDown:        .int szMessMoveDown
iAdrszMessTopLeft:         .int szMessTopLeft

/******************************************************************/
/*     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


DllCall("AllocConsole")
hConsole:=DllCall("GetConsoleWindow","UPtr")
Stdout:=FileOpen(DllCall("GetStdHandle", "int", -11, "ptr"), "h `n")
Stdin:=FileOpen(DllCall("GetStdHandle", "int", -10, "ptr"), "h `n")

;move the cursor one position to the left
GetPos(x,y)
SetPos(x-1)

;move the cursor one position to the right
GetPos(x,y)
SetPos(x+1)

;move the cursor up one line (without affecting its horizontal position)
GetPos(x,y)
SetPos(x,y-1)

;move the cursor down one line (without affecting its horizontal position)
GetPos(x,y)
SetPos(x,y+1)

;move the cursor to the beginning of the line
GetPos(x,y)
SetPos(0,y)

;move the cursor to the end of the line
;requires previous knowledge of screen width -- typically 80
SetPos(79) ;minus 1 because origin is (0,0)

;move the cursor to the top left corner of the screen
SetPos(0,0)

;move the cursor to the bottom right corner of the screen
GetConsoleSize(w,h)
SetPos(w-1,h-1) ;minus 1 because origin is (0,0)

GetPos(ByRef x, ByRef y) {
	global Stdout
	VarSetCapacity(struct,22,0)
	e:=DllCall("GetConsoleScreenBufferInfo","UPtr",Stdout.__Handle,"Ptr",&struct)
	if (!e) or (ErrorLevel)
			return 0 ;Failure
	x:=NumGet(&struct,4,"UShort")
	y:=NumGet(&struct,6,"UShort")
	return 1
}

SetPos(x="",y="") {
	global Stdout
	GetPos(ox,oy)
	if x is not Integer
			x:=ox
	if y is not Integer
			y:=oy
	VarSetCapacity(struct,4,0)
	Numput(x,struct,"UShort")
	Numput(y,struct,2,"UShort")
	e:=DllCall("SetConsoleCursorPosition","Ptr",Stdout.__Handle,"uint",Numget(struct,"uint"))
	if (!e) or (ErrorLevel)
			return 0 ;Failure
	return 1
}

GetConsoleSize(ByRef bufferwidth, ByRef bufferheight) {
	global Stdout
	VarSetCapacity(struct,22,0)
	x:=DllCall("GetConsoleScreenBufferInfo","UPtr",Stdout.__Handle,"Ptr",&struct)
	if (!x) or (ErrorLevel)
		return 0 ;Failure
	bufferwidth:=NumGet(&struct,"UShort")
	bufferheight:=NumGet(&struct,2,"UShort")
	return 1
}


JSR $C004C2    ;clear the FIX layer
JSR $C004C8    ;clear hardware sprites


putch:	equ	2	; CP/M 'putchar' syscall
bdos:	equ	5	; CP/M BDOS entry point
FF:	equ	12	; ASCII form feed
	org	100h
	mvi	c,putch	; Print character (syscall goes in C register)
	mvi	e,FF	; Form feed (argument goes in E register)
	jmp	bdos	; Call CP/M BDOS and quit


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

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

.equ BUFFERSIZE,          100
/*******************************************/
/* Initialized data                        */
/*******************************************/
.data
szMessStartPgm:            .asciz "Program start \n"
szMessEndPgm:              .asciz "Program normal end.\n"
szClear:                   .asciz "\33[2J"     // console clear (id language C)
szClear1:                  .byte 0x1B
                           .byte 'c'           // other console clear
                           .byte 0
szCarriageReturn:          .asciz "\n"
/*******************************************/
/* UnInitialized data                      */
/*******************************************/
.bss
/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:

    ldr x0,qAdrszMessStartPgm                   // display start message
    bl affichageMess
    //ldr x0,qAdrszClear                        // clear screen
    ldr x0,qAdrszClear1                         // change for other clear screen
    bl affichageMess
    ldr x0,qAdrszMessEndPgm                     // display end message
    bl affichageMess

100:                                            // standard end of the program
    mov x0,0                                    // return code
    mov x8,EXIT                                 // request to exit program
    svc 0                                       // perform system call
qAdrszMessStartPgm:       .quad szMessStartPgm
qAdrszMessEndPgm:         .quad szMessEndPgm
qAdrszClear:              .quad szClear
qAdrszClear1:             .quad szClear1
qAdrszCarriageReturn:     .quad szCarriageReturn
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


with Ada.Text_IO;
procedure CLS is
begin
   Ada.Text_IO.Put(ASCII.ESC & "[2J");
end CLS;


Output(X-1,Y)
Output(X+1,Y)
Output(X,Y-1)
Output(X,Y+1)
Output(0,Y)
Output(15,Y)
Output(0,0)
Output(15,7)


' ANSI terminal cursor movement
' Default number of positions, if not specified, is 1.

' Left 1 position, blocks at first position
CURSOR BACK 1

' Right 1, blocks at end of line
CURSOR FORWARD 1

' Up 1, column uneffected, blocks at top
CURSOR UP 1

' Down 1, column uneffected, until scroll at bottom
CURSOR DOWN 1

' First column of current row
R = GETY
GOTOXY 1,R

' Last column of current row
C = COLUMNS
GOTOXY C,R

' Home position, top left
GOTOXY 1,1

' Bottom right
R = ROWS
GOTOXY C,R


10 'move left
20 LOCATE , POS(0) - 1
30 'move right
40 LOCATE , POS(0) + 1
50 'move up
60 LOCATE CSRLIN - 1
70 'move down
80 LOCATE CSRLIN + 1
900 'beginning of line
100 LOCATE , 1
110 'end of line; requires previous knowledge of screen width -- typically 80
120 LOCATE , 80
130 'top left corner
140 LOCATE 1, 1
150 'bottom right corner; requires knowledge of screen dimensions (80x25 here)
160 LOCATE 25, 80


      VDU 8    : REM Move one position to the left
      VDU 9    : REM Move one position to the right
      VDU 11   : REM Move up one line
      VDU 10   : REM Move down one line
      VDU 13   : REM Move to the beginning of the line
      VDU 30   : REM Move to the top left corner
      VDU 23,16,16;0;0;0; : REM Disable scrolling
      VDU 13,8,10 : REM Move to the end of the line
      VDU 30,8 : REM Move to the bottom right corner
      VDU 23,16,0;0;0;0; : REM Enable scrolling