import "io" for File
import "/pattern" for Pattern
import "/fmt" for Fmt

var p = Pattern.new("+1/s")
var fileName = "readings.txt"
var lines = File.read(fileName).trimEnd().split("\r\n")
var f = "Line:  $s  Reject: $2d  Accept: $2d  Line_tot: $8.3f  Line_avg: $7.3f"
var grandTotal = 0
var readings = 0
var date = ""
var run = 0
var maxRun = -1
var finishLine = ""
for (line in lines) {
    var fields = p.splitAll(line)
    date = fields[0]
    if (fields.count == 49) {
        var accept = 0
        var total = 0
        var i = 1
        while (i < fields.count) {
            if (Num.fromString(fields[i+1]) >= 1) {
                accept = accept + 1
                total = total + Num.fromString(fields[i])
                if (run > maxRun) {
                    maxRun = run
                    finishLine = date
                }
                run = 0
            } else {
                run = run + 1
            }
            i = i + 2
        }
        grandTotal = grandTotal + total
        readings = readings + accept
        Fmt.print(f, date, 24-accept, accept, total, total/accept)
    } else {
        Fmt.print("Line:  $s does not have 49 fields and has been ignored", date)
    }
}

if (run > maxRun) {
    maxRun = run
    finishLine = date
}
var average = grandTotal / readings
Fmt.print("\nFile     = $s", fileName)
Fmt.print("Total    = $0.3f", grandTotal)
Fmt.print("Readings = $d", readings)
Fmt.print("Average  = $0.3f", average)
Fmt.print("\nMaximum run of $d consecutive false readings", maxRun)
Fmt.print("ends at line starting with date: $s", finishLine)


package require Tcl 8.6

oo::class create ISAAC {
    variable aa bb cc mm randrsl randcnt

    constructor {seed} {
	namespace eval tcl {
	    namespace eval mathfunc {
		proc mm {idx} {
		    upvar 1 mm list
		    lindex $list [expr {$idx % [llength $list]}]
		}
		proc clamp {value} {
		    expr {$value & 0xFFFFFFFF}
		}
	    }
	}
	proc mix1 {i v} {
	    upvar 1 a a
	    lset a $i [expr {clamp([lindex $a $i] ^ $v)}]
	    lset a [set idx [expr {($i+3)%8}]] \
		[expr {clamp([lindex $a $idx] + [lindex $a $i])}]
	    lset a [set idx [expr {($i+1)%8}]] \
		[expr {clamp([lindex $a $idx] + [lindex $a [expr {($i+2)%8}]])}]
	}

	binary scan $seed[string repeat \u0000 256] c256 randrsl
	set mm [lrepeat 256 0]
	set randcnt [set aa [set bb [set cc 0]]]

	set a [lrepeat 8 0x9e3779b9]
	foreach i {1 2 3 4} {
	    mix1 0 [expr {[lindex $a 1] << 11}]
	    mix1 1 [expr {[lindex $a 2] >> 2}]
	    mix1 2 [expr {[lindex $a 3] << 8}]
	    mix1 3 [expr {[lindex $a 4] >> 16}]
	    mix1 4 [expr {[lindex $a 5] << 10}]
	    mix1 5 [expr {[lindex $a 6] >> 4}]
	    mix1 6 [expr {[lindex $a 7] << 8}]
	    mix1 7 [expr {[lindex $a 0] >> 9}]
	}
	for {set i 0} {$i < 256} {incr i 8} {
	    set a [lmap av $a bv [lrange $randrsl $i [expr {$i+7}]] {
		expr {clamp($av + $bv)}
	    }]
	    mix1 0 [expr {[lindex $a 1] << 11}]
	    mix1 1 [expr {[lindex $a 2] >> 2}]
	    mix1 2 [expr {[lindex $a 3] << 8}]
	    mix1 3 [expr {[lindex $a 4] >> 16}]
	    mix1 4 [expr {[lindex $a 5] << 10}]
	    mix1 5 [expr {[lindex $a 6] >> 4}]
	    mix1 6 [expr {[lindex $a 7] << 8}]
	    mix1 7 [expr {[lindex $a 0] >> 9}]
	    for {set j 0} {$j < 8} {incr j} {
		lset mm [expr {$i+$j}] [lindex $a $j]
	    }
	}
	for {set i 0} {$i < 256} {incr i 8} {
	    set a [lmap av $a bv [lrange $mm $i [expr {$i+7}]] {
		expr {clamp($av + $bv)}
	    }]
	    mix1 0 [expr {[lindex $a 1] << 11}]
	    mix1 1 [expr {[lindex $a 2] >> 2}]
	    mix1 2 [expr {[lindex $a 3] << 8}]
	    mix1 3 [expr {[lindex $a 4] >> 16}]
	    mix1 4 [expr {[lindex $a 5] << 10}]
	    mix1 5 [expr {[lindex $a 6] >> 4}]
	    mix1 6 [expr {[lindex $a 7] << 8}]
	    mix1 7 [expr {[lindex $a 0] >> 9}]
	    for {set j 0} {$j < 8} {incr j} {
		lset mm [expr {$i+$j}] [lindex $a $j]
	    }
	}
	my Step
    }

    method Step {} {
	incr bb [incr cc]
	set i -1
	foreach x $mm {
	    set shift [lindex {13 -6 2 -16} [expr {[incr i] % 4}]]
	    set aa [expr {$aa ^ ($shift>0 ? $aa<<$shift : $aa>>-$shift)}]
	    set aa [expr {clamp($aa + mm($i+128))}]
	    set y [expr {clamp(mm($x>>2) + $aa + $bb)}]
	    lset mm $i $y
	    set bb [expr {clamp(mm($y>>10) + $x)}]
	    lset randrsl $i $bb
	}
    }

    method random {} {
	set r [lindex $randrsl $randcnt]
	if {[incr randcnt] == 256} {
	    my Step
	    set randcnt 0
	}
	return $r
    }

    method RandA {} {
	expr {([my random] % 95) + 32}
    }
    method vernam {msg} {
	binary scan $msg c* b
	for {set i 0} {$i < [llength $b]} {incr i} {
	    lset b $i [expr {[lindex $b $i] & 255 ^ [my RandA]}]
	}
	return [binary encode hex [binary format c* $b]]
    }
}


tmpx -i inverse-video.s -o inverse-video.prg


PROC PrintInv(CHAR ARRAY a)
  BYTE i

  IF a(0)>0 THEN
    FOR i=1 TO a(0)
    DO
      Put(a(i)%$80)
    OD
  FI
RETURN

PROC Main()
  Position(2,2)

  PrintInv("Inverse")
  Print(" video")
RETURN


use std::io::{stdout, Write};
use std::time::Duration;

fn main() {
    let mut output = stdout();

    print!("\x1b[?1049h\x1b[H");
    println!("Alternate screen buffer");

    for i in (1..=5).rev() {
        print!("\rgoing back in {}...", i);
        output.flush().unwrap();
        std::thread::sleep(Duration::from_secs(1));
    }

    print!("\x1b[?1049l");
}


print("\033[?1049h\033[H")
println("Alternate buffer!")

for (i <- 5 to 0 by -1) {
    println(s"Going back in: $i")
    Thread.sleep(1000)
}

print("\033[?1049l")


print "\e[?1049h\e[H";
say "Alternate buffer!";

3.downto(1).each { |i|
    say "Going back in: #{i}";
    Sys.sleep(1);
}

print "\e[?1049l";


public let CSI = ESC+"["   // Control Sequence Introducer
func write(_ text: String...) {
  for txt in text { write(STDOUT_FILENO, txt, txt.utf8.count) }
}
write(CSI,"?1049h") // open alternate screen
print("Alternate screen buffer\n")
for n in (1...5).reversed() {
    print("Going back in \(n)...")
    sleep(1)
}
write(CSI,"?1049l") // close alternate screen


# A helper to make code more readable
proc terminal {args} {
    exec /usr/bin/tput {*}$args >/dev/tty
}

# Save the screen with the "enter_ca_mode" capability, a.k.a. 'smcup'
terminal smcup
# Some indication to users what is happening...
puts "This is the top of a blank screen. Press Return/Enter to continue..."
gets stdin
# Restore the screen with the "exit_ca_mode" capability, a.k.a. 'rmcup'
terminal rmcup


#!/bin/sh
tput smcup    # Save the display
echo 'Hello'
sleep 5       # Wait five seconds
tput rmcup    # Restore the display


import "io" for Stdout
import "timer" for Timer

System.write("\e[?1049h\e[H")
System.print("Alternate screen buffer")
for (i in 5..1) {
    var s = (i != 1) ? "s" : ""
    System.write("\rGoing back in %(i) second%(s)...")
    Stdout.flush()
    Timer.sleep(1000)
}
System.write("\e[?1049l")


die "Terminal can't handle UTF-8"
    unless $ENV{LC_ALL} =~ /utf-8/i or $ENV{LC_CTYPE} =~ /utf-8/i or $ENV{LANG} =~ /utf-8/i;

print "△ \n";


with javascript_semantics
include builtins\cffi.e
constant tGSH = """
HANDLE WINAPI GetStdHandle(
  _In_  DWORD nStdHandle
);
""",
tSCOCP = """
BOOL WINAPI SetConsoleOutputCP(
  _In_  UINT wCodePageID
);
""",
STD_OUTPUT_HANDLE = -11,
CP_UTF8 = 65001,
envset = {"LANG","LC_ALL","LC_CTYPE"}

atom k32 = NULL, xGetStdHandle, hConsole, xSetConsoleOutputCP

global function unicode_console()
-- initialises the windows console for unicode, and
-- returns true if unicode is supported, else false.
    bool res = false
    if platform()=WINDOWS then
        if k32=NULL then
            puts(1,"")  -- force console to exist
            k32 = open_dll("kernel32.dll")
            xGetStdHandle = define_cffi_func(k32,tGSH)
            hConsole = c_func(xGetStdHandle,{STD_OUTPUT_HANDLE})
            xSetConsoleOutputCP = define_cffi_func(k32,tSCOCP)
        end if
        -- following is equivalent to running "chcp 65001":
        res = c_func(xSetConsoleOutputCP,{CP_UTF8})
    else    -- LINUX
        for i=1 to length(envset) do
            if match("UTF",upper(getenv(envset[i])))!=0 then
                res = true
                exit
            end if
        end for
    end if
    return res
end function


(if (sub? "UTF-8" (or (sys "LC_ALL") (sys "LC_CTYPE") (sys "LANG")))
   (prinl (char (hex "25b3")))
   (quit "UTF-8 capable terminal required") )


import sys

if "UTF-8" in sys.stdout.encoding:
    print("△")
else:
    raise Exception("Terminal can't handle UTF-8")


import "/trait" for Stepped
import "/dynamic" for Enum
import "/fmt" for Fmt

/* external results */
var randrsl = List.filled(256, 0)
var randcnt = 0

/* internal state */
var mm = List.filled(256, 0)
var aa = 0
var bb = 0
var cc = 0

var GOLDEN_RATIO = 0x9e3779b9

var isaac = Fn.new {
    cc = cc + 1    // cc just gets incremented once per 256 results
    bb = bb + cc   // then combined with bb
    for (i in 0..255) {
        var x = mm[i]
        var j = i % 4
        aa = (j == 0) ? aa ^ (aa << 13) :
             (j == 1) ? aa ^ (aa >> 6)  :
             (j == 2) ? aa ^ (aa << 2)  :
             (j == 3) ? aa ^ (aa >> 16) : aa
        aa = aa + mm[(i + 128) % 256]
        var y = mm[(x >> 2) % 256] + aa + bb
        mm[i] = y
        bb = mm[(y >> 10) % 256] + x
        randrsl[i] = bb
    }
    randcnt = 0
}

/* if (flag == true), then use the contents of randrsl to initialize mm. */
var mix = Fn.new { |n|
    n[0] = n[0] ^ (n[1] << 11)
    n[3] = n[3] + n[0]
    n[1] = n[1] + n[2]
    n[1] = n[1] ^ (n[2] >>  2)
    n[4] = n[4] + n[1]
    n[2] = n[2] + n[3]
    n[2] = n[2] ^ (n[3] <<  8)
    n[5] = n[5] + n[2]
    n[3] = n[3] + n[4]
    n[3] = n[3] ^ (n[4] >> 16)
    n[6] = n[6] + n[3]
    n[4] = n[4] + n[5]
    n[4] = n[4] ^ (n[5] << 10)
    n[7] = n[7] + n[4]
    n[5] = n[5] + n[6]
    n[5] = n[5] ^ (n[6] >>  4)
    n[0] = n[0] + n[5]
    n[6] = n[6] + n[7]
    n[6] = n[6] ^ (n[7] <<  8)
    n[1] = n[1] + n[6]
    n[7] = n[7] + n[0]
    n[7] = n[7] ^ (n[0] >>  9)
    n[2] = n[2] + n[7]
    n[0] = n[0] + n[1]
}

var randinit = Fn.new { |flag|
    aa = 0
    bb = 0
    cc = 0
    var n = List.filled(8, GOLDEN_RATIO)
    for (i in 0..3) mix.call(n) // scramble the array

    for (i in Stepped.new(0..255, 8)) {  // fill in mm with messy stuff
        if (flag) {                      // use all the information in the seed
           for (j in 0..7) {
                n[j] = n[j] + randrsl[i + j]
           }
        }
        mix.call(n)
        for (j in 0..7) mm[i + j] = n[j]
    }

    if (flag) {
        /* do a second pass to make all of the seed affect all of mm */
        for (i in Stepped.new(0..255, 8)) {
            for (j in 0..7) n[j] = n[j] + mm[i + j]
            mix.call(n)
            for (j in 0..7) mm[i + j] = n[j]
        }
    }

    isaac.call() // fill in the first set of results
    randcnt = 0  // prepare to use the first set of results
}

var iRandom = Fn.new {
    var r = randrsl[randcnt]
    randcnt = randcnt + 1
    if (randcnt > 255) {
        isaac.call()
        randcnt = 0
    }
    return r & 0xffffffff
}

/* Get a random character (as Num) in printable ASCII range */
var iRandA = Fn.new { (iRandom.call() % 95 + 32)  }

/* Seed ISAAC with a string */
var iSeed = Fn.new { |seed, flag|
    for (i in 0..255) mm[i] = 0
    var m = seed.count
    for (i in 0..255) {
        /* in case seed has less than 256 elements */
        randrsl[i] = (i >= m) ? 0 : seed[i].bytes[0]
    }
    /* initialize ISAAC with seed */
    randinit.call(flag)
}

/* XOR cipher on random stream. Output: ASCII string */
var vernam = Fn.new { |msg|
    var len = msg.count
    var v = List.filled(len, 0)
    var i = 0
    for (b in msg.bytes) {
        v[i] = (iRandA.call() ^ b) & 0xff
        i = i + 1
    }
    return v.map { |b| String.fromByte(b) }.join()
}

/* constants for Caesar */
var MOD = 95
var START = 32

/* cipher modes for Caesar */
var CipherMode = Enum.create("CipherMode", ["ENCIPHER", "DECIPHER", "NONE"])

/* Caesar-shift a printable character */
var caesar = Fn.new { |m, ch, shift, modulo, start|
    var sh = (m == CipherMode.DECIPHER) ? -shift : shift
    var n = (ch - start) + sh
    n = n % modulo
    if (n < 0) n = n + modulo
    return String.fromByte(start + n)
}

/* Caesar-shift a string on a pseudo-random stream */
var caesarStr = Fn.new { |m, msg, modulo, start|
    var sb = ""
    /* Caesar-shift message */
    for (b in msg.bytes) {
        sb = sb + caesar.call(m, b, iRandA.call(), modulo, start)
    }
    return sb
}

var toHexByteString = Fn.new { |s|
    return s.bytes.map { |b| Fmt.swrite("$02X", b) }.join()
}

var msg = "a Top Secret secret"
var key = "this is my secret key"

// Vernam & Caesar ciphertext
iSeed.call(key, true)
var vctx = vernam.call(msg)
var cctx = caesarStr.call(CipherMode.ENCIPHER, msg,  MOD, START)

// Vernam & Caesar plaintext
iSeed.call(key, true)
var vptx = vernam.call(vctx)
var cptx = caesarStr.call(CipherMode.DECIPHER, cctx, MOD, START)

// Program output
System.print("Message : %(msg)")
System.print("Key     : %(key)")
System.print("XOR     : %(toHexByteString.call(vctx))")
System.print("XOR dcr : %(vptx)")
System.print("MOD     : %(toHexByteString.call(cctx))")
System.print("MOD dcr : %(cptx)")


with Ada.Text_IO; use  Ada.Text_IO;

procedure Reverse_Video is

   Rev_Video  : String := Ascii.ESC & "[7m";
   Norm_Video : String := Ascii.ESC & "[m";

begin
   Put (Rev_Video & "Reversed");
   Put (Norm_Video & " Normal");
end Reverse_Video;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Program Start

	.equ ramarea, 0x02000000
	.equ CursorX,ramarea
	.equ CursorY,ramarea+1

ProgramStart:
	mov sp,#0x03000000			;Init Stack Pointer

	mov r4,#0x04000000  		        ;DISPCNT -LCD Control
	mov r2,#0x403    			;4= Layer 2 on / 3= ScreenMode 3
	str r2,[r4]
	bl ResetTextCursors			;set text cursors to top left of screen

	adr r1,HelloWorld
	mov r2,#0x7FFF
	mov r11,#1
	bl PrintString

	adr r1,HelloWorld
	mov r2,#0x7FFF
	mov r11,#0
	bl PrintString

forever:
	b forever
BitmapFont:
        .include "M:\SrcAll\BitmapFont.asm"

HelloWorld:
	.byte "HELLO",255
	.align 4
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
PrintString:					;Print 255 terminated string
	STMFD sp!,{r0-r12, lr}
PrintStringAgain:
		ldrB r0,[r1],#1
		cmp r0,#255
		beq PrintStringDone		;Repeat until 255
		bl printchar 			;Print Char
		b PrintStringAgain
PrintStringDone:
	LDMFD sp!,{r0-r12, lr}
	bx lr

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
PrintChar:
	;input: R1 = ADDR OF TEXT
	;	R2 = DESIRED COLOR (ABBBBBGGGGGRRRRR   A=Alpha)
	;	CursorX = X POS OF WHERE TO DRAW
	;	CursorY = Y POS OF WHERE TO DRAW
        ;       R11 = 1 FOR INVERTED TEXT, 0 FOR NORMAL TEXT

	STMFD sp!,{r4-r12, lr}

		mov r4,#0
		mov r5,#0

		mov r3,#CursorX
		ldrB r4,[r3]			;X pos
		mov r3,#CursorY
		ldrB r5,[r3]			;Y pos

		mov r3,#0x06000000 		;VRAM base

		mov r6,r4,lsl #4		;Xpos, 2 bytes per pixel, 8 bytes per char
		add r3,r3,r6

	;Ypos, 240 pixels per line,2 bytes per pixel, 8 lines per char

		mov r4,r5,lsl #4
		mov r5,r5,lsl #8
		sub r6,r5,r4
		mov r6,r6,lsl #4		;ypos * 240 * 8 * 2 = ((((ypos << 8)-(ypos << 4)) << 3)<< 1
		add r3,r3,r6

		adr r4,BitmapFont 		;Font source

		subs r0,r0,#32			;First Char is 32 (space)
		beq LineDone			;if it's a space, just move the cursor without actually writing anything
		add r4,r4,r0,asl #3		;8 bytes per char

		mov r6,#8			;8 lines
DrawLine:
		mov r7,#8 			;8 pixels per line
		ldrb r8,[r4],#1			;Load this piece of the letter
		cmp r11,#1			;does r11 = 1?
		mvneq r8,r8			;if so, flip the bits of r8 before printing.
		mov r9,#0b100000000		;Bit Mask for testing whether to fill

DrawPixel:
		tst r8,r9			;Is bit 1?
		strneh r2,[r3]			;Yes? then fill pixel (HalfWord)
		add r3,r3,#2
		mov r9,r9,ror #1		;Bitshift Mask
		subs r7,r7,#1
		bne DrawPixel			;Next Hpixel

		add r3,r3,#480-16	        ;Move Down a line (240 pixels * 2 bytes)
		subs r6,r6,#1			;-1 char (16 px)
		bne DrawLine			;Next Vline

LineDone:
		mov r3,#CursorX
		ldrB r0,[r3]
		add r0,r0,#1			;Move across screen
		strB r0,[r3]
		mov r10,#30
		cmp r0,r10
		bleq NewLine
	LDMFD sp!,{r4-r12, lr}
	bx lr
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
NewLine:
	STMFD sp!,{r0-r12, lr}
		mov r3,#CursorX
		mov r0,#0
		strB r0,[r3]
		mov r4,#CursorY
		ldrB r0,[r4]
		add r0,r0,#1
		strB r0,[r4]
	LDMFD sp!,{r0-r12, pc}
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ResetTextCursors:
	STMFD sp!,{r4-r6,lr}
		mov r4,#0
		mov r5,#CursorX
		mov r6,#CursorY
		strB r4,[r5]
		strB r4,[r6]
	LDMFD sp!,{r4-r6,lr}
	bx lr


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

proc SetPage(P);        \Select active display page for video screen
int  P;
int  CpuReg;
[CpuReg:= GetReg;       \access CPU registers
CpuReg(0):= $0500 + P;  \call BIOS interrupt $10, function 5
SoftInt($10);
]; \SetPage

[SetPage(1);            \enable page 1 text display screen
Clear;                  \clear screen and output something
Text(0, "Hit any key to restore original screen. ");
if ChIn(1) then [];     \wait for keystroke
SetPage(0);             \restore original, default text screen, page 0
]


		org	$3000

txt_output:	equ	$bb5a
scr_clear:	equ	$bc14
wait_char:	equ	$bb06
scr_get_loc:	equ	$bc0b
scr_set_off:	equ	$bc05

		push	bc
		push	de
		push	hl
		push	af

		call	scr_get_loc ; save this value just in case the
		push	hl          ;   original screen has been scrolled vertically

		ld	hl,$c000 ; copy screen to block 1
		ld	de,$4000
		ld	bc,$4000
		ldir

		call	scr_clear
		ld	hl,text

print:		ld	a,(hl)
		cp	0
		jr	z,key
		call	txt_output
		inc	hl
		jr	print

key:		call	wait_char
		pop	hl
		call	scr_set_off
		ld	hl,$4000 ; restore screen
		ld	de,$c000
		ld	bc,$4000
		ldir
		pop	af
		pop	hl
		pop	de
		pop	bc
		ret

text:		defm	"This is some text. Please press a key.\0"


print("\e[?1049h\e[H");
println("Alternate screen buffer");
foreach i in ([5..1,-1]){
   print("\rgoing back in %d...".fmt(i));
   Atomic.sleep(1);
}
print("\e[?1049l");


if (any(grepl("UTF", toupper(Sys.getenv(c("LANG", "LC_ALL", "LC_CTYPE")))))) {
        cat("Unicode is supported on this terminal and U+25B3 is : \u25b3\n")
} else {
        cat("Unicode is not supported on this terminal.")
}


#lang racket
(displayln
 (if (regexp-match? #px"(?i:utf-?8)"
                    (or (getenv "LC_ALL") (getenv "LC_CTYPE") (getenv "LANG")))
   "\u25b3" "No Unicode detected."))


die "Terminal can't handle UTF-8"
    unless first(*.defined, %*ENV<LC_ALL LC_CTYPE LANG>) ~~ /:i 'utf-8'/;
say "△";


#encoding: UTF-8       # superfluous in Ruby >1.9.3

if ENV.values_at("LC_ALL","LC_CTYPE","LANG").compact.first.include?("UTF-8")
  puts "△"
else
  raise "Terminal can't handle UTF-8"
end


scala> println(s"Unicode is supported on this terminal and U+25B3 is : \u25b3")
Unicode is supported on this terminal and U+25B3 is : △


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

const proc: main is func
  begin
    if pos(lower(getenv("LANG")), "utf") <> 0 or
       pos(lower(getenv("LC_ALL")), "utf") <> 0 or
       pos(lower(getenv("LC_CTYPE")), "utf") <> 0 then
      writeln(STD_CONSOLE, "Unicode is supported on this terminal and U+25B3 is: △");
    else
      writeln("Unicode is not supported on this terminal.");
    end if;
  end func;


if (/\bUTF-?8/i ~~ [ENV{"LC_ALL","LC_CTYPE","LANG"}]) {
    say "△"
} else {
    die "Terminal can't handle UTF-8.\n";
}


# Check if we're using one of the UTF or "unicode" encodings
if {[string match utf-* [encoding system]] || [string match *unicode* [encoding system]]} {
    puts "\u25b3"
} else {
    error "terminal does not support unicode (probably)"
}


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

SetConsoleTextAttribute(hConsole, 0x70) ; gray background, black foreground
FileAppend, Reversed`n, CONOUT$ ; print to stdout

SetConsoleTextAttribute(hConsole, 0x07) ; black background, gray foreground
FileAppend, Normal, CONOUT$

MsgBox

SetConsoleTextAttribute(hConsole, Attributes){
	return DllCall( "SetConsoleTextAttribute", UPtr, hConsole, UShort, Attributes)
}


BEGIN {
system ("tput rev")
print "foo"
system ("tput sgr0")
print "bar"
}


Fix 3
Disp "INVERTED"
Fix 2
Disp "REGULAR",i
Pause 4500


COLOR INVERSE
PRINT "a word"
COLOR RESET
PRINT "a word"


#include <stdio.h>

int main()
{
	printf("\033[7mReversed\033[m Normal\n");

	return 0;
}


        .cr  6800
        .tf  bel6800.obj,AP1
        .lf  bel6800
;=====================================================;
;         Ring the Bell for the Motorola 6800         ;
;                 by barrym 2013-03-31                ;
;-----------------------------------------------------;
; Rings the bell of an ascii terminal (console)       ;
;   connected to a 1970s vintage SWTPC 6800 system,   ;
;   which is the target device for this assembly.     ;
; Many thanks to:                                     ;
;   swtpc.com for hosting Michael Holley's documents! ;
;   sbprojects.com for a very nice assembler!         ;
;   swtpcemu.com for a very capable emulator!         ;
; reg a holds the ascii char to be output             ;
;-----------------------------------------------------;
outeee   =   $e1d1      ;ROM: console putchar routine
        .or  $0f00
;-----------------------------------------------------;
main    ldaa #7         ;Load the ascii BEL char
        jsr  outeee     ;  and print it
        swi             ;Return to the monitor
        .en


unicode_tty() {
  # LC_ALL supersedes LC_CTYPE, which supersedes LANG.
  # Set $1 to environment value.
  case y in
  ${LC_ALL:+y})		set -- "$LC_ALL";;
  ${LC_CTYPE:+y})	set -- "$LC_CTYPE";;
  ${LANG:+y})		set -- "$LANG";;
  y)			return 1;;  # Assume "C" locale not UTF-8.
  esac
  # We use 'case' to perform pattern matching against a string.
  case "$1" in
  *UTF-8*)		return 0;;
  *)			return 1;;
  esac
}

if unicode_tty; then
  # printf might not know \u or \x, so use octal.
  # U+25B3 => UTF-8 342 226 263
  printf "\342\226\263\n"
else
  echo "HW65001 This program requires a Unicode compatible terminal" >&2
  exit 252    # Incompatible hardware
fi


/* terminal_control_unicode_output.wren */

class C {
    foreign static isUnicodeSupported
}

if (C.isUnicodeSupported) {
    System.print("Unicode is supported on this terminal and U+25B3 is : \u25b3")
} else {
    System.print("Unicode is not supported on this terminal.")
}


if(System.isUnix and T("LC_CTYPE","LC_LANG","LANG").apply(System.getenv)
		.filter().filter("holds","UTF"))
   println("This terminal supports UTF-8 (\U25B3;)");
else println("I have doubts about UTF-8 on this terminal.");


10 REM There is no Unicode delta in ROM
20 REM So we first define a custom character
30 FOR l=0 TO 7
40 READ n
50 POKE USR "d"+l,n
60 NEXT l
70 REM our custom character is a user defined d
80 PRINT CHR$(147): REM this outputs our delta
9500 REM data for our custom delta
9510 DATA 0,0,8,20,34,65,127,0


       IDENTIFICATION DIVISION.
       PROGRAM-ID. terminal-reverse-video.

       PROCEDURE DIVISION.
           DISPLAY "Reverse-Video" WITH REVERSE-VIDEO
           DISPLAY "Normal"

           GOBACK
           .


(defun reverse-attribute ()
  (with-screen (scr :input-blocking t :input-echoing nil :cursor-visible nil)
    (add-string scr "Reverse" :attributes '(:reverse))
    (add-string scr " Normal" :attributes '())
    (refresh scr)
    (get-char scr)))


: Reverse          #27  emit "[7m" type ;
: Normal           #27 emit "[m" type ;

: test cr Reverse ."   Reverse " cr  Normal ."  Normal  " ;
test


import console.*

println( "${REVERSED}This is reversed.$RESET This is normal." )


package main

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

func main() {
    tput("rev")
    fmt.Print("Rosetta")
    tput("sgr0")
    fmt.Println(" Code")
}

func tput(arg string) error {
    cmd := exec.Command("tput", arg)
    cmd.Stdout = os.Stdout
    return cmd.Run()
}


   ;:';:,#.*."3,(C.A.)/\/&.:;:' NB. some output beforehand
   attributes REVERSEVIDEO      NB. does as it says
   2 o.^:a:0                    NB. solve the fixed point equation cos(x) == x
   attributes OFF               NB. no more blinky flashy
   parseFrench=:;:,#.*."3,(C.A.)/\/&.:;:  NB. just kidding!  More output.


using Crayons.Box

println(WHITE_FG, BLACK_BG, "Normal")
println(WHITE_BG, BLACK_FG, "Reversed")
println(WHITE_FG, BLACK_BG, "Normal")


.model small
.stack 1024

.data

.code

start:  mov     ah, 02h         ;character output
        mov     dl, 07h         ;bell code
        int     21h             ;call MS-DOS

        mov     ax, 4C00h       ;exit
        int     21h             ;return to MS-DOS
end start


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

PROC Main()
  BYTE
    i,n=[3],
    CH=$02FC ;Internal hardware value for last key pressed

  PrintF("Press any key to hear %B bells...",n)
  DO UNTIL CH#$FF OD
  CH=$FF

  FOR i=1 TO n
  DO
    Put(253) ;buzzer
    Wait(20)
  OD
  Wait(100)
RETURN


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

procedure Bell is
begin
   Put(Ada.Characters.Latin_1.BEL);
end Bell;


// version 1.1.2

fun main(args: Array<String>) {
    println("\u001B[7mInverse\u001B[m Normal")
}


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

stdout( #esc + '[7m Reversed Video ' + #esc + '[0m Normal Video ')


Run["tput mr"]
Run["echo foo"] (* is displayed in reverse mode *)
Run["tput me"]
Run["echo bar"]


import terminal

stdout.styledWrite("normal ", styleReverse, "inverse", resetStyle, " normal\n")


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

# open ANSITerminal ;;
# print_string [Inverse] "Hello\n" ;;
Hello
- : unit = ()


program InverseVideo;
{$LINKLIB tinfo}
uses
  ncurses;
begin
  initscr;
  attron(A_REVERSE);
  printw('reversed');
  attroff(A_REVERSE);
  printw(' normal');
  refresh;
  getch;
  endwin;
end.


print "normal\n";
system "tput rev";
print "reversed\n";
system "tput sgr0";
print "normal\n";


--
-- demo\rosetta\Inverse_Video.exw
-- ================================
--
with javascript_semantics
text_color(BLACK)
bk_color(WHITE)
printf(1,"Inverse")
text_color(WHITE)
bk_color(BLACK)
printf(1," Video")
printf(1,"\n\npress enter to exit")
{} = wait_key()


@echo off
for /f %%. in ('forfiles /m "%~nx0" /c "cmd /c echo 0x07"') do set bell=%%.
echo %bell%


(prin "abc")
(call "tput" "rev")
(prin "def")  # These three chars are displayed in reverse video
(call "tput" "sgr0")
(prinl "ghi")


#!/usr/bin/env python

print "\033[7mReversed\033[m Normal"


  [ $ 'print("\033[7m", end="")' python ] is inversetext ( --> )

  [ $ 'print("\033[m", end="")' python ]  is regulartext ( --> )

  inversetext say "inverse video"
  regulartext say " normal text"


#lang racket
(require (planet neil/charterm:3:0))

(with-charterm
 (charterm-clear-screen)
 (charterm-cursor 0 0)
 (charterm-inverse)
 (charterm-display "Hello")
 (charterm-normal)
 (charterm-display "World"))


say "normal";
run "tput", "rev";
say "reversed";
run "tput", "sgr0";
say "normal";


/*REXX program demonstrates the showing of  reverse  video  to the display terminal.    */
@day   = 'day'
@night = 'night'

call scrwrite , 1, @day, , , 7                   /*display to terminal:  white on black.*/
call scrwrite , 1+length(@day), @night, , , 112  /*   "     "     "      black  " white.*/

exit 0                                           /*stick a fork in it,  we're all done. */


nverse = char(17)+char(128)+char(17)+char(15)
normal = char(17)+char(128+15)+char(17)+char(0)
see  inverse + " inverse " + normal + " video"


object Main extends App {
    println("\u001B[7mInverse\u001B[m Normal")
}


#include <stdio.h>
int main() {
  printf("\a");
  return 0;
}


// the simple version:
System.Console.Write("\a"); // will beep
System.Threading.Thread.Sleep(1000); // will wait for 1 second
System.Console.Beep(); // will beep a second time
System.Threading.Thread.Sleep(1000);

// System.Console.Beep() also accepts (int)hertz and (int)duration in milliseconds:
System.Console.Beep(440, 2000); // default "concert pitch" for 2 seconds


#include <iostream>

int main() {
  std::cout << "\a";
  return 0;
}


val () = print "\^[[7mReversed\^[[m Normal\n"


# Get how the terminal wants to do things...
set videoSeq(reverse) [exec tput rev]
set videoSeq(normal) [exec tput rmso]
proc reverseVideo str {
    global videoSeq
    return "$videoSeq(reverse)${str}$videoSeq(normal)"
}

# The things to print
set inReverse "foo"
set inNormal "bar"

# Print those words
puts "[reverseVideo $inReverse] $inNormal"


--revon
This is inverse
--revoff
This is normal


#!/bin/sh
tput mr     # foo is reversed
echo 'foo'
tput me     # bar is normal video
echo 'bar'


include c:\cxpl\codes;
[Attrib($70);
Text(6, "Inverse");
Attrib($07);
Text(6, " Video");
CrLf(6);
]


.org &8000
PrintChar equ &BB5A
InvertTextColors equ &BB9C

;main

call InvertTextColors

ld hl, HelloAddr
call PrintString

call InvertTextColors

ld hl,HelloAddr
jp PrintString      ;and return to basic after that.

HelloAddr: byte "Hello",0

PrintString:
ld a,(hl)
or a
ret z
call PrintChar
inc hl
jp PrintString


void main() {
    import std.stdio;
    writeln('\a');
}


program TerminalBell;

{$APPTYPE CONSOLE}

begin
  Writeln(#7);
end.


(ding)    ;; ring the bell
(beep)    ;; the same thing


package main

import "fmt"

func main() {
  fmt.Print("\a")
}


procedure main ()
  write ("\7") # ASCII 7 rings the bell under Bash
end


7{a.  NB. noun a. is a complete ASCII ordered character vector.


public class Bell{
    public static void main(String[] args){
        java.awt.Toolkit.getDefaultToolkit().beep();

        //or

        System.out.println((char)7);
    }
}


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

PROC Main()
  BYTE CRSINH=$02F0 ;Controls visibility of cursor

  Print("Hiding the cursor...")
  Wait(50)
  CRSINH=1 PutE() ;put the new line character to force hide the cursor
  Wait(50)

  Print("Showing the cursor...")
  Wait(50)
  CRSINH=0 PutE() ;put the new line character to force show the cursor
  Wait(50)
RETURN


with Ada.Text_Io;

with Ansi;

procedure Hiding is
   use Ada.Text_Io;
begin
   Put ("Hiding the cursor for 2.0 seconds...");
   delay 0.500;
   Put (Ansi.Hide);
   delay 2.000;
   Put ("And showing again.");
   delay 0.500;
   Put (Ansi.Show);
   delay 2.000;
   New_Line;
end Hiding;


cursor false
print "hiding the cursor"

pause 2000

cursor true
print "showing the cursor"


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

VarSetCapacity(cci, 8)  ; CONSOLE_CURSOR_INFO structure
DllCall("GetConsoleCursorInfo", UPtr, hConsole, UPtr, &cci)
NumPut(0, cci, 4)
DllCall("SetConsoleCursorInfo", UPtr, hConsole, UPtr, &cci)

FileAppend, Cursor hidden for 3 seconds..., CONOUT$ ; Prints to stdout
Sleep 3000

NumPut(1, cci, 4)
DllCall("SetConsoleCursorInfo", UPtr, hConsole, UPtr, &cci)

FileAppend, `nCursor shown, CONOUT$
MsgBox


proc Main()
 byte CHARS, cursorinh=$2F0

 graphics(0) cursorinh=1

 position(2,2) printe("Action!")

 CHARS=Locate(2,2) position(2,2) put(CHARS)

 cursorinh=0
 position(2,4) printf("Character at column 2 row 2 was %C",CHARS)

return


DllCall( "AllocConsole" ) ; create a console if not launched from one
hConsole := DllCall( "GetStdHandle", int, STDOUT := -11 )
Loop 10
{
	Loop 10
	{
		Random, asc, % asc("A"), % Asc("Z")
		WriteConsole(hConsole, Chr(asc))
	}
	WriteConsole(hConsole, "`n")
}

MsgBox % ReadConsoleOutputCharacter(hConsole, 1, 3, 6)

; === The below simply wraps part of the WinAPI ===

WriteConsole(hConsole, text){
	VarSetCapacity(out, 16)
	If DllCall( "WriteConsole", UPtr, hConsole, Str, text, UInt, StrLen(text)
				  , UPtrP, out, uint, 0 )
		return out
	return 0
}
ReadConsoleOutputCharacter(hConsole, length, x, y){
	VarSetCapacity(out, length * (1 << !!A_IsUnicode))
	VarSetCapacity(n, 16)
	if DllCall( "ReadConsoleOutputCharacter"
		, UPtr, hConsole
		, Str, out
		, UInt, length
		, UInt, x | (y << 16)
		, UPtrP, n )

		&& VarSetCapacity(out, -1)
				return out
	return 0
}


// version 1.1.2

fun main(args: Array<String>) {
    println("\u0007")
}


Module CheckIt {
      After 300 {beep}
      Print "Begin"
      for i=0 to 100 {
            wait 10
            Print i
      }
      Print "End"
}
CheckIt


using System.Console;

module Beep
{
    Main() : void
    {
        Write("\a");
        System.Threading.Thread.Sleep(1000);
        Beep();
        System.Threading.Thread.Sleep(1000);
        Beep(2600, 1000); // limited OS support
    }
}


' Hiding the cursor for an ANSI compliant terminal
CURSOR OFF
CURSOR ON


'hide the cursor:
LOCATE , , 0
'wait for a keypress...
SLEEP
'show the cursor:
LOCATE , , 1


      OFF : REM Hide the cursor
      WAIT 400
      ON  : REM Show the cursor again


/* Please note that curs_set is terminal dependent. */

#include<curses.h>
#include<stdio.h>

int
main ()
{
  printf
    ("At the end of this line you will see the cursor, process will sleep for 5 seconds.");
  napms (5000);
  curs_set (0);
  printf
    ("\nAt the end of this line you will NOT see the cursor, process will again sleep for 5 seconds.");
  napms (5000);
  printf ("\nGoodbye.");
  return 0;
}


static void Main(string[] args)
{
    Console.Write("At the end of this line you will see the cursor, process will sleep for 5 seconds.");
    System.Threading.Thread.Sleep(5000);
    Console.CursorVisible = false;
    Console.WriteLine();
    Console.Write("At the end of this line you will not see the cursor, process will sleep for 5 seconds.");
    System.Threading.Thread.Sleep(5000);
}


#include <Windows.h>
int main()
{
  bool showCursor = false;

  HANDLE std_out = GetStdHandle(STD_OUTPUT_HANDLE); // Get standard output
  CONSOLE_CURSOR_INFO cursorInfo;                   //
  GetConsoleCursorInfo(out, &cursorInfo);           // Get cursorinfo from output
  cursorInfo.bVisible = showCursor;                 // Set flag visible.
  SetConsoleCursorInfo(out, &cursorInfo);           // Apply changes
}


#include <windows.h>
#include <wchar.h>

int
main()
{
	CONSOLE_SCREEN_BUFFER_INFO info;
	COORD pos;
	HANDLE conout;
	long len;
	wchar_t c;

	/* Create a handle to the console screen. */
	conout = CreateFileW(L"CONOUT$", GENERIC_READ | GENERIC_WRITE,
	    FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING,
	    0, NULL);
	if (conout == INVALID_HANDLE_VALUE)
		return 1;

	/* Where is the display window? */
	if (GetConsoleScreenBufferInfo(conout, &info) == 0)
		return 1;

	/* c = character at position. */
	pos.X = info.srWindow.Left + 3;  /* Column */
	pos.Y = info.srWindow.Top  + 6;  /* Row */
	if (ReadConsoleOutputCharacterW(conout, &c, 1, pos, &len) == 0 ||
	    len <= 0)
		return 1;

	wprintf(L"Character at (3, 6) had been '%lc'\n", c);
	return 0;
}


(defun positional-read ()
  (with-screen (scr :input-blocking t :input-echoing nil :cursor-visible nil)
    ;; print random characters in a 10x20 grid
    (loop for i from 0 to 9 do
         (loop for j from 0 to 19 do
              (add-char scr (+ 33 (random 94)) :y i :x j)))
    ;; highlight char to extract at row 6 column 3
    (change-attributes scr 1 (list :reverse) :y 5 :x 2)
    (refresh scr)
    ;; wait for keypress
    (get-char scr)
    ;; extract char from row 6 column 3
    (let ((char (extract-char scr :y 5 :x 2)))
      ;; then print it out again
      (move scr 11 0)
      (format scr "extracted char: ~A" char))
    (refresh scr)
    (get-char scr)))


package main

/*
#include <windows.h>
*/
import "C"
import "fmt"

func main() {
    for i := 0; i < 80*25; i++ {
        fmt.Print("A")  // fill 80 x 25 console with 'A's
    }
    fmt.Println()
    conOut := C.GetStdHandle(C.STD_OUTPUT_HANDLE)
    info := C.CONSOLE_SCREEN_BUFFER_INFO{}
    pos := C.COORD{}
    C.GetConsoleScreenBufferInfo(conOut, &info)
    pos.X = info.srWindow.Left + 3 // column number 3 of display window
    pos.Y = info.srWindow.Top + 6  // row number 6 of display window
    var c C.wchar_t
    var le C.ulong
    ret := C.ReadConsoleOutputCharacterW(conOut, &c, 1, pos, &le)
    if ret == 0 || le <= 0 {
        fmt.Println("Something went wrong!")
        return
    }
    fmt.Printf("The character at column 3, row 6 is '%c'\n", c)
}


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

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
  do
    BEL = 8x07
    jtk = java.awt.toolkit.getDefaultToolkit()
    say 'Bing!'(Rexx BEL).d2c
    Thread.sleep(500)
    say 'Ding\x07-ding\u0007!'
    Thread.sleep(500)
    say 'Beep!'
    jtk.beep()
  catch ex = Exception
    ex.printStackTrace()
  end
  return


\\ Ringing the terminal bell.
\\ 8/14/2016 aev
Strchr(7) \\ press <Enter>


(defun sh (cmd)
  #+clisp (shell cmd)
  #+ecl (si:system cmd)
  #+sbcl (sb-ext:run-program "/bin/sh" (list "-c" cmd) :input nil :output *standard-output*)
  #+clozure (ccl:run-program "/bin/sh" (list "-c" cmd) :input nil :output *standard-output*))

(defun show-cursor (x)
  (if x (sh "tput cvvis") (sh "tput civis")))

(show-cursor nil)
(sleep 3)
(show-cursor t)
(sleep 3)


import time.*
import console.*

hide()
sleep( 2 Second )
show()


package main

import (
    "os"
    "os/exec"
    "time"
)

func main() {
    tput("civis") // hide
    time.Sleep(3 * time.Second)
    tput("cvvis") // show
    time.Sleep(3 * time.Second)
}

func tput(arg string) error {
    cmd := exec.Command("tput", arg)
    cmd.Stdout = os.Stdout
    return cmd.Run()
}


smoutput HIDECURSOR
usleep(4e6) NB. wait 4 seconds
smoutput SHOWCURSOR


const ESC = "\u001B" # escape code
print("$ESC[?25l")                       # hide the cursor
print("Enter anything, press RETURN: ")  # prompt shown
input = readline()                       # but no cursor
print("$ESC[0H$ESC[0J$ESC[?25h")         # reset, visible again
sleep(3)
println()


using LibNCurses

randtxt(n) = foldl(*, rand(split("1234567890abcdefghijklmnopqrstuvwxyz", ""), n))

initscr()

for i in 1:20
    LibNCurses.mvwaddstr(i, 1, randtxt(50))
end

row = rand(1:20)
col = rand(1:50)
ch = LibNCurses.winch(row, col)
LibNCurses.mvwaddstr(col, 52, "The character at ($row, $col) is $ch.") )


// Kotlin Native version 0.3

import kotlinx.cinterop.*
import win32.*

fun main(args: Array<String>) {
    for (i in 0 until (80 * 25)) print("A")  // fill 80 x 25 console with 'A's
    println()
    memScoped {
        val conOut = GetStdHandle(-11)
        val info = alloc<CONSOLE_SCREEN_BUFFER_INFO>()
        val pos = alloc<COORD>()
        GetConsoleScreenBufferInfo(conOut, info.ptr)
        pos.X = (info.srWindow.Left + 3).toShort()  // column number 3 of display window
        pos.Y = (info.srWindow.Top + 6).toShort()   // row number 6 of display window
        val c = alloc<wchar_tVar>()
        val len = alloc<IntVar>()
        ReadConsoleOutputCharacterW(conOut, c.ptr, 1, pos.readValue(), len.ptr)
        if (len.value == 1) {
            val ch = c.value.toChar()
            println("The character at column 3, row 6 is '$ch'")
        }
        else println("Something went wrong!")
    }
}


#!/bin/ksh

# Determine the character displayed on the screen at column 3, row 6 and
# store that character in a variable.
#
# Use a group of functions "shellcurses"

#	# Variables:
#
FPATH="/usr/local/functions/shellcurses/"

rst="�[0m"
red="�[31m"
whi="�[37m"

integer row=${1:-6} col=${2:-3}		# Allow command line row col input

#	# 10x10 grid of random digits
#
typeset -A grid
for ((i=0; i<10; i++)); do
	for ((j=0; j<10; j++)); do
		(( grid[${i}][${j}] = (RANDOM % 9) + 1 ))
	done
done

#	# Functions:
#

 ######
# main #
 ######
#	# Initialize the curses screen
#
initscr ; export MAX_LINES MAX_COLS

#	# Display the random number grid with target in red
#
clear
for ((i=1; i<=10; i++)); do
	for ((j=1; j<=10; j++)); do
		colr=${whi}
		(( i == row )) && (( j == col )) && colr=${red}
		mvaddstr ${i} ${j} "${colr}${grid[$((i-1))][$((j-1))]}${rst}"
	done
done

str=$(rtnch ${row} ${col})	# return char at (row, col) location

mvaddstr 12 1 "Digit at (${row},${col}) = ${str}"	# Display result
move 14 1
refresh
endwin


import random, sequtils, strutils
import ncurses

randomize()

let win = initscr()
assert not win.isNil, "Unable to initialize."

for y in 0..9:
  mvaddstr(y.cint, 0, newSeqWith(10, sample({'0'..'9', 'a'..'z'})).join())

let row = rand(9).cint
let col = rand(9).cint
let ch = win.mvwinch(row, col)

mvaddstr(row, col + 11, "The character at ($1, $2) is $3.".format(row, col, chr(ch)))
mvaddstr(11, 0, "Press any key to quit.")
refresh()
discard getch()

endwin()


# 20200917 added Perl programming solution

use strict;
use warnings;

use Curses;

initscr or die;

my $win = Curses->new;

foreach my $row (0..9) {
   $win->addstr( $row , 0, join('', map { chr(int(rand(50)) + 41) } (0..9)))
};

my $icol = 3 - 1;
my $irow = 6 - 1;

my $ch = $win->inch($irow,$icol);

$win->addstr( $irow, $icol+10, 'Character at column 3, row 6 = '.$ch );

$win->addstr( LINES() - 2, 2, "Press any key to exit..." );

$win->getch;

endwin;


   declare bell character (1);
   unspec (bell) = '00000111'b;
   put edit (bell) (a);


#lang racket
(require (planet neil/charterm:3:0))
(with-charterm
 (void (charterm-bell)))


// version 1.1.2

fun main(args: Array<String>) {
    print("\u001B[?25l")      // hide cursor
    Thread.sleep(2000)        // wait 2 seconds before redisplaying cursor
    print("\u001B[?25h")      // display cursor
    Thread.sleep(2000)        // wait 2 more seconds before exiting
}


#!/usr/bin/lasso9

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

// hide the cursor
stdout(#esc + '[?25l')

// wait for 4 seconds to give time discover the cursor is gone
sleep(4000)

// show the cursor
stdout(#esc + '[?25h')

// wait for 4 seconds to give time discover the cursor is back
sleep(4000)


10 CURSOR 0: REM hide cursor
20 FOR l = 1 TO 2000: REM delay
30 NEXT l
40 CURSOR 1: REM show cursor


Run["tput civis"]  (* Cursor hidden *)
Pause[2]
Run["tput cvvis"]  (* Cursor Visible *)


using System.Console;
using System.Threading.Thread;

module CursorVisibility
{
    Main() : void
    {
        repeat(3) {
            CursorVisible = !CursorVisible;
            Sleep(5000);
        }
    }
}


import terminal

echo "Cursor hidden.  Press a key to show the cursor and exit."
stdout.hideCursor()
discard getCh()
stdout.showCursor()


print "\e[?25l";                        # hide the cursor
print "Enter anything, press RETURN: "; # prompt shown
$input = <>;                            # but no cursor
print "\e[0H\e[0J\e[?25h";              # reset, visible again


(call "tput" "civis")  # Invisible
(wait 1000)
(call "tput" "cvvis")  # Visible


--
-- demo\rosetta\Positional_read.exw
-- ================================
--
without js -- (position, get_screen_char)
position(6,1) -- line 6 column 1 (1-based)
puts(1,"abcdef")
integer {ch,attr} = get_screen_char(6,3)
printf(1,"\n\n=>%c",ch)
{} = wait_key()


$coord = [System.Management.Automation.Host.Coordinates]::new(3, 6)
$rect  = [System.Management.Automation.Host.Rectangle]::new($coord, $coord)
$char  = $Host.UI.RawUI.GetBufferContents($rect).Character


import curses
from random import randint

# Print random text in a 10x10 grid
stdscr = curses.initscr()
for rows in range(10):
    line = ''.join([chr(randint(41, 90)) for i in range(10)])
    stdscr.addstr(line + '\n')

# Read
icol = 3 - 1
irow = 6 - 1
ch = stdscr.instr(irow, icol, 1).decode(encoding="utf-8")

# Show result
stdscr.move(irow, icol + 10)
stdscr.addstr('Character at column 3, row 6 = ' + ch + '\n')
stdscr.getch()

curses.endwin()


#lang racket
(require ffi/unsafe ffi/unsafe/define)
(define-ffi-definer defwin #f)
(defwin GetStdHandle (_fun _int -> _pointer))
(defwin ReadConsoleOutputCharacterA
  (_fun _pointer _pointer _uint _uint [len : (_ptr o _uint)] -> _bool))

(define b (make-bytes 1 32))
(and (ReadConsoleOutputCharacterA (GetStdHandle -11) b 1 #x50002)
     (printf "The character at 3x6 is <~a>\n" b))


use NCurses;

# Reference:
# https://github.com/azawawi/perl6-ncurses

# Initialize curses window
my $win = initscr() or die "Failed to initialize ncurses\n";

# Print random text in a 10x10 grid

for ^10 { mvaddstr($_ , 0, (for ^10 {(41 .. 90).roll.chr}).join )};

# Read

my $icol = 3 - 1;
my $irow = 6 - 1;

my $ch = mvinch($irow,$icol);

# Show result

mvaddstr($irow, $icol+10, 'Character at column 3, row 6 = ' ~ $ch.chr);

mvaddstr( LINES() - 2, 2, "Press any key to exit..." );

# Refresh (this is needed)
nc_refresh;

# Wait for a keypress
getch;

# Cleanup
LEAVE {
    delwin($win) if $win;
    endwin;
}


/*REXX program illustrates methods to  ring the terminal bell  or  use the PC speaker.  */
                     /*╔═══════════════════════════════════════════════════════════════╗
                       ║                                                               ║
                       ║  Note that the  hexadecimal code  to ring the  terminal bell  ║
                       ║  is different on an ASCII machine than an EBCDIC machine.     ║
                       ║                                                               ║
                       ║  On an  ASCII machine,  it is  (hexadecimal)  '07'x.          ║
                       ║   "  " EBCDIC    "       "  "        "        '2F'x.          ║
                       ║                                                               ║
                       ╚═══════════════════════════════════════════════════════════════╝*/

if 3=='F3'  then bell= '2f'x                     /*we are running on an EBCDIC machine. */
            else bell= '07'x                     /* "  "     "     "  "  ASCII    "     */

say bell                                         /*sound the  bell  on the terminal.    */
say copies(bell, 20)                             /*as above,  but much more annoying.   */

                     /*╔═══════════════════════════════════════════════════════════════╗
                       ║                                                               ║
                       ║  Some REXX interpreters have a  built-in function  (BIF)  to  ║
                       ║  to produce a sound on the PC speaker, the sound is specified ║
                       ║  by frequency  and  an optional  duration.                    ║
                       ║                                                               ║
                       ╚═══════════════════════════════════════════════════════════════╝*/

                                         /* [↓]  supported by Regina REXX:              */
freq= 1200                               /*frequency in  (nearest)  cycles per second.  */
call  beep freq                          /*sounds the PC speaker, duration=  1   second.*/
ms=   500                                /*duration in milliseconds.                    */
call  beep freq, ms                      /*  "     "   "    "         "     1/2     "   */

                                         /* [↓]  supported by PC/REXX  &  Personal REXX:*/
freq= 2000                               /*frequency in  (nearest)  cycles per second.  */
call  sound freq                         /*sounds PC speaker, duration=   .2   second.  */
secs= .333                               /*duration in seconds (round to nearest tenth).*/
call  sound freq, secs                   /*  "     "    "         "      3/10     "     */

                                         /*stick a fork in it, we're done making noises.*/


$ include "seed7_05.s7i";

const proc: main is func
  begin
    write("\a");
  end func;


#cursorSize = 10 ;use a full sized cursor

If OpenConsole()
  Print("Press any key to toggle cursor: ")
  EnableGraphicalConsole(1)
  height = #cursorSize
  ConsoleCursor(height)
  Repeat
    If Inkey()
      height ! #cursorSize
      ConsoleCursor(height)
    EndIf
  ForEver
EndIf


print("\x1b[?25l") # hidden
print("\x1b[?25h") # shown


cat("\x1b[?25l") # Hide
Sys.sleep(2)
cat("\x1b[?25h") # Show


#lang racket
(void (system "tput civis")) (sleep 2) (void (system "tput cvvis"))


say 'Hiding the cursor for 5 seconds...';
run 'tput', 'civis';
sleep 5;
run 'tput', 'cvvis';


/*REXX pgm calls a function in a shared library (regutil) to hide/show cursor.*/
z=rxfuncadd('sysloadfuncs', "regutil", 'sysloadfuncs')   /*add a function lib.*/
if z\==0  then do                                        /*test the return cod*/
               say 'return code'  z  "from rxfuncadd"    /*tell about bad RC. */
               exit z                                    /*exit this program. */
               end

call sysloadfuncs                                        /*load the functions.*/

                                       /* [↓]   call a particular function.   */
call syscurstate 'off'                 /*hide the displaying of the cursor.   */
say 'showing of the cursor is now off' /*inform that the cursor is now hidden.*/

                                       /* ··· and perform some stuff here ··· */
say 'sleeping for three seconds ...'   /*inform the user of what we're doing. */
call sleep 3                           /*might as well sleep for three seconds*/

call syscurstate 'on'                  /*(unhide) the displaying of the cursor*/
say 'showing of the cursor is now on'  /*inform that the cursor is now showing*/
                                       /*stick a fork in it,  we're all done. */


/*REXX program demonstrates reading a character from (at) at  specific screen location. */
    row = 6                                      /*point to a particular row   on screen*/
    col = 3                                      /*  "    " "     "      column "    "  */
howMany = 1                                      /*read this many characters from screen*/

stuff = scrRead(row, col, howMany)               /*this'll do it.                       */

other = scrRead(40, 3, 1)                        /*same thing,  but for row forty.      */
                                                 /*stick a fork in it,  we're all done. */


;;; Type definitions and constants

(typedef BOOL (enum BOOL FALSE TRUE))
(typedef HANDLE cptr)
(typedef WCHAR wchar)
(typedef DWORD uint32)
(typedef WORD uint16)
(typedef SHORT short)

(typedef COORD
         (struct COORD
           (X SHORT)
           (Y SHORT)))

(typedef SMALL_RECT
         (struct SMALL_RECT
           (Left SHORT)
           (Top SHORT)
           (Right SHORT)
           (Bottom SHORT)))

(typedef CONSOLE_SCREEN_BUFFER_INFO
         (struct CONSOLE_SCREEN_BUFFER_INFO
           (dwSize COORD)
           (dwCursorPosition COORD)
           (wAttributes WORD)
           (srWindow SMALL_RECT)
           (dwMaximumWindowSize COORD)))

;;; Various constants

(defvarl STD_INPUT_HANDLE (- #x100000000 10))
(defvarl STD_OUTPUT_HANDLE (- #x100000000 11))
(defvarl STD_ERROR_HANDLE (- #x100000000 12))

(defvarl NULL cptr-null)
(defvarl INVALID_HANDLE_VALUE (cptr-int -1))

;;; Foreign Function Bindings

(with-dyn-lib "kernel32.dll"
  (deffi GetStdHandle "GetStdHandle" HANDLE (DWORD))
  (deffi GetConsoleScreenBufferInfo "GetConsoleScreenBufferInfo"
         BOOL (HANDLE (ptr-out CONSOLE_SCREEN_BUFFER_INFO)))
  (deffi ReadConsoleOutputCharacter "ReadConsoleOutputCharacterW"
         BOOL (HANDLE (ptr-out (array 1 WCHAR))
                       DWORD COORD (ptr-out (array 1 DWORD)))))

;;; Now the character at <2, 5> -- column 3, row 6.

(let ((console-handle (GetStdHandle STD_OUTPUT_HANDLE)))
  (when (equal console-handle INVALID_HANDLE_VALUE)
    (error "couldn't get console handle"))

  (let* ((cinfo (new CONSOLE_SCREEN_BUFFER_INFO))
         (getinfo-ok (GetConsoleScreenBufferInfo console-handle cinfo))
         (coord (if getinfo-ok
                  ^#S(COORD X ,(+ 2 cinfo.srWindow.Left)
                            Y ,(+ 5 cinfo.srWindow.Top))
                  #S(COORD X 0 Y 0)))
         (chars (vector 1))
         (nread (vector 1))
         (read-ok (ReadConsoleOutputCharacter console-handle chars
                                              1 coord nread)))
    (when (eq getinfo-ok 'FALSE)
      (error "GetConsoleScreenBufferInfo failed"))
    (prinl cinfo)
    (when (eq read-ok 'FALSE)
      (error "ReadConsoleOutputCharacter failed"))
    (unless (plusp [nread 0])
      (error "ReadConsoleOutputCharacter read zero characters"))
    (format t "character is ~s\n" [chars 0])))


/* terminal_control_positional_read.wren */

import "random" for Random

foreign class Window {
    construct initscr() {}

    foreign addstr(str)

    foreign inch(y, x)

    foreign move(y, x)

    foreign refresh()

    foreign getch()

    foreign delwin()
}

class Ncurses {
    foreign static endwin()
}

// initialize curses window
var win = Window.initscr()
if (win == 0) {
    System.print("Failed to initialize ncurses.")
    return
}

// print random text in a 10x10 grid
var rand = Random.new()
for (row in 0..9) {
    var line = (0..9).map{ |d| String.fromByte(rand.int(41, 91)) }.join()
    win.addstr(line + "\n")
}

// read
var col = 3 - 1
var row = 6 - 1
var ch = win.inch(row, col)

// show result
win.move(row, col + 10)
win.addstr("Character at column 3, row 6 = %(ch)")
win.move(11, 0)
win.addstr("Press any key to exit...")

// refresh
win.refresh()

// wait for a keypress
win.getch()

// clean-up
win.delwin()
Ncurses.endwin()


include c:\cxpl\stdlib;
int C;
[Cursor(3, 6);                  \move cursor to column 3, row 6 (top left = 0,0)
\Call BIOS interrupt routine to read character (& attribute) at cursor position
C:= CallInt($10, $0800, 0) & $00FF; \mask off attribute, leaving the character
]


#!/bin/sh
# Ring the terminal bell
# echo "\a" # does not work in some shells
tput bel


;Assemble with: tasm; tlink /t
        .model  tiny
        .code
        org     100h            ;.com files start here
start:  mov     ah, 02h         ;character output
        mov     dl, 07h         ;bell code
        int     21h             ;call MS-DOS
        ret                     ;return to MS-DOS
        end     start


# Project : Terminal control/Hiding the cursor

load "stdlib.ring"
# Linux
? "Hide Cursor using tput utility"
system("tput civis")     # Invisible
sleep(10)
? "Show Cursor using tput utility"
system("tput cnorm")   # Normal


require "curses"
include Curses

init_screen
begin
  curs_set(1) #visible cursor
  sleep 3
  curs_set(0) #invisible cursor
  sleep 3
  curs_set(1) #visible cursor
  sleep 3
ensure
  close_screen
end


object Main extends App {
  print("\u001B[?25l") // hide cursor
  Thread.sleep(2000) // wait 2 seconds before redisplaying cursor
  print("\u001B[?25h") // display cursor
  Thread.sleep(2000) // wait 2 more seconds before exiting
}


proc cursorVisibility {{state normal}} {
    switch -- $state {
	invisible {set op civis}
	visible   {set op cvvis}
	normal    {set op cnorm}
    }
    exec -- >@stdout tput $op
}


tput civis    # Hide the cursor
sleep 5       # Sleep for 5 seconds
tput cnorm    # Show the cursor


import "timer" for Timer

System.print("\e[?25l")
Timer.sleep(3000)
System.print("\e[?25h")
Timer.sleep(3000)


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

proc ShowCur(On);       \Turn flashing cursor on or off
int On;                 \true = cursor on; false = cursor off
int CpuReg;
[CpuReg:= GetReg;       \access CPU registers
CpuReg(0):= $0100;      \AX:= $0100
CpuReg(2):= if On then $0007 else $2000;
SoftInt($10);           \Call BIOS interrupt $10
]; \ShowCur

[ShowCur(false);        \turn off flashing cursor
if ChIn(1) then [];     \wait for keystroke
ShowCur(true);          \turn on flashing cursor
]


DEFINE TERNARY="BYTE"
DEFINE FALSE="0"
DEFINE MAYBE="1"
DEFINE TRUE="2"

PROC PrintT(TERNARY a)
  IF a=FALSE THEN Print("F")
  ELSEIF a=MAYBE THEN Print("?")
  ELSE Print("T")
  FI
RETURN

TERNARY FUNC NotT(TERNARY a)
RETURN (TRUE-a)

TERNARY FUNC AndT(TERNARY a,b)
  IF a<b THEN RETURN (a) FI
RETURN (b)

TERNARY FUNC OrT(TERNARY a,b)
  IF a>b THEN RETURN (a) FI
RETURN (b)

TERNARY FUNC IfThenT(TERNARY a,b)
  IF a=TRUE THEN RETURN (b)
  ELSEIF a=FALSE THEN RETURN (TRUE)
  ELSEIF a+b>TRUE THEN RETURN (TRUE)
  FI
RETURN (MAYBE)

TERNARY FUNC EquivT(TERNARY a,b)
  IF a=b THEN RETURN (TRUE)
  ELSEIF a=TRUE THEN RETURN (b)
  ELSEIF b=TRUE THEN RETURN (a)
  FI
RETURN (MAYBE)

PROC Main()
  BYTE x,y,a,b,res

  x=2 y=1
  FOR a=FALSE TO TRUE
  DO
    res=NotT(a)
    Position(x,y) y==+1
    Print("not ") PrintT(a)
    Print(" = ") PrintT(res)
  OD

  y==+1
  FOR a=FALSE TO TRUE
  DO
    FOR b=FALSE TO TRUE
    DO
      res=AndT(a,b)
      Position(x,y) y==+1
      PrintT(a) Print(" and ") PrintT(b)
      Print(" = ") PrintT(res)
    OD
  OD

  y==+1
  FOR a=FALSE TO TRUE
  DO
    FOR b=FALSE TO TRUE
    DO
      res=OrT(a,b)
      Position(x,y) y==+1
      PrintT(a) Print(" or ") PrintT(b)
      Print(" = ") PrintT(res)
    OD
  OD

  x=20 y=5
  FOR a=FALSE TO TRUE
  DO
    FOR b=FALSE TO TRUE
    DO
      res=IfThenT(a,b)
      Position(x,y) y==+1
      Print("if ") PrintT(a)
      Print(" then ") PrintT(b)
      Print(" = ") PrintT(res)
    OD
  OD

  y==+1
  FOR a=FALSE TO TRUE
  DO
    FOR b=FALSE TO TRUE
    DO
      res=EquivT(a,b)
      Position(x,y) y==+1
      PrintT(a) Print(" equiv ") PrintT(b)
      Print(" = ") PrintT(res)
    OD
  OD
RETURN


package Logic is
   type Ternary is (True, Unknown, False);

   -- logic functions
   function "and"(Left, Right: Ternary) return Ternary;
   function "or"(Left, Right: Ternary) return Ternary;
   function "not"(T: Ternary) return Ternary;
   function Equivalent(Left, Right: Ternary) return Ternary;
   function Implies(Condition, Conclusion: Ternary) return Ternary;

   -- conversion functions
   function To_Bool(X: Ternary) return Boolean;
   function To_Ternary(B: Boolean) return Ternary;
   function Image(Value: Ternary) return Character;
end Logic;


# -*- coding: utf-8 -*- #

INT trit width = 1, trit base = 3;
MODE TRIT = STRUCT(BITS trit);
CO FORMAT trit fmt = $c("?","⌈","⌊",#|"~"#)$; CO

# These values treated are as per "Balanced ternary" #
# eg true=1, maybe=0, false=-1 #
TRIT true =INITTRIT 4r1, maybe=INITTRIT 4r0,
     false=INITTRIT 4r2;

# Warning: redefines standard builtins flip & flop #
LONGCHAR flap="?", flip="⌈", flop="⌊";

OP REPR = (TRIT t)LONGCHAR:
  []LONGCHAR(flap, flip, flop)[1+ABS trit OF t];

############################################
# Define some OPerators for coercing MODES #
############################################
OP INITTRIT = (BOOL in)TRIT:
  (in|true|false);

OP INITBOOL = (TRIT in)BOOL:
  (trit OF in=trit OF true|TRUE|:trit OF in=trit OF false|FALSE|
    raise value error(("vague TRIT to BOOL coercion: """, REPR in,""""));~
  );
OP B = (TRIT in)BOOL: INITBOOL in;

# These values treated are as per "Balanced ternary" #
# n.b true=1, maybe=0, false=-1 #
# Warning: BOOL ABS FALSE (0) is not the same as TRIT ABS false (-1) #

OP INITINT = (TRIT t)INT:
  CASE 1+ABS trit OF t
  IN #maybe# 0, #true # 1, #false#-1
  OUT raise value error(("invalid TRIT value",REPR t)); ~
  ESAC;

OP INITTRIT = (INT in)TRIT: (
  TRIT out;
  trit OF out:= trit OF
    CASE 2+in
    IN false, maybe, true
    OUT raise value error(("invalid TRIT value",in)); ~
    ESAC;
  out
);

OP INITTRIT = (BITS b)TRIT:
  (TRIT out; trit OF out:=b; out);

##################################################
# Define the LOGICAL OPerators for the TRIT MODE #
##################################################
MODE LOGICAL = TRIT;
PR READ "Template_operators_logical_mixin.a68" PR

COMMENT
  Kleene logic truth tables:
END COMMENT

OP AND = (TRIT a,b)TRIT: (
  [,]TRIT(
    # ∧  ##  false, maybe, true  #
    #false# (false, false, false),
    #maybe# (false, maybe, maybe),
    #true # (false, maybe, true )
  )[@-1,@-1][INITINT a, INITINT b]
);

OP OR = (TRIT a,b)TRIT: (
  [,]TRIT(
    # ∨  ##  false, maybe, true #
    #false# (false, maybe, true),
    #maybe# (maybe, maybe, true),
    #true # (true,  true,  true)
  )[@-1,@-1][INITINT a, INITINT b]
);

PRIO IMPLIES = 1; # PRIO = 1.9 #
OP IMPLIES = (TRIT a,b)TRIT: (
  [,]TRIT(
    # ⊃   ## false, maybe, true #
    #false# (true,  true,  true),
    #maybe# (maybe, maybe, true),
    #true # (false, maybe, true)
  )[@-1,@-1][INITINT a, INITINT b]
);

PRIO EQV = 1; # PRIO = 1.8 #
OP EQV = (TRIT a,b)TRIT: (
  [,]TRIT(
    # ≡   ## false, maybe, true #
    #false# (true,  maybe, false),
    #maybe# (maybe, maybe, maybe),
    #true # (false, maybe, true )
  )[@-1,@-1][INITINT a, INITINT b]
);


vals: @[true maybe false]

loop vals 'v -> print ["NOT" v "=>" not? v]
print ""
loop vals 'v1 [
    loop vals 'v2
        -> print [v1 "AND" v2 "=>" and? v1 v2]
]
print ""
loop vals 'v1 [
    loop vals 'v2
        -> print [v1 "OR" v2 "=>" or? v1 v2]
]
print ""
loop vals 'v1 [
    loop vals 'v2
        -> print [v1 "XOR" v2 "=>" xor? v1 v2]
]


Ternary_Not(a){
	SetFormat, Float, 2.1
	return Abs(a-1)
}

Ternary_And(a,b){
	return a<b?a:b
}

Ternary_Or(a,b){
	return a>b?a:b
}

Ternary_IfThen(a,b){
	return a=1?b:a=0?1:a+b>1?1:0.5
}

Ternary_Equiv(a,b){
	return a=b?1:a=1?b:b=1?a:0.5
}


global tFalse, tDontKnow, tTrue
tFalse = 0
tDontKnow = 1
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

function and3(a,b)
	if a < b then return a else return b
end function

function or3(a,b)
	if a > b then return a else return b
end function

function eq3(a,b)
	begin case
		case a = tDontKnow or b = tDontKnow
			return tDontKnow
		case a = b
			return tTrue
		else
			return tFalse
	end case
end function

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

function not3(b)
	return 2-b
end function

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

function longName3$(i)
	begin case
		case i = 1
			return "Don't know"
		case i = 2
			return "True"
		else
			return "False"
	end case
end function


      INSTALL @lib$ + "CLASSLIB"

      REM Create a ternary class:
      DIM trit{tor, tand, teqv, tnot, tnor, s, v}
      DEF PRIVATE trit.s (t&) LOCAL t$():DIM t$(2):t$()="FALSE","MAYBE","TRUE":=t$(t&)
      DEF PRIVATE trit.v (t$) = INSTR("FALSE MAYBE TRUE", t$) DIV 6
      DEF trit.tnot (t$) = FN(trit.s)(2 - FN(trit.v)(t$))
      DEF trit.tor (a$,b$) LOCAL t:t=FN(trit.v)(a$)ORFN(trit.v)(b$):=FN(trit.s)(t+(t>2))
      DEF trit.tnor (a$,b$) = FN(trit.tnot)(FN(trit.tor)(a$,b$))
      DEF trit.tand (a$,b$) = FN(trit.tnor)(FN(trit.tnot)(a$),FN(trit.tnot)(b$))
      DEF trit.teqv (a$,b$) = FN(trit.tor)(FN(trit.tand)(a$,b$),FN(trit.tnor)(a$,b$))
      PROC_class(trit{})

      PROC_new(mytrit{}, trit{})

      REM Test it:
      PRINT "Testing NOT:"
      PRINT "NOT FALSE = " FN(mytrit.tnot)("FALSE")
      PRINT "NOT MAYBE = " FN(mytrit.tnot)("MAYBE")
      PRINT "NOT TRUE  = " FN(mytrit.tnot)("TRUE")

      PRINT '"Testing OR:"
      PRINT "FALSE OR FALSE = " FN(mytrit.tor)("FALSE","FALSE")
      PRINT "FALSE OR MAYBE = " FN(mytrit.tor)("FALSE","MAYBE")
      PRINT "FALSE OR TRUE  = " FN(mytrit.tor)("FALSE","TRUE")
      PRINT "MAYBE OR MAYBE = " FN(mytrit.tor)("MAYBE","MAYBE")
      PRINT "MAYBE OR TRUE  = " FN(mytrit.tor)("MAYBE","TRUE")
      PRINT "TRUE  OR TRUE  = " FN(mytrit.tor)("TRUE","TRUE")

      PRINT '"Testing AND:"
      PRINT "FALSE AND FALSE = " FN(mytrit.tand)("FALSE","FALSE")
      PRINT "FALSE AND MAYBE = " FN(mytrit.tand)("FALSE","MAYBE")
      PRINT "FALSE AND TRUE  = " FN(mytrit.tand)("FALSE","TRUE")
      PRINT "MAYBE AND MAYBE = " FN(mytrit.tand)("MAYBE","MAYBE")
      PRINT "MAYBE AND TRUE  = " FN(mytrit.tand)("MAYBE","TRUE")
      PRINT "TRUE  AND TRUE  = " FN(mytrit.tand)("TRUE","TRUE")

      PRINT '"Testing EQV (similar to EOR):"
      PRINT "FALSE EQV FALSE = " FN(mytrit.teqv)("FALSE","FALSE")
      PRINT "FALSE EQV MAYBE = " FN(mytrit.teqv)("FALSE","MAYBE")
      PRINT "FALSE EQV TRUE  = " FN(mytrit.teqv)("FALSE","TRUE")
      PRINT "MAYBE EQV MAYBE = " FN(mytrit.teqv)("MAYBE","MAYBE")
      PRINT "MAYBE EQV TRUE  = " FN(mytrit.teqv)("MAYBE","TRUE")
      PRINT "TRUE  EQV TRUE  = " FN(mytrit.teqv)("TRUE","TRUE")

      PROC_discard(mytrit{})


#include <stdio.h>

typedef enum {
  TRITTRUE,  /* In this enum, equivalent to integer value 0 */
  TRITMAYBE, /* In this enum, equivalent to integer value 1 */
  TRITFALSE  /* In this enum, equivalent to integer value 2 */
} trit;

/* We can trivially find the result of the operation by passing
   the trinary values as indeces into the lookup tables' arrays. */
trit tritNot[3] = {TRITFALSE , TRITMAYBE, TRITTRUE};
trit tritAnd[3][3] = { {TRITTRUE, TRITMAYBE, TRITFALSE},
                       {TRITMAYBE, TRITMAYBE, TRITFALSE},
                       {TRITFALSE, TRITFALSE, TRITFALSE} };

trit tritOr[3][3] = { {TRITTRUE, TRITTRUE, TRITTRUE},
                      {TRITTRUE, TRITMAYBE, TRITMAYBE},
                      {TRITTRUE, TRITMAYBE, TRITFALSE} };

trit tritThen[3][3] = { { TRITTRUE, TRITMAYBE, TRITFALSE},
                        { TRITTRUE, TRITMAYBE, TRITMAYBE},
                        { TRITTRUE, TRITTRUE, TRITTRUE } };

trit tritEquiv[3][3] = { { TRITTRUE, TRITMAYBE, TRITFALSE},
                         { TRITMAYBE, TRITMAYBE, TRITMAYBE},
                         { TRITFALSE, TRITMAYBE, TRITTRUE } };

/* Everything beyond here is just demonstration */

const char* tritString[3] = {"T", "?", "F"};

void demo_binary_op(trit operator[3][3], const char* name)
{
  trit operand1 = TRITTRUE; /* Declare. Initialize for CYA */
  trit operand2 = TRITTRUE; /* Declare. Initialize for CYA */

  /* Blank line */
  printf("\n");

  /* Demo this operator */
  for( operand1 = TRITTRUE; operand1 <= TRITFALSE; ++operand1 )
  {
    for( operand2 = TRITTRUE; operand2 <= TRITFALSE; ++operand2 )
    {
      printf("%s %s %s: %s\n", tritString[operand1],
                               name,
                               tritString[operand2],
                               tritString[operator[operand1][operand2]]);
    }
  }

}

int main()
{
  trit op1 = TRITTRUE; /* Declare. Initialize for CYA */
  trit op2 = TRITTRUE; /* Declare. Initialize for CYA */

  /* Demo 'not' */
  for( op1 = TRITTRUE; op1 <= TRITFALSE; ++op1 )
  {
    printf("Not %s: %s\n", tritString[op1], tritString[tritNot[op1]]);
  }
  demo_binary_op(tritAnd, "And");
  demo_binary_op(tritOr, "Or");
  demo_binary_op(tritThen, "Then");
  demo_binary_op(tritEquiv, "Equiv");

  return 0;
}


using System;

/// <summary>
/// Extension methods on nullable bool.
/// </summary>
/// <remarks>
/// The operators !, & and | are predefined.
/// </remarks>
public static class NullableBoolExtension
{
    public static bool? Implies(this bool? left, bool? right)
    {
        return !left | right;
    }

    public static bool? IsEquivalentTo(this bool? left, bool? right)
    {
        return left.HasValue && right.HasValue ? left == right : default(bool?);
    }

    public static string Format(this bool? value)
    {
        return value.HasValue ? value.Value.ToString() : "Maybe";
    }
}

public class Program
{
    private static void Main()
    {
        var values = new[] { true, default(bool?), false };

        foreach (var left in values)
        {
            Console.WriteLine("¬{0} = {1}", left.Format(), (!left).Format());
            foreach (var right in values)
            {
                Console.WriteLine("{0} & {1} = {2}", left.Format(), right.Format(), (left & right).Format());
                Console.WriteLine("{0} | {1} = {2}", left.Format(), right.Format(), (left | right).Format());
                Console.WriteLine("{0} → {1} = {2}", left.Format(), right.Format(), left.Implies(right).Format());
                Console.WriteLine("{0} ≡ {1} = {2}", left.Format(), right.Format(), left.IsEquivalentTo(right).Format());
            }
        }
    }
}


#include <iostream>
#include <stdlib.h>

class trit {
public:
    static const trit False, Maybe, True;

    trit operator !() const {
        return static_cast<Value>(-value);
    }

    trit operator &&(const trit &b) const {
        return (value < b.value) ? value : b.value;
    }

    trit operator ||(const trit &b) const {
        return (value > b.value) ? value : b.value;
    }

    trit operator >>(const trit &b) const {
        return -value > b.value ? static_cast<Value>(-value) : b.value;
    }

    trit operator ==(const trit &b) const {
        return static_cast<Value>(value * b.value);
    }

    char chr() const {
        return "F?T"[value + 1];
    }

protected:
    typedef enum { FALSE=-1, MAYBE, TRUE } Value;

    Value value;

    trit(const Value value) : value(value) { }
};

std::ostream& operator<<(std::ostream &os, const trit &t)
{
    os << t.chr();
    return os;
}

const trit trit::False = trit(trit::FALSE);
const trit trit::Maybe = trit(trit::MAYBE);
const trit trit::True = trit(trit::TRUE);

int main(int, char**) {
    const trit trits[3] = { trit::True, trit::Maybe, trit::False };

#define for_each(name) \
    for (size_t name=0; name<3; ++name)

#define show_op(op) \
    std::cout << std::endl << #op << " "; \
    for_each(a) std::cout << ' ' << trits[a]; \
    std::cout << std::endl << "  -------"; \
    for_each(a) { \
        std::cout << std::endl << trits[a] << " |"; \
        for_each(b) std::cout << ' ' << (trits[a] op trits[b]); \
    } \
    std::cout << std::endl;

    std::cout << "! ----" << std::endl;
    for_each(a) std::cout << trits[a] << " | " << !trits[a] << std::endl;

    show_op(&&);
    show_op(||);
    show_op(>>);
    show_op(==);
    return EXIT_SUCCESS;
}


(defun tri-not (x) (- 1 x))
(defun tri-and (&rest x) (apply #'* x))
(defun tri-or (&rest x) (tri-not (apply #'* (mapcar #'tri-not x))))
(defun tri-eq (x y) (+ (tri-and x y) (tri-and (- 1 x) (- 1 y))))
(defun tri-imply (x y) (tri-or (tri-not x) y))

(defun tri-test (x) (< (random 1e0) x))
(defun tri-string (x) (if (= x 1) "T" (if (= x 0) "F" "?")))

;; to say (tri-if (condition) (yes) (no))
(defmacro tri-if (tri ifcase &optional elsecase)
  `(if (tri-test ,tri) ,ifcase ,elsecase))

(defun print-table (func header)
  (let ((vals '(1 .5 0)))
    (format t "~%~a:~%" header)
    (format t "    ~{~a ~^~}~%---------~%" (mapcar #'tri-string vals))
    (loop for row in vals do
	  (format t "~a | " (tri-string row))
	  (loop for col in vals do
		(format t "~a " (tri-string (funcall func row col))))
	  (write-line ""))))

(write-line "NOT:")
(loop for row in '(1 .5 0) do
      (format t "~a | ~a~%" (tri-string row) (tri-string (tri-not row))))

(print-table #'tri-and   "AND")
(print-table #'tri-or    "OR")
(print-table #'tri-imply "IMPLY")
(print-table #'tri-eq    "EQUAL")


import std.stdio;

struct Trit {
    private enum Val : byte { F = -1, M, T }
    private Val t;
    alias t this;
    static immutable Trit[3] vals = [{Val.F}, {Val.M}, {Val.T}];
    static immutable F = Trit(Val.F); // Not necessary but handy.
    static immutable M = Trit(Val.M);
    static immutable T = Trit(Val.T);

    string toString() const pure nothrow {
        return "F?T"[t + 1  .. t + 2];
    }

    Trit opUnary(string op)() const pure nothrow
    if (op == "~") {
        return Trit(-t);
    }

    Trit opBinary(string op)(in Trit b) const pure nothrow
    if (op == "&") {
        return t < b ? this : b;
    }

    Trit opBinary(string op)(in Trit b) const pure nothrow
    if (op == "|") {
        return t > b ? this : b;
    }

    Trit opBinary(string op)(in Trit b) const pure nothrow
    if (op == "^") {
        return ~(this == b);
    }

    Trit opEquals(in Trit b) const pure nothrow {
        return Trit(cast(Val)(t * b));
    }

    Trit imply(in Trit b) const pure nothrow {
        return -t > b ? ~this : b;
    }
}

void showOperation(string op)(in string opName) {
    writef("\n[%s]\n    F ? T\n  -------", opName);
    foreach (immutable a; Trit.vals) {
        writef("\n%s |", a);
        foreach (immutable b; Trit.vals)
            static if (op == "==>")
                writef(" %s", a.imply(b));
            else
                writef(" %s", mixin("a " ~ op ~ " b"));
    }
    writeln();
}

void main() {
    writeln("[Not]");
    foreach (const a; Trit.vals)
        writefln("%s | %s", a, ~a);

    showOperation!"&"("And");
    showOperation!"|"("Or");
    showOperation!"^"("Xor");
    showOperation!"=="("Equiv");
    showOperation!"==>"("Imply");
}


unit TrinaryLogic;

interface

//Define our own type for ternary logic.
//This is actually still a Boolean, but the compiler will use distinct RTTI information.
type
    TriBool = type Boolean;

const
    TTrue:TriBool = True;
    TFalse:TriBool = False;
    TMaybe:TriBool = TriBool(2);

function TVL_not(Value: TriBool): TriBool;
function TVL_and(A, B: TriBool): TriBool;
function TVL_or(A, B: TriBool): TriBool;
function TVL_xor(A, B: TriBool): TriBool;
function TVL_eq(A, B: TriBool): TriBool;

implementation

Uses
    SysUtils;

function TVL_not(Value: TriBool): TriBool;
begin
    if Value = True Then
        Result := TFalse
    else If Value = False Then
        Result := TTrue
    else
        Result := Value;
end;

function TVL_and(A, B: TriBool): TriBool;
begin
    Result := TriBool(Iff(Integer(A * B) > 1, Integer(TMaybe), A * B));
end;

function TVL_or(A, B: TriBool): TriBool;
begin
    Result := TVL_not(TVL_and(TVL_not(A), TVL_not(B)));
end;

function TVL_xor(A, B: TriBool): TriBool;
begin
    Result := TVL_and(TVL_or(A, B), TVL_not(TVL_or(A, B)));
end;

function TVL_eq(A, B: TriBool): TriBool;
begin
    Result := TVL_not(TVL_xor(A, B));
end;

end.


import extensions;
import system'routines;
import system'collections;

sealed class Trit
{
    bool _value;

    bool cast() = _value;

    constructor(v)
    {
        if (v != nil)
        {
            _value := cast bool(v);
        }
    }

    Trit equivalent(b)
        = _value.equal(cast bool(b)) \ back:nilValue;

    Trit Inverted
        = _value.Inverted \ back:nilValue;

    Trit and(b)
    {
        if (nil == _value)
        {
            ^ b.and:nil \ back:nilValue
        }
        else
        {
            ^ _value.and((lazy:cast bool(b))) \ back:nilValue
        }
    }

    Trit or(b)
    {
        if (nil == _value)
        {
            ^ b.or:nilValue \ back:nilValue
        }
        else
        {
            ^ _value.or((lazy:cast bool(b))) \ back:nilValue
        }
    }

    Trit implies(b)
        = self.Inverted.or(b);

    string toPrintable() = _value.toPrintable() \ back:"maybe";
}

public program()
{
    List<Trit> values := new Trit[]{true, nilValue, false};
    values.forEach:(left)
    {
        console.printLine("¬",left," = ", left.Inverted);
        values.forEach:(right)
        {
            console.printLine(left, " & ", right, " = ", left && right);
            console.printLine(left, " | ", right, " = ", left || right);
            console.printLine(left, " → ", right, " = ", left.implies:right);
            console.printLine(left, " ≡ ", right, " = ", left.equivalent:right)
        }
    }
}


% Implemented by Arjun Sunel
-module(ternary).
-export([main/0, nott/1, andd/2,orr/2, then/2, equiv/2]).

main() ->
	{ok, [A]} = io:fread("Enter A: ","~s"),
	{ok, [B]} = io:fread("Enter B: ","~s"),
	andd(A,B).

nott(S) ->
	if
		S=="T" ->
			io : format("F\n");

	 	S=="F" ->
			io : format("T\n");

		true ->
			io: format("?\n")
	end.

andd(A, B) ->
	if
		A=="T", B=="T" ->
			io : format("T\n");

		A=="F"; B=="F" ->
			io : format("F\n");

		true ->
			io: format("?\n")
	end.

orr(A, B) ->
	if
		A=="T"; B=="T" ->
			io : format("T\n");

		A=="?"; B=="?" ->
			io : format("?\n");

		true ->
			io: format("F\n")
	end.

then(A, B) ->
	if
		B=="T" ->
			io : format("T\n");

		A=="?" ->
			io : format("?\n");

		A=="F" ->
			io :format("T\n");
		B=="F" ->
			io:format("F\n");
		true ->
			io: format("?\n")
	end.

equiv(A, B) ->
	if
		A=="?" ->
			io : format("?\n");

		A=="F" ->
			io : format("~s\n", [nott(B)]);

		true ->
			io: format("~s\n", [B])
	end.


! rosettacode/ternary/ternary.factor
! http://rosettacode.org/wiki/Ternary_logic
USING: combinators kernel ;
IN: rosettacode.ternary

SINGLETON: m
UNION: trit t m POSTPONE: f ;

GENERIC: >trit ( object -- trit )
M: trit >trit ;

: tnot ( trit1 -- trit )
    >trit { { t [ f ] } { m [ m ] } { f [ t ] } } case ;

: tand ( trit1 trit2 -- trit )
    >trit {
        { t [ >trit ] }
        { m [ >trit { { t [ m ] } { m [ m ] } { f [ f ] } } case ] }
        { f [ >trit drop f ] }
    } case ;

: tor ( trit1 trit2 -- trit )
    >trit {
        { t [ >trit drop t ] }
        { m [ >trit { { t [ t ] } { m [ m ] } { f [ m ] } } case ] }
        { f [ >trit ] }
    } case ;

: txor ( trit1 trit2 -- trit )
    >trit {
        { t [ tnot ] }
        { m [ >trit drop m ] }
        { f [ >trit ] }
    } case ;

: t= ( trit1 trit2 -- trit )
    {
        { t [ >trit ] }
        { m [ >trit drop m ] }
        { f [ tnot ] }
    } case ;


1 constant maybe

: tnot dup maybe <> if invert then ;
: tand and ;
: tor or ;
: tequiv 2dup and rot tnot rot tnot and or ;
: timply tnot tor ;
: txor tequiv tnot ;

: t. C" TF?" 2 + + [email protected] emit ;

: table2. ( xt -- )
  cr ."     T F ?"
  cr ."   --------"
  2 true DO
    cr I t.  ."  | "
    2 true DO
      dup I J rot execute t. ."  "
    LOOP
  LOOP DROP ;

: table1. ( xt -- )
  2 true DO
    CR I t. ."  | "
    dup I swap execute t.
  LOOP DROP ;

CR ." [NOT]" ' tnot table1. CR
CR ." [AND]" ' tand table2. CR
CR ." [OR]" ' tor table2. CR
CR ." [XOR]" ' txor table2. CR
CR ." [IMPLY]" ' timply table2. CR
CR ." [EQUIV]" ' tequiv table2. CR


!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Mon May 20 23:05:46
!
!a=./f && make $a && $a < unixdict.txt
!gfortran -std=f2003 -Wall -ffree-form f.f03 -o f
!
!ternary not
! 1.0 0.5 0.0
!
!
!ternary and
! 0.0 0.0 0.0
! 0.0 0.5 0.5
! 0.0 0.5 1.0
!
!
!ternary or
! 0.0 0.5 1.0
! 0.5 0.5 1.0
! 1.0 1.0 1.0
!
!
!ternary if
! 1.0 1.0 1.0
! 0.5 0.5 1.0
! 0.0 0.5 1.0
!
!
!ternary eq
! 1.0 0.5 0.0
! 0.5 0.5 0.5
! 0.0 0.5 1.0
!
!
!Compilation finished at Mon May 20 23:05:46

!This program is based on the j implementation
!not=: -.
!and=: <.
!or =: >.
!if =: (>. -.)"0~
!eq =: (<.&-. >. <.)"0

module trit

  real, parameter :: true = 1,  false = 0, maybe = 0.5

contains

  real function tnot(y)
    real, intent(in) :: y
    tnot = 1 - y
  end function tnot

  real function tand(x, y)
    real, intent(in) :: x, y
    tand = min(x, y)
  end function tand

  real function tor(x, y)
    real, intent(in) :: x, y
    tor = max(x, y)
  end function tor

  real function tif(x, y)
    real, intent(in) :: x, y
    tif = tor(y, tnot(x))
  end function tif

  real function teq(x, y)
    real, intent(in) :: x, y
    teq = tor(tand(tnot(x), tnot(y)), tand(x, y))
  end function teq

end module trit

program ternaryLogic
  use trit
  integer :: i
  real, dimension(3) :: a = [false, maybe, true] ! (/ ... /)
  write(6,'(/a)')'ternary not' ; write(6, '(3f4.1/)') (tnot(a(i)), i = 1 , 3)
  write(6,'(/a)')'ternary and' ; call table(tand, a, a)
  write(6,'(/a)')'ternary or' ; call table(tor, a, a)
  write(6,'(/a)')'ternary if' ; call table(tif, a, a)
  write(6,'(/a)')'ternary eq' ; call table(teq, a, a)

contains

  subroutine table(u, x, y) ! for now, show the table.
    real, external :: u
    real, dimension(3), intent(in) :: x, y
    integer :: i, j
    write(6, '(3(3f4.1/))') ((u(x(i), y(j)), j=1,3), i=1,3)
  end subroutine table

end program ternaryLogic


{$mode objfpc}
unit ternarylogic;

interface
type
  { ternary type, balanced }
  trit = (tFalse=-1, tMaybe=0, tTrue=1);

 { ternary operators }

  { equivalence = multiplication }
  operator * (const a,b:trit):trit;
  operator and (const a,b:trit):trit;inline;
  operator or (const a,b:trit):trit;inline;
  operator not (const a:trit):trit;inline;
  operator xor (const a,b:trit):trit;
  { imp ==>}
  operator >< (const a,b:trit):trit;

implementation

  operator and (const a,b:trit):trit;inline;
    const lookupAnd:array[trit,trit] of trit =
                    ((tFalse,tFalse,tFalse),
                     (tFalse,tMaybe,tMaybe),
                     (tFalse,tMaybe,tTrue));
  begin
    Result:= LookupAnd[a,b];
  end;

  operator or (const a,b:trit):trit;inline;
    const lookupOr:array[trit,trit] of trit =
                   ((tFalse,tMaybe,tTrue),
                    (tMaybe,tMaybe,tTrue),
                    (tTrue,tTrue,tTrue));
  begin
    Result := LookUpOr[a,b];
  end;

  operator not (const a:trit):trit;inline;
    const LookupNot:array[trit] of trit =(tTrue,tMaybe,tFalse);
  begin
     Result:= LookUpNot[a];
  end;

  operator xor (const a,b:trit):trit;
    const LookupXor:array[trit,trit] of trit =
                    ((tFalse,tMaybe,tTrue),
                     (tMaybe,tMaybe,tMaybe),
                     (tTrue,tMaybe,tFalse));
  begin
    Result := LookupXor[a,b];
  end;

  operator * (const a,b:trit):trit;
  begin
    result := not (a xor b);
  end;

  { imp ==>}
  operator >< (const a,b:trit):trit;
  begin
     result := not(a) or b;
  end;
end.


enum trit
   F=-1, M=0, T=1
end enum

dim as string symbol(-1 to 1) = {"F", "?", "T"}, outstr
dim as trit i

operator not ( x as trit ) as trit
    return -x
end operator

operator and (x as trit, y as trit) as trit
    if x>y then return y and x
    return x
end operator

operator or ( x as trit, y as trit ) as trit
    if x<y then return y or x
    return x
end operator

operator eqv ( x as trit, y as trit ) as trit
    return x*y
end operator

operator imp ( x as trit, y as trit ) as trit
    if -y>x then return -y
    return x
end operator

print "     (AND)      ( OR)      (EQV)      (IMP)     (NOT)"
print "     F ? T      F ? T      F ? T      F ? T          "
print "    -------------------------------------------------"
for i = F to T
    outstr  = " "+symbol(i)+" | "
    outstr += symbol(F and i) + " " + symbol(M and i) + " " + symbol(T and i)
    outstr += "      "
    outstr += symbol(F or i) + " " + symbol(M or i) + " " + symbol(T or i)
    outstr += "      "
    outstr += symbol(F eqv i) + " " + symbol(M eqv i) + " " + symbol(T eqv i)
    outstr += "      "
    outstr += symbol(F imp i) + " " + symbol(M imp i) + " " + symbol(T imp i)
    outstr += "       " + symbol(not(i))
    print outstr
next i


package main

import "fmt"

type trit int8

const (
    trFalse trit = iota - 1
    trMaybe
    trTrue
)

func (t trit) String() string {
    switch t {
    case trFalse:
        return "False"
    case trMaybe:
        return "Maybe"
    case trTrue:
        return "True "
    }
    panic("Invalid trit")
}

func trNot(t trit) trit {
    return -t
}

func trAnd(s, t trit) trit {
    if s < t {
        return s
    }
    return t
}

func trOr(s, t trit) trit {
    if s > t {
        return s
    }
    return t
}

func trEq(s, t trit) trit {
    return s * t
}

func main() {
    trSet := []trit{trFalse, trMaybe, trTrue}

    fmt.Println("t     not t")
    for _, t := range trSet {
        fmt.Println(t, trNot(t))
    }

    fmt.Println("\ns     t     s and t")
    for _, s := range trSet {
        for _, t := range trSet {
            fmt.Println(s, t, trAnd(s, t))
        }
    }

    fmt.Println("\ns     t     s or t")
    for _, s := range trSet {
        for _, t := range trSet {
            fmt.Println(s, t, trOr(s, t))
        }
    }

    fmt.Println("\ns     t     s eq t")
    for _, s := range trSet {
        for _, t := range trSet {
            fmt.Println(s, t, trEq(s, t))
        }
    }
}


enum Trit {
    TRUE, MAYBE, FALSE

    private Trit nand(Trit that) {
        switch ([this,that]) {
            case { FALSE in it }: return TRUE
            case { MAYBE in it }: return MAYBE
            default             : return FALSE
        }
    }
    private Trit nor(Trit that) { this.or(that).not() }

    Trit and(Trit that)   { this.nand(that).not() }
    Trit or(Trit that)    { this.not().nand(that.not()) }
    Trit not()            { this.nand(this) }
    Trit imply(Trit that) { this.nand(that.not()) }
    Trit equiv(Trit that) { this.and(that).or(this.nor(that)) }
}


import Prelude hiding (Bool(..), not, (&&), (||), (==))

main = mapM_ (putStrLn . unlines . map unwords)
    [ table "not"     $ unary not
    , table "and"     $ binary (&&)
    , table "or"      $ binary (||)
    , table "implies" $ binary (=->)
    , table "equals"  $ binary (==)
    ]

data Trit = False | Maybe | True deriving (Show)

False `nand` _     = True
_     `nand` False = True
True  `nand` True  = False
_     `nand` _     = Maybe

not a = nand a a

a && b = not $ a `nand` b

a || b = not a `nand` not b

a =-> b = a `nand` not b

a == b = (a && b) || (not a && not b)

inputs1 = [True, Maybe, False]
inputs2 = [(a,b) | a <- inputs1, b <- inputs1]

unary f = map (\a -> [a, f a]) inputs1
binary f = map (\(a,b) -> [a, b, f a b]) inputs2

table name xs = map (map pad) . (header :) $ map (map show) xs
    where header = map (:[]) (take ((length $ head xs) - 1) ['A'..]) ++ [name]

pad s = s ++ replicate (5 - length s) ' '


$define TRUE    1
$define FALSE  -1
$define UNKNOWN 0

invocable all
link printf

procedure main()  # demonstrate ternary logic

ufunc := ["not3"]
bfunc := ["and3", "or3", "xor3", "eq3", "ifthen3"]

every f := !ufunc  do {   # display unary functions
   printf("\nunary function=%s:\n",f)
   every t1 := (TRUE | FALSE | UNKNOWN) do
      printf(" %s : %s\n",showtrit(t1),showtrit(not3(t1)))
   }

every f :=  !bfunc do {   # display binary functions
   printf("\nbinary function=%s:\n     ",f)
   every t1 := (&null | TRUE | FALSE | UNKNOWN) do {
      printf(" %s : ",showtrit(\t1))
      every t2 := (TRUE | FALSE | UNKNOWN | &null) do {
         if /t1 then printf("  %s",showtrit(\t2)|"\n")
         else printf("  %s",showtrit(f(t1,\t2))|"\n")
         }
      }
   }
end

procedure showtrit(a)   #: return printable trit of error if invalid
return case a of {TRUE:"T";FALSE:"F";UNKNOWN:"?";default:runerr(205,a)}
end

procedure istrit(a)     #: return value of trit or error if invalid
return (TRUE|FALSE|UNKNOWN|runerr(205,a)) = a
end

procedure not3(a)       #: not of trit or error if invalid
return FALSE * istrit(a)
end

procedure and3(a,b)     #: and of two trits or error if invalid
return min(istrit(a),istrit(b))
end

procedure or3(a,b)      #: or of two trits or error if invalid
return max(istrit(a),istrit(b))
end

procedure eq3(a,b)      #: equals of two trits or error if invalid
return istrit(a) * istrit(b)
end

procedure ifthen3(a,b)  #: if trit then trit or error if invalid
return case istrit(a) of { TRUE: istrit(b) ; UNKNOWN: or3(a,b); FALSE: TRUE }
end

procedure xor3(a,b)     #: xor of two trits or error if invalid
return not3(eq3(a,b))
end


public class Logic{
	public static enum Trit{
		TRUE, MAYBE, FALSE;

		public Trit and(Trit other){
			if(this == TRUE){
				return other;
			}else if(this == MAYBE){
				return (other == FALSE) ? FALSE : MAYBE;
			}else{
				return FALSE;
			}
		}

		public Trit or(Trit other){
			if(this == TRUE){
				return TRUE;
			}else if(this == MAYBE){
				return (other == TRUE) ? TRUE : MAYBE;
			}else{
				return other;
			}
		}

		public Trit tIf(Trit other){
			if(this == TRUE){
				return other;
			}else if(this == MAYBE){
				return (other == TRUE) ? TRUE : MAYBE;
			}else{
				return TRUE;
			}
		}

		public Trit not(){
			if(this == TRUE){
				return FALSE;
			}else if(this == MAYBE){
				return MAYBE;
			}else{
				return TRUE;
			}
		}

		public Trit equals(Trit other){
			if(this == TRUE){
				return other;
			}else if(this == MAYBE){
				return MAYBE;
			}else{
				return other.not();
			}
		}
	}
	public static void main(String[] args){
		for(Trit a:Trit.values()){
			System.out.println("not " + a + ": " + a.not());
		}
		for(Trit a:Trit.values()){
			for(Trit b:Trit.values()){
				System.out.println(a+" and "+b+": "+a.and(b)+
						"\t "+a+" or "+b+": "+a.or(b)+
						"\t "+a+" implies "+b+": "+a.tIf(b)+
						"\t "+a+" = "+b+": "+a.equals(b));
			}
		}
	}
}


var L3 = new Object();

L3.not = function(a) {
  if (typeof a == "boolean") return !a;
  if (a == undefined) return undefined;
  throw("Invalid Ternary Expression.");
}

L3.and = function(a, b) {
  if (typeof a == "boolean" && typeof b == "boolean") return a && b;
  if ((a == true && b == undefined) || (a == undefined && b == true)) return undefined;
  if ((a == false && b == undefined) || (a == undefined && b == false)) return false;
  if (a == undefined && b == undefined) return undefined;
  throw("Invalid Ternary Expression.");
}

L3.or = function(a, b) {
  if (typeof a == "boolean" && typeof b == "boolean") return a || b;
  if ((a == true && b == undefined) || (a == undefined && b == true)) return true;
  if ((a == false && b == undefined) || (a == undefined && b == false)) return undefined;
  if (a == undefined && b == undefined) return undefined;
  throw("Invalid Ternary Expression.");
}

// A -> B is equivalent to -A or B
L3.ifThen = function(a, b) {
  return L3.or(L3.not(a), b);
}

// A <=> B is equivalent to (A -> B) and (B -> A)
L3.iff = function(a, b) {
  return L3.and(L3.ifThen(a, b), L3.ifThen(b, a));
}


def ternary_nand(a; b):
  if a == false or b == false then true
  elif a == "maybe" or b == "maybe" then "maybe"
  else false
  end ;

def ternary_not(a):    ternary_nand(a; a);

def ternary_or(a; b):  ternary_nand( ternary_not(a); ternary_not(b) );

def ternary_nor(a; b): ternary_not( ternary_or(a;b) );

def ternary_and(a; b): ternary_not( ternary_nand(a; b) );

def ternary_imply(this; that):
  ternary_nand(this, ternary_not(that));

def ternary_equiv(this; that):
  ternary_or( ternary_and(this; that); ternary_nor(this; that) );

def display_and(a; b):
  a as $a | b as $b
  | "\($a) and \($b) is \( ternary_and($a; $b) )";
def display_equiv(a; b):
  a as $a | b as $b
  | "\($a) equiv \($b) is \( ternary_equiv($a; $b) )";
# etc etc

# Invoke the display functions:
display_and( (false, "maybe", true );  (false, "maybe", true) ),
display_equiv( (false, "maybe", true );  (false, "maybe", true) ),
"etc etc"


@enum Trit False Maybe True
const trits = (False, Maybe, True)

Base.:!(a::Trit) = a == False ? True : a == Maybe ? Maybe : False
∧(a::Trit, b::Trit) = a == b == True ? True : (a, b) ∋ False ? False : Maybe
∨(a::Trit, b::Trit) = a == b == False ? False : (a, b) ∋ True ? True : Maybe
⊃(a::Trit, b::Trit) = a == False || b == True ? True : (a, b) ∋ Maybe ? Maybe : False
≡(a::Trit, b::Trit) = (a, b) ∋ Maybe ? Maybe : a == b ? True : False

println("Not (!):")
println(join(@sprintf("%10s%s is %5s", "!", t, !t) for t in trits))
println("And (∧):")
for a in trits
    println(join(@sprintf("%10s ∧ %5s is %5s", a, b, a ∧ b) for b in trits))
end
println("Or (∨):")
for a in trits
    println(join(@sprintf("%10s ∨ %5s is %5s", a, b, a ∨ b) for b in trits))
end
println("If Then (⊃):")
for a in trits
    println(join(@sprintf("%10s ⊃ %5s is %5s", a, b, a ⊃ b) for b in trits))
end
println("Equivalent (≡):")
for a in trits
    println(join(@sprintf("%10s ≡ %5s is %5s", a, b, a ≡ b) for b in trits))
end


# built-in: true, false and missing

using Printf

const tril = (true, missing, false)

@printf("\n%8s | %8s\n", "A", "¬A")
for A in tril
    @printf("%8s | %8s\n", A, !A)
end

@printf("\n%8s | %8s | %8s\n", "A", "B", "A ∧ B")
for (A, B) in Iterators.product(tril, tril)
    @printf("%8s | %8s | %8s\n", A, B, A & B)
end

@printf("\n%8s | %8s | %8s\n", "A", "B", "A ∨ B")
for (A, B) in Iterators.product(tril, tril)
    @printf("%8s | %8s | %8s\n", A, B, A | B)
end

@printf("\n%8s | %8s | %8s\n", "A", "B", "A ≡ B")
for (A, B) in Iterators.product(tril, tril)
    @printf("%8s | %8s | %8s\n", A, B, A == B)
end

⊃(A, B) = B | !A

@printf("\n%8s | %8s | %8s\n", "A", "B", "A ⊃ B")
for (A, B) in Iterators.product(tril, tril)
    @printf("%8s | %8s | %8s\n", A, B, A ⊃ B)
end


// version 1.1.2

enum class Trit {
    TRUE, MAYBE, FALSE;

    operator fun not() = when (this) {
        TRUE  -> FALSE
        MAYBE -> MAYBE
        FALSE -> TRUE
    }

    infix fun and(other: Trit) = when (this) {
        TRUE  -> other
        MAYBE -> if (other == FALSE) FALSE else MAYBE
        FALSE -> FALSE
    }

    infix fun or(other: Trit) = when (this) {
        TRUE  -> TRUE
        MAYBE -> if (other == TRUE) TRUE else MAYBE
        FALSE -> other
    }

    infix fun imp(other: Trit) = when (this) {
        TRUE  -> other
        MAYBE -> if (other == TRUE) TRUE else MAYBE
        FALSE -> TRUE
    }

    infix fun eqv(other: Trit) = when (this) {
        TRUE  -> other
        MAYBE -> MAYBE
        FALSE -> !other
    }

    override fun toString() = this.name[0].toString()
}

fun main(args: Array<String>) {
    val ta = arrayOf(Trit.TRUE, Trit.MAYBE, Trit.FALSE)

    // not
    println("not")
    println("-------")
    for (t in ta) println(" $t  | ${!t}")
    println()

    // and
    println("and | T  M  F")
    println("-------------")
    for (t in ta) {
        print(" $t  | ")
        for (tt in ta) print("${t and tt}  ")
        println()
    }
    println()

    // or
    println("or  | T  M  F")
    println("-------------")
    for (t in ta) {
        print(" $t  | ")
        for (tt in ta) print("${t or tt}  ")
        println()
    }
    println()

    // imp
    println("imp | T  M  F")
    println("-------------")
    for (t in ta) {
        print(" $t  | ")
        for (tt in ta) print("${t imp tt}  ")
        println()
    }
    println()

    // eqv
    println("eqv | T  M  F")
    println("-------------")
    for (t in ta) {
        print(" $t  | ")
        for (tt in ta) print("${t eqv tt}  ")
        println()
    }
}


# borrowing null for "maybe"
val .trSet = [false, null, true]

val .and = f given .a, .b {
    case true, null:
    case null, true:
    case null: null
    default: .a and .b
}

val .or = f given .a, .b {
    case false, null:
    case null, false:
    case null: null
    default: .a or .b
}

val .imply = f if(.a nor .b: not? .a; .b)

# formatting function for the result values
# replacing null with "maybe"
# using left alignment of 5 code points
val .F = f $"\{nn [.r, "maybe"]:-5}"

writeln "a     not a"
for .a in .trSet {
    writeln $"\.a:.F; \(not? .a:.F)"
}

writeln "\na     b     a and b"
for .a in .trSet {
    for .b in .trSet {
        writeln $"\.a:.F; \.b:.F; \.and(.a, .b):.F;"
    }
}

writeln "\na     b     a or b"
for .a in .trSet {
    for .b in .trSet {
        writeln $"\.a:.F; \.b:.F; \.or(.a, .b):.F;"
    }
}

writeln "\na     b     a implies b"
for .a in .trSet {
    for .b in .trSet {
        writeln $"\.a:.F; \.b:.F; \.imply(.a, .b):.F;"
    }
}

writeln "\na     b     a eq b"
for .a in .trSet {
    for .b in .trSet {
        writeln $"\.a:.F; \.b:.F; \.a ==? .b:.F;"
    }
}


'ternary logic
'0 1 2
'F ? T
'False Don't know True
'LB has NOT AND OR XOR, so we implement them.
'LB has no EQ, but XOR could be expressed via EQ. In 'normal' boolean at least.

global tFalse, tDontKnow, tTrue
tFalse = 0
tDontKnow = 1
tTrue = 2

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

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

print "Double  parameter fuctions"
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);"     "; _
            shortName3$(and3(a,b));"       "; shortName3$(or3(a,b));"       "; _
            shortName3$(eq3(a,b));"        "; shortName3$(xor3(a,b))
    next
next

function and3(a,b)
    and3 = min(a,b)
end function

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

function eq3(a,b)
    select case
    case a=tDontKnow or b=tDontKnow
        eq3 = tDontKnow
    case a=b
        eq3 = tTrue
    case else
        eq3 = tFalse
    end select
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


tv := [true, false, FAIL];
NotTable     := Array(1..3, i->not tv[i] );
AndTable     := Array(1..3, 1..3, (i,j)->tv[i] and tv[j] );
OrTable      := Array(1..3, 1..3, (i,j)->tv[i] or tv[j] );
XorTable     := Array(1..3, 1..3, (i,j)->tv[i] xor tv[j] );
ImpliesTable := Array(1..3, 1..3, (i,j)->tv[i] implies tv[j] );


Maybe /: ! Maybe = Maybe;
Maybe /: (And | Or | Nand | Nor | Xor | Xnor | Implies | Equivalent)[Maybe, Maybe] = Maybe;


type Trit* = enum ttrue, tmaybe, tfalse

proc `$`*(a: Trit): string =
  case a
  of ttrue: "T"
  of tmaybe: "?"
  of tfalse: "F"

proc `not`*(a: Trit): Trit =
  case a
  of ttrue: tfalse
  of tmaybe: tmaybe
  of tfalse: ttrue

proc `and`*(a, b: Trit): Trit =
  const t: array[Trit, array[Trit, Trit]] =
    [ [ttrue,  tmaybe, tfalse]
    , [tmaybe, tmaybe, tfalse]
    , [tfalse, tfalse, tfalse] ]
  t[a][b]

proc `or`*(a, b: Trit): Trit =
  const t: array[Trit, array[Trit, Trit]] =
    [ [ttrue, ttrue,  ttrue]
    , [ttrue, tmaybe, tmaybe]
    , [ttrue, tmaybe, tfalse] ]
  t[a][b]

proc then*(a, b: Trit): Trit =
  const t: array[Trit, array[Trit, Trit]] =
    [ [ttrue, tmaybe, tfalse]
    , [ttrue, tmaybe, tmaybe]
    , [ttrue, ttrue,  ttrue] ]
  t[a][b]

proc equiv*(a, b: Trit): Trit =
  const t: array[Trit, array[Trit, Trit]] =
    [ [ttrue,  tmaybe, tfalse]
    , [tmaybe, tmaybe, tmaybe]
    , [tfalse, tmaybe, ttrue] ]
  t[a][b]

when isMainModule:

  import strutils

  for t in Trit:
    echo "Not ", t , ": ", not t

  for op1 in Trit:
    for op2 in Trit:
      echo "$# and   $#: $#".format(op1, op2, op1 and op2)
      echo "$# or    $#: $#".format(op1, op2, op1 or op2)
      echo "$# then  $#: $#".format(op1, op2, op1.then op2)
      echo "$# equiv $#: $#".format(op1, op2, op1.equiv op2)


type trit = True | False | Maybe

let t_not = function
  | True -> False
  | False -> True
  | Maybe -> Maybe

let t_and a b = match (a,b) with
   | (True,True) -> True
   | (False,_)  | (_,False) -> False
   | _ -> Maybe

let t_or a b = t_not (t_and (t_not a) (t_not b))

let t_eq a b = match (a,b) with
   | (True,True) | (False,False) -> True
   | (False,True) | (True,False) -> False
   | _ -> Maybe

let t_imply a b = t_or (t_not a) b

let string_of_trit = function
  | True -> "True"
  | False -> "False"
  | Maybe -> "Maybe"

let () =
  let values = [| True; Maybe; False |] in
  let f = string_of_trit in
  Array.iter (fun v -> Printf.printf "Not %s: %s\n" (f v) (f (t_not v))) values;
  print_newline ();
  let print op str =
    Array.iter (fun a ->
      Array.iter (fun b ->
        Printf.printf "%s %s %s: %s\n" (f a) str (f b) (f (op a b))
      ) values
    ) values;
    print_newline ()
  in
  print t_and "And";
  print t_or "Or";
  print t_imply "Then";
  print t_eq "Equiv";
;;