extern crate image;
use image::{DynamicImage, GenericImageView, ImageBuffer, Rgba};

/// index of the alpha channel in RGBA
const ALPHA: usize = 3;

/// Computes the luminance of a single pixel
/// Result lies within `u16::MIN..u16::MAX`
const fn luminance(rgba: Rgba<u8>) -> u16 {
    let Rgba([r, g, b, _a]) = rgba;
    55 * r as u16 + 183 * g as u16 + 19 * b as u16
}

/// computes the median of a given histogram
/// Result lies within `u16::MIN..u16::MAX`
fn get_median(total: usize, histogram: &[usize]) -> u16 {
    let mut sum = 0;
    for (index, &count) in histogram.iter().enumerate() {
        sum += count;
        if sum >= total / 2 {
            return index as u16;
        }
    }

    u16::MAX
}

/// computes the histogram of a given image
fn compute_histogram(img: &DynamicImage) -> Vec<usize> {
    let mut histogram = vec![0; 1 << u16::BITS];

    img.pixels()
        .map(|(_x, _y, pixel)| luminance(pixel))
        .for_each(|luminance| histogram[luminance as usize] += 1);

    histogram
}

/// returns a black or white pixel with an alpha value
const fn black_white(is_white: bool, alpha: u8) -> [u8; 4] {
    if is_white {
        [255, 255, 255, alpha]
    } else {
        [0, 0, 0, alpha]
    }
}

/// create a monochome compy of the given image
/// preserves alpha data
fn convert_to_monochrome(img: &DynamicImage) -> ImageBuffer<Rgba<u8>, Vec<u8>> {
    let histogram = compute_histogram(img);

    let (width, height) = img.dimensions();
    let pixel_count = (width * height) as usize;
    let median = get_median(pixel_count, &histogram);

    let pixel_buffer = img.pixels()
        .flat_map(|(_x, _y, pixel)| black_white(luminance(pixel) > median, pixel[ALPHA]))
        .collect();

    ImageBuffer::from_vec(width, height, pixel_buffer).unwrap_or_else(|| unreachable!())
}

fn main() {
    let img = image::open("lena.jpg").expect("could not load image file");
    let img = convert_to_monochrome(&img);
    img.save("lena-mono.png").expect("could not save result image");
}


object BitmapOps {
   def histogram(bm:RgbBitmap)={
      val hist=new Array[Int](255)
      for(x <- 0 until bm.width; y <- 0 until bm.height; l=luminosity(bm.getPixel(x,y)))
         hist(l)+=1
      hist
   }

   def histogram_median(hist:Array[Int])={
      var from=0
      var to=hist.size-1
      var left=hist(from)
      var right=hist(to)

      while(from!=to){
         if (left<right)
            {from+=1; left+=hist(from)}
         else
            {to-=1; right+=hist(to)}
      }
      from
   }

   def monochrom(bm:RgbBitmap, threshold:Int)={
      val image=new RgbBitmap(bm.width, bm.height)
      val c1=Color.BLACK
      val c2=Color.WHITE
      for(x <- 0 until bm.width; y <- 0 until bm.height; l=luminosity(bm.getPixel(x,y)))
         image.setPixel(x, y, if(l>threshold) c2 else c1)
      image
   }
}


public class BoxingTheCompass{
    private static String[] points = new String[32];

    public static void main(String[] args){
        buildPoints();

        double heading = 0;

        for(int i = 0; i<= 32;i++){
            heading = i * 11.25;
            switch(i % 3){
                case 1:
                    heading += 5.62;
                    break;
                case 2:
                    heading -= 5.62;
                    break;
                default:
            }

            System.out.printf("%s\t%18s\t%s°\n",(i % 32) + 1, initialUpper(getPoint(heading)), heading);
        }
    }

    private static void buildPoints(){
        String[] cardinal = {"north", "east", "south", "west"};
        String[] pointDesc = {"1", "1 by 2", "1-C", "C by 1", "C", "C by 2", "2-C", "2 by 1"};

        String str1, str2, strC;

        for(int i = 0;i <= 3;i++){
            str1 = cardinal[i];
            str2 = cardinal[(i + 1) % 4];
            strC = (str1.equals("north") || str1.equals("south")) ? (str1 + str2): (str2 + str1);
            for(int j = 0;j <= 7;j++){
                points[i * 8 + j] = pointDesc[j].replace("1", str1).replace("2", str2).replace("C", strC);
            }
        }
    }

    private static String initialUpper(String s){
        return s.substring(0, 1).toUpperCase() + s.substring(1);
    }

    private static String getPoint(double degrees){
        double testD = (degrees / 11.25) + 0.5;
        return points[(int)Math.floor(testD % 32)];
    }
}


'   bitwise operations on byte-sized variables

v =int( 256 *rnd( 1))

s = 1

print "Shift            ="; s; " place."
print
print "Number as dec. = "; v; " & as 8-bits byte = ", dec2Bin$( v)
print "NOT  as dec.          =  "; bitInvert(   v),    dec2Bin$( bitInvert(   v))
print "Shifted left  as dec. =  "; shiftLeft(   v, s), dec2Bin$( shiftLeft(   v, s))
print "Shifted right as dec. =  "; shiftRight(  v, s), dec2Bin$( shiftRight(  v, s))
print "Rotated left  as dec. =  "; rotateLeft(  v, s), dec2Bin$( rotateLeft(  v, s))
print "Rotated right as dec. =  "; rotateRight( v, s), dec2Bin$( rotateRight( v, s))

end

function shiftLeft( b, n)
    shiftLeft =( b *2^n) and 255
end function

function shiftRight( b, n)
    shiftRight =int(b /2^n)
end function

function rotateLeft( b, n)
    rotateLeft = (( 2^n *b) mod 256) or ( b >127)
end function

function rotateRight( b, n)
    rotateRight = (128*( b and 1)) or int( b /2)
end function

function bitInvert( b)
    bitInvert =b xor 255
end function

function dec2Bin$( num) '   Given an integer decimal 0 <--> 255, returns binary equivalent as a string
    n =num
    dec2Bin$ =""
    while ( num >0)
        dec2Bin$    =str$( num mod 2) +dec2Bin$
        num         =int(  num /2)
    wend
    dec2Bin$ =right$( "00000000" +dec2Bin$, 8)
end function


import "graphics" for Canvas, ImageData, Color, Point
import "dome" for Window

class Game {
    static bmpCreate(name, w, h) { ImageData.create(name, w, h) }

    static bmpFill(name, col) {
        var image = ImageData[name]
        for (x in 0...image.width) {
            for (y in 0...image.height) image.pset(x, y, col)
        }
    }

    static bmpPset(name, x, y, col) { ImageData[name].pset(x, y, col) }

    static bmpPget(name, x, y) { ImageData[name].pget(x, y) }

    static bmpLine(name, x0, y0, x1, y1, col) {
        var dx = (x1 - x0).abs
        var dy = (y1 - y0).abs
        var sx = (x0 < x1) ? 1 : -1
        var sy = (y0 < y1) ? 1 : -1
        var err = ((dx > dy ? dx : - dy) / 2).floor
        while (true) {
            bmpPset(name, x0, y0, col)
            if (x0 == x1 && y0 == y1) break
            var e2 = err
            if (e2 > -dx) {
                err = err - dy
                x0 = x0 + sx
            }
            if (e2 < dy) {
                err = err + dx
                y0 = y0 + sy
            }
        }
    }

    static bmpQuadraticBezier(name, p1, p2, p3, col, n) {
        var pts = List.filled(n+1, null)
        for (i in 0..n) {
            var t = i / n
            var u = 1 - t
            var a = u * u
            var b = 2 * t * u
            var c = t * t
            var px = (a * p1.x + b * p2.x + c * p3.x).truncate
            var py = (a * p1.y + b * p2.y + c * p3.y).truncate
            pts[i] = Point.new(px, py, col)
        }
        for (i in 0...n) {
            var j = i + 1
            bmpLine(name, pts[i].x, pts[i].y, pts[j].x, pts[j].y, col)
        }
    }

    static init() {
        Window.title = "Quadratic Bézier curve"
        var size = 320
        Window.resize(size, size)
        Canvas.resize(size, size)
        var name = "quadratic"
        var bmp = bmpCreate(name, size, size)
        bmpFill(name, Color.white)
        var p1 = Point.new( 10, 100)
        var p2 = Point.new(250, 270)
        var p3 = Point.new(150,  20)
        bmpQuadraticBezier(name, p1, p2, p3, Color.darkpurple, 20)
        bmp.draw(0, 0)
    }

    static update() {}

    static draw(alpha) {}
}


package require Tcl 8.5
package require Tk

proc convert_to_blackandwhite {filename} {
    set img [image create photo]
    readPPM $img $filename
    grayscale $img
    set hist [histogram $img]
    set median [median $img $hist]
    blackandwhite $img $median
    output_ppm $img bw_$filename
}

proc histogram {image} {
    set hist [dict create]
    for {set x 0} {$x < [image width $image]} {incr x} {
        for {set y 0} {$y < [image height $image]} {incr y} {
            dict incr hist [luminance {*}[$image get $x $y]]
        }
    }
    return $hist
}

proc luminance {r g b} {
    expr {
        int(0.2126*$r + 0.7152*$g + 0.0722*$b)
    }
}

proc median {img hist} {
    set sum [expr {[image width $img] * [image height $img]}]
    set total 0
    foreach luminance [lsort -integer [dict keys $hist]] {
        incr total [dict get $hist $luminance]
        if {$total > $sum / 2} break
    }
    return $luminance
}

proc blackandwhite {image median} {
    for {set x 0} {$x < [image width $image]} {incr x} {
        for {set y 0} {$y < [image height $image]} {incr y} {
            if {[luminance {*}[$image get $x $y]] < $median} {
                $image put black -to $x $y
            } else {
                $image put white -to $x $y
            }
        }
    }
}


:HISTOGRAM:
#30 = Buf_Free			     // #30 = buffer to store histogram data
for (#9=0; #9<256; #9++) {
    Out_Reg(21) TC(#9) Out_Reg(Clear)		// @21 = intensity value to be counted
    Buf_Switch(#15)				// switch to image buffer
    #8 = Search(@21, CASE+BEGIN+ALL+NOERR)	// count intensity values
    Buf_Switch(#30)				// switch to histogram buffer
    Num_Ins(#8, FILL)				// store count
}
Return


function createRow(i, point, heading) {
    var tr = document.createElement('tr'),
        td;

    td = document.createElement('td');
    td.appendChild(document.createTextNode(i));
    tr.appendChild(td);

    td = document.createElement('td');
    point = point.substr(0, 1).toUpperCase() + point.substr(1);
    td.appendChild(document.createTextNode(point));
    tr.appendChild(td);

    td = document.createElement('td');
    td.appendChild(document.createTextNode(heading));
    tr.appendChild(td);

    return tr;
}

function getPoint(i) {
    var j = i % 8,
        i = Math.floor(i / 8) % 4,
        cardinal = ['north', 'east', 'south', 'west'],
        pointDesc = ['1', '1 by 2', '1-C', 'C by 1', 'C', 'C by 2', '2-C', '2 by 1'],
        str1, str2, strC;

    str1 = cardinal[i];
    str2 = cardinal[(i + 1) % 4];
    strC = (str1 === 'north' || str1 === 'south') ? str1 + str2 : str2 + str1;
    return pointDesc[j].replace('1', str1).replace('2', str2).replace('C', strC);
}

var i,
    heading,
    table = document.createElement('table'),
    tbody = document.createElement('tbody'),
    tr;
for (i = 0; i <= 32; i += 1) {
    heading = i * 11.25 + [0, 5.62, -5.62][i % 3];
    tr = createRow(i % 32 + 1, getPoint(i), heading + '°');
    tbody.appendChild(tr);
}
table.appendChild(tbody);
document.body.appendChild(table);


put bitAND(2,7)
put bitOR(2,7)
put bitXOR(2,7)
put bitNOT(7)


put "and:" && (255 bitand 2) & comma into bitops
put " or:" && (255 bitor 2) & comma after bitops
put " xor:" && (255 bitxor 2) & comma after bitops
put " not:" && (bitnot 255) after bitops
put bitops

-- Ouput
and: 2, or: 255, xor: 253, not: 4294967040


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

proc Bezier(P0, P1, P2);        \Draw quadratic Bezier curve
real P0, P1, P2;
def  Segments = 8;
int  I;
real T, A, B, C, X, Y;
[Move(fix(P0(0)), fix(P0(1)));
for I:= 1 to Segments do
        [T:= float(I)/float(Segments);
        A:= sq(1.-T);
        B:= 2.*T*(1.-T);
        C:= sq(T);
        X:= A*P0(0) + B*P1(0) + C*P2(0);
        Y:= A*P0(1) + B*P1(1) + C*P2(1);
        Line(fix(X), fix(Y), $00FFFF);          \cyan line segments
        ];
Point(fix(P0(0)), fix(P0(1)), $FF0000);         \red control points
Point(fix(P1(0)), fix(P1(1)), $FF0000);
Point(fix(P2(0)), fix(P2(1)), $FF0000);
];

[SetVid($112);          \set 640x480x24 video graphics
Bezier([0., 0.], [80., 100.], [160., 20.]);
if ChIn(1) then [];     \wait for keystroke
SetVid(3);              \restore normal text display
]


   fcn qBezier(p0x,p0y, p1x,p1y, p2x,p2y, rgb, numPts=500){
      numPts.pump(Void,'wrap(t){ // B(t)
      	 t=t.toFloat()/numPts; t1:=(1.0 - t);
	 a:=t1*t1; b:=t*t1*2; c:=t*t;
	 x:=a*p0x + b*p1x + c*p2x + 0.5;
	 y:=a*p0y + b*p1y + c*p2y + 0.5;
	 __sSet(rgb,x,y);
      });
   }


import "dome" for Window
import "graphics" for Canvas, Color, ImageData

class ImageHistogram {
    construct new(filename, filename2) {
        _image  = ImageData.loadFromFile(filename)
        Window.resize(_image.width, _image.height)
        Canvas.resize(_image.width, _image.height)
        Window.title = filename2
        _image2 = ImageData.create("Grayscale", _image.width, _image.height)
        _image3 = ImageData.create("B & W", _image.width, _image.height)
    }

    init() {
        toGrayScale()
        var h = histogram
        var m = median(h)
        toBlackAndWhite(m)
        _image3.draw(0, 0)
        _image3.saveToFile(Window.title)
    }

    luminance(c) { (0.2126 * c.r + 0.7152 * c.g + 0.0722 * c.b).floor }

    toGrayScale() {
        for (x in 0..._image.width) {
            for (y in 0..._image.height) {
                var c1 = _image.pget(x, y)
                var lumin = luminance(c1)
                var c2 = Color.rgb(lumin, lumin, lumin, c1.a)
                _image2.pset(x, y, c2)
            }
        }
    }

    toBlackAndWhite(median) {
        for (x in 0..._image2.width) {
            for (y in 0..._image2.height) {
                var c = _image2.pget(x, y)
                var lum = luminance(c)
                if (lum < median) {
                    _image3.pset(x, y, Color.black)
                } else {
                    _image3.pset(x, y, Color.white)
                }
            }
        }
    }

    histogram {
        var h = List.filled(256, 0)
        for (x in 0..._image2.width) {
            for (y in 0..._image2.height) {
                var c = _image2.pget(x, y)
                var lum = luminance(c)
                h[lum] = h[lum] + 1
             }
        }
        return h
    }

    median(h) {
        var lSum  = 0
        var rSum  = 0
        var left  = 0
        var right = 255
        while (true) {
            if (lSum < rSum) {
                lSum = lSum + h[left]
                left = left + 1
            } else {
                rSum = rSum + h[right]
                right = right - 1
            }
            if (left == right) break
        }
        return left
    }

    update() {}

    draw(alpha) {}
}

var Game = ImageHistogram.new("Lenna100.jpg", "Lenna100_B&W.png")


using Printf

function degree2compasspoint(d::Float64)
    majors = ("north", "east", "south", "west", "north", "east", "south", "west")
    quarter1 = ("N", "N by E", "N-NE", "NE by N", "NE", "NE by E", "E-NE", "E by N")
    quarter2 = map(p -> replace(p, "NE" => "EN"), quarter1)

    d = d % 360 + 360 / 64
    imajor, minor = divrem(d, 90)
    iminor = div(minor * 4, 45)
    imajor += 1
    iminor += 1
    p1, p2 = majors[imajor:imajor+1]
    q = p1 in ("north", "south") ? quarter1 : quarter2
    titlecase(replace(replace(q[iminor], 'N' => p1), 'E' => p2))
end

for i in 0:32
    d = i * 11.25
    i % 3 == 1 && (d += 5.62)
    i % 3 == 2 && (d -= 5.62)
    @printf("%2i %-17s %10.2f°\n", i % 32 + 1, degree2compasspoint(d), d)
end


   d:("N;Nbe;N-ne;Nebn;Ne;Nebe;E-ne;Ebn;")
   d,:("E;Ebs;E-se;Sebe;Se;Sebs;S-se;Sbe;")
   d,:("S;Sbw;S-sw;Swbs;Sw;Swbw;W-sw;Wbs;")
   d,:("W;Wbn;W-nw;Nwbw;Nw;Nwbn;N-nw;Nbw;N")

   split:{1_'(&x=y)_ x:y,x}
   dd:split[d;";"]

   / lookup table
   s1:"NEWSnewsb-"
   s2:("North";"East";"West";"South";"north";"east";"west";"south";" by ";"-")
   c:.({`$x}'s1),'{`$x}'s2   / create the dictionary
   cc:{,/{$c[`$$x]}'x}       / lookup function

   / calculate the degrees
   f:{m:x!3;(11.25*x)+:[1=m;+5.62;2=m;-5.62;0]}


; ModuleID = 'test.o'
;e means little endian
;p: { pointer size : pointer abi : preferred alignment for pointers }
;i same for integers
;v is for vectors
;f for floats
;a for aggregate types
;s for stack objects
;n: {size:size:size...}, best integer sizes
target datalayout = "e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-f80:32:32-n8:16:32"
;this was compiled with mingw32; thus it must be linked to an ABI compatible c library
target triple = "i386-mingw32"

@.str = private constant [13 x i8] c"a and b: %d\0A\00", align 1 ; <[13 x i8]*> [#uses=1]
@.str1 = private constant [12 x i8] c"a or b: %d\0A\00", align 1 ; <[12 x i8]*> [#uses=1]
@.str2 = private constant [13 x i8] c"a xor b: %d\0A\00", align 1 ; <[13 x i8]*> [#uses=1]
@.str3 = private constant [11 x i8] c"not a: %d\0A\00", align 1 ; <[11 x i8]*> [#uses=1]
@.str4 = private constant [12 x i8] c"a << n: %d\0A\00", align 1 ; <[12 x i8]*> [#uses=1]
@.str5 = private constant [12 x i8] c"a >> n: %d\0A\00", align 1 ; <[12 x i8]*> [#uses=1]
@.str6 = private constant [12 x i8] c"c >> b: %d\0A\00", align 1 ; <[12 x i8]*> [#uses=1]

;A function that will do many bitwise opreations to two integer arguments, %a and %b
define void @bitwise(i32 %a, i32 %b) nounwind {
;entry block
entry:
  ;Register to store (a & b)
  %0 = and i32 %b, %a                             ; <i32> [#uses=1]
  ;print the results
  %1 = tail call i32 (i8*, ...)* @printf(i8* getelementptr inbounds ([13 x i8]* @.str, i32 0, i32 0), i32 %0) nounwind ; <i32> [#uses=0]
  ;Register to store (a | b)
  %2 = or i32 %b, %a                              ; <i32> [#uses=1]
  ;print the results
  %3 = tail call i32 (i8*, ...)* @printf(i8* getelementptr inbounds ([12 x i8]* @.str1, i32 0, i32 0), i32 %2) nounwind ; <i32> [#uses=0]
  ;Register to store (a ^ b)
  %4 = xor i32 %b, %a                             ; <i32> [#uses=1]
  ;print the results
  %5 = tail call i32 (i8*, ...)* @printf(i8* getelementptr inbounds ([13 x i8]* @.str2, i32 0, i32 0), i32 %4) nounwind ; <i32> [#uses=0]
  ;Register to store (~a)
  %not = xor i32 %a, -1                           ; <i32> [#uses=1]
  ;print the results
  %6 = tail call i32 (i8*, ...)* @printf(i8* getelementptr inbounds ([11 x i8]* @.str3, i32 0, i32 0), i32 %not) nounwind ; <i32> [#uses=0]
  ;Register to store (a << b)
  %7 = shl i32 %a, %b                             ; <i32> [#uses=1]
  ;print the results
  %8 = tail call i32 (i8*, ...)* @printf(i8* getelementptr inbounds ([12 x i8]* @.str4, i32 0, i32 0), i32 %7) nounwind ; <i32> [#uses=0]
  ;Register to store (a >> b) (a is signed)
  %9 = ashr i32 %a, %b                            ; <i32> [#uses=1]
  ;print the results
  %10 = tail call i32 (i8*, ...)* @printf(i8* getelementptr inbounds ([12 x i8]* @.str5, i32 0, i32 0), i32 %9) nounwind ; <i32> [#uses=0]
  ;Register to store (c >> b), where c is unsiged (eg. logical right shift)
  %11 = lshr i32 %a, %b                           ; <i32> [#uses=1]
  ;print the results
  %12 = tail call i32 (i8*, ...)* @printf(i8* getelementptr inbounds ([12 x i8]* @.str6, i32 0, i32 0), i32 %11) nounwind ; <i32> [#uses=0]

  ;terminator instruction
  ret void
}

;Declare external fuctions
declare i32 @printf(i8* nocapture, ...) nounwind


fcn histogram(image){
   hist:=List.createLong(256,0);	// array[256] of zero
   image.data.howza(0).pump(Void,'wrap(c){ hist[c]+=1 });  // byte by byte loop
   hist;
}
fcn histogramMedian(hist){
   from,to:=0,(2).pow(8) - 1; // 16 bits of luminance
   left,right:=hist[from],hist[to];
   while(from!=to){
      if(left<right){ from+=1; left +=hist[from]; }
      else 	    { to  -=1; right+=hist[to];   }
   }
   from
}


// version 1.1.2

fun expand(cp: String): String {
    val sb = StringBuilder()
    for (c in cp) {
        sb.append(when (c) {
            'N'  -> "north"
            'E'  -> "east"
            'S'  -> "south"
            'W'  -> "west"
            'b'  -> " by "
            else -> "-"
        })
    }
    return sb.toString().capitalize()
}

fun main(args: Array<String>) {
    val cp = arrayOf(
        "N", "NbE", "N-NE", "NEbN", "NE", "NEbE", "E-NE", "EbN",
        "E", "EbS", "E-SE", "SEbE", "SE", "SEbS", "S-SE", "SbE",
        "S", "SbW", "S-SW", "SWbS", "SW", "SWbW", "W-SW", "WbS",
        "W", "WbN", "W-NW", "NWbW", "NW", "NWbN", "N-NW", "NbW"
    )
    println("Index  Degrees  Compass point")
    println("-----  -------  -------------")
    val f = "%2d     %6.2f   %s"
    for (i in 0..32) {
        val index  = i % 32
        var heading = i * 11.25
        when (i % 3) {
            1 -> heading += 5.62
            2 -> heading -= 5.62
        }
        println(f.format(index + 1, heading, expand(cp[index])))
    }
}


to bitwise :a :b
  (print [a and b:] BitAnd :a :b)
  (print [a or b:] BitOr :a :b)
  (print [a xor b:] BitXor :a :b)
  (print [not a:] BitNot :a)
  ; shifts are to the left if positive, to the right if negative
  (print [a lshift b:] LShift :a :b)
  (print [a lshift -b:] LShift :a minus :b)
  (print [-a ashift -b:] AShift minus :a minus :b)
end
bitwise 255 5


over : 2 pick
2dup : over over

bitwise : \
  " A=" ,t over ,h sp " B=" ,t dup ,h nl \
  " A and B=" ,t 2dup & ,h nl \
  " A  or B=" ,t 2dup | ,h nl \
  " A xor B=" ,t over ^ ,h nl \
  " not A="  ,t      ~ ,h nl

\ a \ 7 bitwise   # hex literals


val .box = ["North", "North by east", "North-northeast", "Northeast by north",
    "Northeast", "Northeast by east", "East-northeast", "East by north",
    "East", "East by south", "East-southeast", "Southeast by east",
    "Southeast", "Southeast by south", "South-southeast", "South by east",
    "South", "South by west", "South-southwest", "Southwest by south",
    "Southwest", "Southwest by west", "West-southwest", "West by south",
    "West", "West by north", "West-northwest", "Northwest by west",
    "Northwest", "Northwest by north", "North-northwest", "North by west"]

val .angles = [
    0.0, 16.87, 16.88, 33.75, 50.62, 50.63, 67.5, 84.37, 84.38,
    101.25, 118.12, 118.13, 135.0, 151.87, 151.88, 168.75, 185.62,
    185.63, 202.5, 219.37, 219.38, 236.25, 253.12, 253.13, 270.0,
    286.87, 286.88, 303.75, 320.62, 320.63, 337.5, 354.37, 354.38]

writeln "index   degrees    compass point"
writeln "-----   -------    -------------"

for .phi in .angles {
    val .i = truncate(.phi x 32 / 360 + 0.5) rem 32 + 1
    writeln $"\.i:5;    \.phi:r2:6;    \.box[.i];"
}


define pointsarray() => {
	local(points = array)
	loop(-from=0,-to=32) => {
		local(heading = loop_count * 11.25)
		if(loop_count % 3 == 1) => {
			#heading += 5.62
		else(loop_count % 3 == 2)
			#heading -= 5.62
		}
		#points->insert(#heading)
	}
	return #points
}
define compassShort => array(
	'N','Nbe','N-ne','Nebn','Ne','Nebe','E-ne','Ebn',
	'E','Ebs','E-se','Sebe','Se','Sebs','S-se','Sbe',
	'S','Sbw','S-sw','Swbs','Sw','Swbw','W-sw','Wbs',
	'W','Wbn','W-nw','Nwbw','Nw','Nwbn','N-nw','Nbw', 'N')
define compassLong(short::string) => {
	local(o = string)
	with i in #short->values do => { #o->append(compassLongProcessor(#i)) }
	return #o
}
define compassLongProcessor(char::string) => {
	#char == 'N' ? return #char + 'orth'
	#char == 'S' ? return #char + 'outh'
	#char == 'E' ? return #char + 'ast'
	#char == 'W' ? return #char + 'est'
	#char == 'b' ? return ' by '
	#char == '-' ? return '-'
}
// test output points as decimals
//pointsarray

// test output the array of text values
//compassShort

// test output the long names of the text values
//with s in compassShort do => {^ compassLong(#s) + '\r' ^}

'angle  | box  | compass point
---------------------------------
'
local(counter = 0)
with p in pointsarray do => {^
	local(pformatted = #p->asString(-precision=2))
	while(#pformatted->size < 6) => { #pformatted->append(' ') }
	#counter += 1
	#counter > 32 ? #counter = 1
	#pformatted + ' |  ' + (#counter < 10 ? ' ') + #counter + '  | ' + compassLong(compassShort->get(#counter)) + '\r'

^}


local bit = require"bit"

local vb = {
  0, 1, -1, 2, -2, 0x12345678, 0x87654321,
  0x33333333, 0x77777777, 0x55aa55aa, 0xaa55aa55,
  0x7fffffff, 0x80000000, 0xffffffff
}

local function cksum(name, s, r)
  local z = 0
  for i=1,#s do z = (z + string.byte(s, i)*i) % 2147483629 end
  if z ~= r then
    error("bit."..name.." test failed (got "..z..", expected "..r..")", 0)
  end
end

local function check_unop(name, r)
  local f = bit[name]
  local s = ""
  if pcall(f) or pcall(f, "z") or pcall(f, true) then
    error("bit."..name.." fails to detect argument errors", 0)
  end
  for _,x in ipairs(vb) do s = s..","..tostring(f(x)) end
  cksum(name, s, r)
end

local function check_binop(name, r)
  local f = bit[name]
  local s = ""
  if pcall(f) or pcall(f, "z") or pcall(f, true) then
    error("bit."..name.." fails to detect argument errors", 0)
  end
  for _,x in ipairs(vb) do
    for _,y in ipairs(vb) do s = s..","..tostring(f(x, y)) end
  end
  cksum(name, s, r)
end

local function check_binop_range(name, r, yb, ye)
  local f = bit[name]
  local s = ""
  if pcall(f) or pcall(f, "z") or pcall(f, true) or pcall(f, 1, true) then
    error("bit."..name.." fails to detect argument errors", 0)
  end
  for _,x in ipairs(vb) do
    for y=yb,ye do s = s..","..tostring(f(x, y)) end
  end
  cksum(name, s, r)
end

local function check_shift(name, r)
  check_binop_range(name, r, 0, 31)
end

-- Minimal sanity checks.
assert(0x7fffffff == 2147483647, "broken hex literals")
assert(0xffffffff == -1 or 0xffffffff == 2^32-1, "broken hex literals")
assert(tostring(-1) == "-1", "broken tostring()")
assert(tostring(0xffffffff) == "-1" or tostring(0xffffffff) == "4294967295", "broken tostring()")

-- Basic argument processing.
assert(bit.tobit(1) == 1)
assert(bit.band(1) == 1)
assert(bit.bxor(1,2) == 3)
assert(bit.bor(1,2,4,8,16,32,64,128) == 255)


dim point$( 32)

for i =1 to 32
    read d$: point$( i) =d$
next i

for i = 0 to 32
    heading = i *11.25
    if ( i mod 3) =1 then
        heading = heading +5.62
    else
        if ( i mod 3) =2 then heading = heading -5.62
    end if
    ind = i mod 32 +1
    print ind, compasspoint$( heading), heading
next i

end

function compasspoint$( h)
    x = h /11.25 +1.5
    if (x >=33.0) then x =x -32.0
    compasspoint$ = point$( int( x))
end function

data  "North             ", "North by east     ", "North-northeast   "
data  "Northeast by north", "Northeast         ", "Northeast by east ", "East-northeast    "
data  "East by north     ", "East              ", "East by south     ", "East-southeast    "
data  "Southeast by east ", "Southeast         ", "Southeast by south", "South-southeast   "
data  "South by east     ", "South             ", "South by west     ", "South-southwest   "
data  "Southwest by south", "Southwest         ", "Southwest by west ", "West-southwest    "
data  "West by south     ", "West              ", "West by north     ", "West-northwest    "
data  "Northwest by west ", "Northwest         ", "Northwest by north", "North-northwest   "
data  "North by west


with(Bits):
bit:=proc(A,B)
local a,b,c,d,e,f,g,h,i,x,bitpow;
bitpow := 2^B:
a:=And(A,B);
b:=Not(A);
c:=Or(A,B);
d:=Xor(A,B);
#Left Shift
e:= irem(2*A,bitpow);
#Right Shift
f := iquo(A,2);
#Left Rotate
g:= irem(2*A,bitpow,'x')+x;
#Rightarithshift
i:= iquo(A,2)+bitpow/2*irem(A,bitpow/2);
return a,b,c,d,e,f,g,i;
end proc;


(*and xor and or*)
BitAnd[integer1, integer2]
BitXor[integer1, integer2]
BitOr[integer1, integer2]

(*logical not*)
BitNot[integer1]

(*left and right shift*)
BitShiftLeft[integer1]
BitShiftRight[integer1]

(*rotate digits left and right*)
FromDigits[RotateLeft[IntegerDigits[integer1, 2]], 2]
FromDigits[RotateRight[IntegerDigits[integer1, 2]], 2]

(*right arithmetic shift*)
FromDigits[Prepend[Most[#], #[[1]]], 2] &[IntegerDigits[integer1, 2]]


; This is not strictly LLVM, as it uses the C library function "printf".
; LLVM does not provide a way to print values, so the alternative would be
; to just load the string into memory, and that would be boring.

; Additional comments have been inserted, as well as changes made from the output produced by clang such as putting more meaningful labels for the jumps

;--- The declarations for the external C functions
declare i32 @printf(i8*, ...)

$"COMPASS_STR" = comdat any
$"OUTPUT_STR" = comdat any

@main.degrees = private unnamed_addr constant [33 x double] [double 0.000000e+00, double 1.687000e+01, double 1.688000e+01, double 3.375000e+01, double 5.062000e+01, double 5.063000e+01, double 6.750000e+01, double 8.437000e+01, double 0x40551851EB851EB8, double 1.012500e+02, double 1.181200e+02, double 1.181300e+02, double 1.350000e+02, double 1.518700e+02, double 1.518800e+02, double 1.687500e+02, double 1.856200e+02, double 1.856300e+02, double 2.025000e+02, double 2.193700e+02, double 2.193800e+02, double 2.362500e+02, double 2.531200e+02, double 2.531300e+02, double 2.700000e+02, double 2.868700e+02, double 2.868800e+02, double 3.037500e+02, double 3.206200e+02, double 3.206300e+02, double 3.375000e+02, double 3.543700e+02, double 3.543800e+02], align 16
@"COMPASS_STR" = linkonce_odr unnamed_addr constant [727 x i8] c"North                 North by east         North-northeast       Northeast by north    Northeast             Northeast by east     East-northeast        East by north         East                  East by south         East-southeast        Southeast by east     Southeast             Southeast by south    South-southeast       South by east         South                 South by west         South-southwest       Southwest by south    Southwest             Southwest by west     West-southwest        West by south         West                  West by north         West-northwest        Northwest by west     Northwest             Northwest by north    North-northwest       North by west         North                 \00", comdat, align 1
@"OUTPUT_STR" = linkonce_odr unnamed_addr constant [19 x i8] c"%2d  %.22s  %6.2f\0A\00", comdat, align 1

; Function Attrs: noinline nounwind optnone uwtable
define i32 @main() #0 {
  %1 = alloca i32, align 4                  ;-- allocate i
  %2 = alloca i32, align 4                  ;-- allocate j
  %3 = alloca [33 x double], align 16       ;-- allocate degrees
  %4 = alloca i8*, align 8                  ;-- allocate names
  %5 = bitcast [33 x double]* %3 to i8*
  call void @llvm.memcpy.p0i8.p0i8.i64(i8* %5, i8* bitcast ([33 x double]* @main.degrees to i8*), i64 264, i32 16, i1 false)
  store i8* getelementptr inbounds ([727 x i8], [727 x i8]* @"COMPASS_STR", i32 0, i32 0), i8** %4, align 8
  store i32 0, i32* %1, align 4             ;-- i = 0
  br label %loop

loop:
  %6 = load i32, i32* %1, align 4           ;-- load i
  %7 = icmp slt i32 %6, 33                  ;-- i < 33
  br i1 %7, label %loop_body, label %exit

loop_body:
  %8 = load i32, i32* %1, align 4           ;-- load i
  %9 = sext i32 %8 to i64                   ;-- sign extend i
  %10 = getelementptr inbounds [33 x double], [33 x double]* %3, i64 0, i64 %9  ;-- calculate index of degrees[i]
  %11 = load double, double* %10, align 8   ;-- load degrees[i]
  %12 = fmul double %11, 3.200000e+01       ;-- degrees[i] * 32
  %13 = fdiv double %12, 3.600000e+02       ;-- degrees[i] * 32 / 360.0
  %14 = fadd double 5.000000e-01, %13       ;-- 0.5 + degrees[i] * 32 / 360.0
  %15 = fptosi double %14 to i32            ;-- convert floating point to integer
  store i32 %15, i32* %2, align 4           ;-- write result to j

  %16 = load i8*, i8** %4, align 8          ;-- load names
  %17 = load i32, i32* %2, align 4          ;-- load j
  %18 = srem i32 %17, 32                    ;-- j % 32
  %19 = mul nsw i32 %18, 22                 ;-- (j % 32) * 22
  %20 = sext i32 %19 to i64                 ;-- sign extend the result
  %21 = getelementptr inbounds i8, i8* %16, i64 %20 ;-- load names at the calculated offset
  %22 = load i32, i32* %2, align 4          ;-- load j
  %23 = srem i32 %22, 32                    ;-- j % 32
  %24 = add nsw i32 %23, 1                  ;-- (j % 32) + 1
  %25 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([19 x i8], [19 x i8]* @"OUTPUT_STR", i32 0, i32 0), i32 %24, i8* %21, double %11)

  %26 = load i32, i32* %1, align 4          ;-- load i
  %27 = add nsw i32 %26, 1                  ;-- increment i
  store i32 %27, i32* %1, align 4           ;-- store i
  br label %loop

exit:
  ret i32 0
}

; Function Attrs: argmemonly nounwind
declare void @llvm.memcpy.p0i8.p0i8.i64(i8* nocapture writeonly, i8* nocapture readonly, i64, i32, i1) #1

attributes #0 = { noinline nounwind optnone uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "less-precise-fpmad"="false" "no-frame-pointer-elim"="false" "no-infs-fp-math"="false" "no-jump-tables"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="false" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }
attributes #1 = { argmemonly nounwind }


function bitwiseOps(a,b)

    disp(sprintf('%d and %d = %d', [a b bitand(a,b)]));
    disp(sprintf('%d or %d = %d', [a b bitor(a,b)]));
    disp(sprintf('%d xor %d = %d', [a b bitxor(a,b)]));
    disp(sprintf('%d << %d = %d', [a b bitshift(a,b)]));
    disp(sprintf('%d >> %d = %d', [a b bitshift(a,-b)]));

end


; List of abbreviated compass point labels
make "compass_points [ N NbE N-NE NEbN NE NEbE E-NE EbN
                       E EbS E-SE SEbE SE SEbS S-SE SbE
                       S SbW S-SW SWbS SW SWbW W-SW WbS
                       W WbN W-NW NWbW NW NWbN N-NW NbW ]

; List of angles to test
make "test_angles [  0.00  16.87  16.88  33.75  50.62  50.63  67.50
                    84.37  84.38 101.25 118.12 118.13 135.00 151.87
                   151.88 168.75 185.62 185.63 202.50 219.37 219.38
                   236.25 253.12 253.13 270.00 286.87 286.88 303.75
                   320.62 320.63 337.50 354.37 354.38 ]

; make comparisons case-sensitive
make "caseignoredp "false

; String utilities: search and replace
to replace_in :src :from :to
  output map [ ifelse equalp ? :from [:to] [?] ] :src
end

; pad with spaces
to pad :string :length
  output cascade [lessp :length count ?] [word ? "\ ] :string
end

; capitalize first letter
to capitalize :string
  output word (uppercase first :string) butfirst :string
end

; convert compass point abbreviation to full text of label
to expand_point :abbr
  foreach [[N north] [E east] [S south] [W west] [b \ by\ ]] [
    make "abbr replace_in :abbr (first ?) (last ?)
  ]
  output capitalize :abbr
end

; modulus function that returns 1..N instead of 0..N-1
to adjusted_modulo :n :d
  output sum 1 modulo (difference :n 1) :d
end

; convert a compass angle from degrees into a box index (1..32)
to compass_point :degrees
  make "degrees modulo :degrees 360
  output adjusted_modulo (sum 1 int quotient (sum :degrees 5.625) 11.25) 32
end

;  Now output the table of test data
print (sentence (pad "Degrees 7) "\| (pad "Closest\ Point 18) "\| "Index )
foreach :test_angles [
  local "index
  make "index compass_point ?
  local "abbr
  make "abbr item :index :compass_points
  local "label
  make "label expand_point :abbr
  print (sentence (form ? 7 2) "\| (pad :label 18) "\| (form :index 2 0) )
]

; and exit
bye


fn bitwise a b =
(
    format "a and b: %\n" (bit.and a b)
    format "a or b: %\n" (bit.or a b)
    format "a xor b: %\n" (bit.xor a b)
    format "not a: %\n" (bit.not a)
    format "Left shift a: %\n" (bit.shift a b)
    format "Right shift a: %\n" (bit.shift a -b)
)

bitwise 255 170


MCSKIP "WITH" NL
"" Bitwise operations
"" assumes macros on input stream 1, terminal on stream 2
MCSKIP MT,<>
MCINS %.
MCDEF SL SPACES NL AS <MCSET T1=%A1.
MCSET T2=%A2.
a and b = %%T1.&%T2..
a or b  = %%T1.|%T2..
The other operators are not supported.
MCSET S10=0
>
MCSKIP SL WITH *
MCSET S1=1
*MCSET S10=2


-- List of abbreviated compass point labels
compass_points = { "N", "NbE", "N-NE", "NEbN", "NE", "NEbE", "E-NE", "EbN",
                   "E", "EbS", "E-SE", "SEbE", "SE", "SEbS", "S-SE", "SbE",
                   "S", "SbW", "S-SW", "SWbS", "SW", "SWbW", "W-SW", "WbS",
                   "W", "WbN", "W-NW", "NWbW", "NW", "NWbN", "N-NW", "NbW" }

-- List of angles to test
test_angles = {  0.00,  16.87,  16.88,  33.75,  50.62,  50.63,  67.50,
                84.37,  84.38, 101.25, 118.12, 118.13, 135.00, 151.87,
               151.88, 168.75, 185.62, 185.63, 202.50, 219.37, 219.38,
               236.25, 253.12, 253.13, 270.00, 286.87, 286.88, 303.75,
               320.62, 320.63, 337.50, 354.37, 354.38 }

-- capitalize a string
function capitalize(s)
  return s:sub(1,1):upper() .. s:sub(2)
end

-- convert compass point abbreviation to full text of label
function expand_point(abbr)
  for from, to in pairs( { N="north", E="east", S="south", W="west",
                             b=" by " }) do
    abbr = abbr:gsub(from, to)
  end
  return capitalize(abbr)
end

-- modulus function that returns 1..N instead of 0..N-1
function adjusted_modulo(n, d)
  return 1 + (n - 1) % d
end

-- convert a compass angle from degrees into a box index (1..32)
function compass_point(degrees)
  degrees = degrees % 360
  return adjusted_modulo(1 + math.floor( (degrees+5.625) / 11.25), 32)
end

--  Now output the table of test data
header_format = "%-7s | %-18s | %s"
row_format = "%7.2f | %-18s | %2d"
print(header_format:format("Degrees", "Closest Point", "Index"))
for i, angle in ipairs(test_angles) do
  index = compass_point(angle)
  abbr  = compass_points[index]
  label  = expand_point(abbr)
  print(row_format:format(angle, label, index))
end


MODULE Bitwise EXPORTS Main;

IMPORT IO, Fmt, Word;

VAR c: Word.T;

PROCEDURE Bitwise(a, b: INTEGER) =
  BEGIN
    IO.Put("a AND b: " & Fmt.Int(Word.And(a, b)) & "\n");
    IO.Put("a OR b: " & Fmt.Int(Word.Or(a, b)) & "\n");
    IO.Put("a XOR b: " & Fmt.Int(Word.Xor(a, b)) & "\n");
    IO.Put("NOT a: " & Fmt.Int(Word.Not(a)) & "\n");
    c := a;
    IO.Put("c LeftShift b: " & Fmt.Unsigned(Word.LeftShift(c, b)) & "\n");
    IO.Put("c RightShift b: " & Fmt.Unsigned(Word.RightShift(c, b)) & "\n");
    IO.Put("c LeftRotate b: " & Fmt.Unsigned(Word.LeftRotate(c, b)) & "\n");
    IO.Put("c RightRotate b: " & Fmt.Unsigned(Word.RightRotate(c, b)) & "\n");
  END Bitwise;

BEGIN
  Bitwise(255, 5);
END Bitwise.


Module CheckIt {
      Locale 1033   'change decimal point char to dot.
      Form 80,50    ' set console to 80 characters by 50 lines
      \\ Function heading() get a positive double as degrees and return the  compass index (1 for North)
      Function heading(d) {
            d1=d div 11.25
            if d1 mod 3= 1 then d+=5.62 :d1=d div 11.25
            =d1 mod 32 +1
      }
      Dim wind$(1 to 32)
      wind$(1)="North", "North by east", "North-northeast", "Northeast by north", "Northeast"
      wind$(6)="Northeast by east", "East-northeast", "East by north", "East", "East by south", "East-southeast"
      wind$(12)="Southeast by east", "Southeast", "Southeast by south", "South-southeast", "South by east", "South"
      wind$(18)="South by west", "South-southwest", "Southwest by south", "Southwest", "Southwest by west", "West-southwest"
      wind$(24)="West by south", "West", "West by north", "West-northwest", "Northwest by west", "Northwest", "Northwest by north"
      wind$(31)="North-northwest", "North by west"
      oldvalue=-2
      newvalue=2
      Print " angle | box | compass point"
      Print "-------+-----+---------------------"
      For i=0 to 360 step 0.005
            newvalue=heading(i)
            if (newvalue mod 3) =2 then i+=5.62: newvalue=heading(i)
            if oldvalue<>newvalue then Print format$("{0:2:-6}°|  {1::-2} | {2}",i, newvalue, wind$(newvalue)) : oldvalue=newvalue : refresh
      Next i
}
CheckIt


/**
 <doc>

bitwise operations

Tectonics:

  nekoc bitwise.neko

  neko bitwise

 </doc>
*/

// Neko is a signed 31 bit integer VM, full 32 bit requires builtins
var int32_new = $loader.loadprim("[email protected]_new", 1);
var int32_and = $loader.loadprim("[email protected]_and", 2);
var int32_or = $loader.loadprim("[email protected]_or", 2);
var int32_xor = $loader.loadprim("[email protected]_xor", 2);
var int32_shl = $loader.loadprim("[email protected]_shl", 2);
var int32_shr = $loader.loadprim("[email protected]_shr", 2);
var int32_ushr = $loader.loadprim("[email protected]_ushr", 2);
var int32_complement = $loader.loadprim("[email protected]_complement", 1);

// Function to show bitwise operations on a,b
var bitwise = function(a, b) {
  var ia = int32_new(a);
  var ib = int32_new(b);

  $print("Neko 32 bit integer library\n");
  $print("a AND b: ", a, " ", b, " ", int32_and(ia, ib), "\n");
  $print("a OR b:  ", a, " ", b, " ", int32_or(ia, ib), "\n");
  $print("a XOR b: ", a, " ", b, " ", int32_xor(ia, ib), "\n");
  $print("ones complement a:   ", a, " ", int32_complement(ia), "\n");
  $print("a SHL b: ", a, " ", b, " ", int32_shl(ia, ib), "\n");
  $print("a SHR b: ", a, " ", b, " ", int32_shr(ia, ib), "\n");
  $print("a USHR b: ", a, " ", b, " ", int32_ushr(ia, ib), "\n");
  $print("a ROL b: is not directly supported in Neko Int32\n");
  $print("a ROR b: is not directly supported in Neko Int32\n");

  $print("\nNormal Neko 31 bit signed integers\n");
  a = $int(a);
  b = $int(b);
  $print("a AND b: ", a, " ", b, " ", a & b, "\n");
  $print("a OR  b: ", a, " ", b, " ", a | b, "\n");
  $print("a XOR b: ", a, " ", b, " ", a ^ b, "\n");
  $print("NOT a: is not directly supported in Neko syntax\n");
  $print("a SHL b: ", a, " ", b, " ", a <> b, "\n");
  $print("a USHR b: ", a, " ", b, " ", a >>> b, "\n");
  $print("a ROL b: is not directly supported in Neko syntax\n");
  $print("a ROR b: is not directly supported in Neko syntax\n");
}

// Pass command line arguments to the demo function
// initially as float, to ensure no internal bit truncation
var a = $float($loader.args[0]);
var b = $float($loader.args[1]);
if a == null a = 0;
if b == null b = 0;

bitwise(a,b);


function b = compassbox(d)
    b = ceil(mod(d+360/64,360)*32/360);
end;


MODULE BoxTheCompass;
FROM FormatString IMPORT FormatString;
FROM RealStr IMPORT RealToStr;
FROM Terminal IMPORT WriteString,WriteLn,Write,ReadChar;

PROCEDURE expand(cp : ARRAY OF CHAR);
VAR i : INTEGER = 0;
BEGIN
    WHILE cp[i] # 0C DO
        IF i=0 THEN
            CASE cp[i] OF
                'N': WriteString("North") |
                'E': WriteString("East")  |
                'S': WriteString("South") |
                'W': WriteString("West")  |
                'b': WriteString(" by ")
            ELSE
                WriteString("-");
            END;
        ELSE
            CASE cp[i] OF
                'N': WriteString("north") |
                'E': WriteString("east")  |
                'S': WriteString("south") |
                'W': WriteString("west")  |
                'b': WriteString(" by ")
            ELSE
                WriteString("-");
            END;
        END;
        INC(i)
    END;
END expand;

PROCEDURE FormatReal(r : REAL);
VAR
    buf : ARRAY[0..63] OF CHAR;
    u,v : INTEGER;
    w : REAL;
BEGIN
    u := TRUNC(r);
    w := r - FLOAT(u);
    v := TRUNC(100.0 * w);

    FormatString("%6i.%'02i", buf, u, v);
    WriteString(buf);
END FormatReal;

VAR
    cp : ARRAY[0..31] OF ARRAY[0..4] OF CHAR = {
        "N", "NbE", "N-NE", "NEbN", "NE", "NEbE", "E-NE", "EbN",
        "E", "EbS", "E-SE", "SEbE", "SE", "SEbS", "S-SE", "SbE",
        "S", "SbW", "S-SW", "SWbS", "SW", "SWbW", "W-SW", "WbS",
        "W", "WbN", "W-NW", "NWbW", "NW", "NWbN", "N-NW", "NbW"
    };
    buf : ARRAY[0..63] OF CHAR;
    i,index : INTEGER;
    heading : REAL;
BEGIN
    WriteString("Index  Degrees  Compass point");
    WriteLn;
    WriteString("-----  -------  -------------");
    WriteLn;
    FOR i:=0 TO 32 DO
        index := i MOD 32;
        heading := FLOAT(i) * 11.25;
        CASE i MOD 3 OF
            1: heading := heading + 5.62; |
            2: heading := heading - 5.62;
        ELSE
            (* empty *)
        END;
        FormatString("%2i  ", buf, index+1);
        WriteString(buf);
        FormatReal(heading);
        WriteString("   ");
        expand(cp[index]);
        WriteLn
    END;

    ReadChar
END BoxTheCompass.


def i = 255;
def j = 2;

WriteLine($"$i and $j is $(i & j)");
WriteLine($"$i or $j is $(i | j)");
WriteLine($"$i xor $j is $(i ^ j)");
WriteLine($"not $i is $(~i)");
WriteLine($"$i lshift $j is $(i << j)");
WriteLine($"$i arshift $j is $(i >> j)");          // When the left operand of the >> operator is of a signed integral type,
                                                   // the operator performs an arithmetic shift right
WriteLine($"$(i :> uint) rshift $j is $(c >> j)"); // When the left operand of the >> operator is of an unsigned integral type,
                                                   // the operator performs a logical shift right
// there are no rotation operators in Nemerle, but you could define your own w/ a macro if you really wanted it


proc bitwise(a, b) =
  echo "a and b: " , a and b
  echo "a or b: ", a or b
  echo "a xor b: ", a xor b
  echo "not a: ", not a
  echo "a << b: ", a shl b
  echo "a >> b: ", a shr b


BOXING(DEGREE)
 ;This takes in a degree heading, nominally from 0 to 360, and returns the compass point name.
 QUIT:((DEGREE<0)||(DEGREE>360)) "land lubber can't read a compass"
 NEW DIRS,UNP,UNPACK,SEP,DIR,DOS,D,DS,I,F
 SET DIRS="N^NbE^N-NE^NEbN^NE^NEbE^E-NE^EbN^E^EbS^E-SE^SEbE^SE^SEbS^S-SE^SbE^"
 SET DIRS=DIRS_"S^SbW^S-SW^SWbS^SW^SWbW^W-SW^WbS^W^WbN^W-NW^NWbW^NW^NWbN^N-NW^NbW"
 SET UNP="NESWb"
 SET UNPACK="north^east^south^west^ by "
 SET SEP=360/$LENGTH(DIRS,"^")
 SET DIR=(DEGREE/SEP)+1.5
 SET DIR=$SELECT((DIR>33):DIR-32,1:DIR)
 SET DOS=$NUMBER(DIR-.5,0)
 SET D=$PIECE(DIRS,"^",DIR)
 SET DS=""
 FOR I=1:1:$LENGTH(D) DO
 . SET F=$FIND(UNP,$EXTRACT(D,I)) SET DS=DS_$SELECT((F>0):$PIECE(UNPACK,"^",F-1),1:$E(D,I))
 KILL DIRS,UNP,UNPACK,SEP,DIR,D,I,F
 QUIT DOS_"^"_DS

BOXWRITE
 NEW POINTS,UP,LO,DIR,P,X
 SET POINTS="0.0,16.87,16.88,33.75,50.62,50.63,67.5,84.37,84.38,101.25,118.12,118.13,135.0,151.87,"
 SET POINTS=POINTS_"151.88,168.75,185.62,185.63,202.5,219.37,219.38,236.25,253.12,253.13,270.0,286.87,"
 SET POINTS=POINTS_"286.88,303.75,320.62,320.63,337.5,354.37,354.38"
 SET UP="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 SET LO="abcdefghijklmnopqrstuvwxyz"
 FOR P=1:1:$LENGTH(POINTS,",") DO
 . SET X=$$BOXING($PIECE(POINTS,",",P))
 . ;Capitalize the initial letter of the direction
 . SET DIR=$PIECE(X,"^",2)
 . SET DIR=$TRANSLATE($EXTRACT(DIR,1),LO,UP)_$EXTRACT(DIR,2,$LENGTH(DIR))
 . WRITE $PIECE(X,"^"),?5,DIR,?40,$JUSTIFY($PIECE(POINTS,",",P),10,2),!
 KILL POINTS,UP,LO,DIR,P,X
 QUIT


/* NetRexx */
options replace format comments java crossref savelog symbols nobinary utf8

class RCBoxTheCompass

properties public constant
  _FULL = '_FULL'

properties indirect
  headings = Rexx
  rosepoints = Rexx

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
method RCBoxTheCompass() public

  setHeadings(makeHeadings)
  setRosepoints(makeRosepoints)

  return

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
method main(args = String[]) public static

  box = RCBoxTheCompass()

  cp = box.getCompassPoints
  loop r_ = 1 to cp[0]
    say cp[r_]
    end r_
  say

  hx = box.getHeadingsReport(box.getHeadings)
  loop r_ = 1 to hx[0]
    say hx[r_]
    end r_
  say

  return

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
method getDecimalAngle(degrees, minutes, seconds) public static returns Rexx

  degrees = degrees * 10 % 10
  minutes = minutes * 10 % 10
  angle = degrees + (minutes / 60 + (seconds / 60 / 60))

  return angle

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
method getDegreesMinutesSeconds(angle) public static returns Rexx

  degrees = angle * 100 % 100
  minutes = ((angle - degrees) * 60) * 100 % 100
  seconds = ((((angle - degrees) * 60) - minutes) * 60) * 100 % 100

  return degrees minutes seconds

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
method getHeadingsReport(bearings) public returns Rexx

  r_ = 0
  table = ''
  r_ = r_ + 1; table[0] = r_; table[r_] = 'Idx' -
                                          'Abbr' -
                                          'Compass Point'.left(20) -
                                          'Degrees'.right(10)

  loop h_ = 1 to bearings[0]
    heading = bearings[h_]
    index = getRosepointIndex(heading)
    parse getRosepoint(index) p_abbrev p_full

    r_ = r_ + 1; table[0] = r_; table[r_] = index.right(3) -
                                            p_abbrev.left(4) -
                                            p_full.left(20) -
                                            heading.format(6, 3).right(10)
    end h_

  return table

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
method getRosepointIndex(heading) public returns Rexx

  one_pt = 360 / 32
  hn = heading // 360
  hi = hn % one_pt

  if hn > hi * one_pt + one_pt / 2 then do
    hi = hi + 1 -- greater than max range for this point; bump to next point
    end

  idx = hi // 32 + 1 -- add one to get index into rosepoints indexed string

  return idx

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
method getRosepoint(index) public returns Rexx

  rp = getRosepoints
  return rp[index] rp[index, _FULL]

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
method makeRosepoints() private returns Rexx

  p_ = 0
  rp = ''
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'N';    rp[p_, _FULL] = 'North'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'NbE';  rp[p_, _FULL] = 'North by East'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'NNE';  rp[p_, _FULL] = 'North-Northeast'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'NEbn'; rp[p_, _FULL] = 'Northeast by North'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'NE';   rp[p_, _FULL] = 'Northeast'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'NEbE'; rp[p_, _FULL] = 'Northeast by East'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'ENE';  rp[p_, _FULL] = 'East-Northeast'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'EbN';  rp[p_, _FULL] = 'East by North'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'E';    rp[p_, _FULL] = 'East'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'EbS';  rp[p_, _FULL] = 'East by South'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'ESE';  rp[p_, _FULL] = 'East-Southeast'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'SEbE'; rp[p_, _FULL] = 'Southeast by East'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'SE';   rp[p_, _FULL] = 'Southeast'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'SEbS'; rp[p_, _FULL] = 'Southeast by South'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'SSE';  rp[p_, _FULL] = 'South-Southeast'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'SbE';  rp[p_, _FULL] = 'South by East'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'S';    rp[p_, _FULL] = 'South'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'SbW';  rp[p_, _FULL] = 'South by West'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'SSW';  rp[p_, _FULL] = 'South-Southwest'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'SWbS'; rp[p_, _FULL] = 'Southwest by South'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'SW';   rp[p_, _FULL] = 'Southwest'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'SWbW'; rp[p_, _FULL] = 'Southwest by West'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'WSW';  rp[p_, _FULL] = 'Southwest'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'WbS';  rp[p_, _FULL] = 'West by South'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'W';    rp[p_, _FULL] = 'West'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'WbN';  rp[p_, _FULL] = 'West by North'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'WNW';  rp[p_, _FULL] = 'West-Northwest'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'NWbW'; rp[p_, _FULL] = 'Northwest by West'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'NW';   rp[p_, _FULL] = 'Northwest'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'NWbN'; rp[p_, _FULL] = 'Northwest by North'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'NNW';  rp[p_, _FULL] = 'North-Northwest'
  p_ = p_ + 1; rp[0] = p_; rp[p_] = 'NbW';  rp[p_, _FULL] = 'North by West'

  return rp

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
method makeHeadings() private returns Rexx

  hdg = ''
  hdg[0] = 0
  points = 32
  loop i_ = 0 to points
    heading = i_ * 360 / points

    select case i_ // 3
      when 1 then heading_h = heading + 5.62
      when 2 then heading_h = heading - 5.62
      otherwise   heading_h = heading
      end

    ix = hdg[0] + 1; hdg[0] = ix; hdg[ix] = heading_h
    end i_

  return hdg

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
method getCompassPoints() public returns Rexx

  r_ = 0
  table = ''
  r_ = r_ + 1; table[0] = r_; table[r_] = 'Idx' -
                                          'Abbr' -
                                          'Compass Point'.left(20) -
                                          'Low (Deg.)'.right(10) -
                                          'Mid (Deg.)'.right(10) -
                                          'Hi (Deg.)'.right(10)

  -- one point of the compass is 360 / 32 (11.25) degrees
  -- using functions to calculate this just for fun
  one_pt = 360 / 32
  parse getDegreesMinutesSeconds(one_pt / 2) ad am as .
  points = 32
  loop h_ = 0 to points - 1
    heading = h_ * 360 / points
    hmin = heading - getDecimalAngle(ad, am, as)
    hmax = heading + getDecimalAngle(ad, am, as)

    if hmin < 0 then do
      hmin = hmin + 360
      end
    if hmax >= 360 then do
      hmax = hmax - 360
      end

    index = getRosepointIndex(heading)
    parse getRosepoint(index) p_abbrev p_full
    r_ = r_ + 1; table[0] = r_; table[r_] = index.right(3) -
                                            p_abbrev.left(4) -
                                            p_full.left(20) -
                                            hmin.format(6, 3).right(10) -
                                            heading.format(6, 3).right(10) -
                                            hmax.format(6, 3).right(10)
    end h_

  return table


Function Bitwise
	Push $0
	Push $1
	Push $2
	StrCpy $0 7
	StrCpy $1 2

	IntOp $2 $0 & $1
	DetailPrint "Bitwise AND: $0 & $1 = $2"
	IntOp $2 $0 | $1
	DetailPrint "Bitwise OR: $0 | $1 = $2"
	IntOp $2 $0 ^ $1
	DetailPrint "Bitwise XOR: $0 ^ $1 = $2"
	IntOp $2 $0 ~
	DetailPrint "Bitwise NOT (negate in NSIS docs): ~$0 = $2"
	DetailPrint "There are no Arithmetic shifts in NSIS"
	IntOp $2 $0 >> $1
	DetailPrint "Right Shift: $0 >> 1 = $2"
	IntOp $2 $0 << $1
	DetailPrint "Left Shift: $0 << $1 = $2"
	DetailPrint "There are no Rotates in NSIS"

	Pop $2
	Pop $1
	Pop $0
FunctionEnd


MODULE Bitwise;
IMPORT
  SYSTEM,
  Out;

PROCEDURE Do(a,b: LONGINT);
VAR
  x,y: SET;
BEGIN
  x := SYSTEM.VAL(SET,a);y := SYSTEM.VAL(SET,b);
  Out.String("a and b :> ");Out.Int(SYSTEM.VAL(LONGINT,x * y),0);Out.Ln;
  Out.String("a or b  :> ");Out.Int(SYSTEM.VAL(LONGINT,x + y),0);Out.Ln;
  Out.String("a xor b :> ");Out.Int(SYSTEM.VAL(LONGINT,x / y),0);Out.Ln;
  Out.String("a and ~b:> ");Out.Int(SYSTEM.VAL(LONGINT,x - y),0);Out.Ln;
  Out.String("~a      :> ");Out.Int(SYSTEM.VAL(LONGINT,-x),0);Out.Ln;
  Out.String("a left shift b :> ");Out.Int(SYSTEM.VAL(LONGINT,SYSTEM.LSH(x,b)),0);Out.Ln;
  Out.String("a right shift b :> ");Out.Int(SYSTEM.VAL(LONGINT,SYSTEM.LSH(x,-b)),0);Out.Ln;
  Out.String("a left rotate b :> ");Out.Int(SYSTEM.VAL(LONGINT,SYSTEM.ROT(x,b)),0);Out.Ln;
  Out.String("a right rotate b :> ");Out.Int(SYSTEM.VAL(LONGINT,SYSTEM.ROT(x,-b)),0);Out.Ln;
  Out.String("a arithmetic left shift b :> ");Out.Int(SYSTEM.VAL(LONGINT,ASH(a,b)),0);Out.Ln;
  Out.String("a arithmetic right shift b :> ");Out.Int(SYSTEM.VAL(LONGINT,ASH(a,-b)),0);Out.Ln
END Do;

BEGIN
  Do(10,2);
END Bitwise.


T Colour
   Byte r, g, b

   F ==(other)
      R .r == other.r & .g == other.g & .b == other.b

   F (r, g, b)
      .r = r
      .g = g
      .b = b

V black = Colour(0, 0, 0)
V white = Colour(255, 255, 255)

T Bitmap
   Int width, height
   Colour background
   [[Colour]] map

   F (width = 40, height = 40, background = white)
      assert(width > 0 & height > 0)
      .width = width
      .height = height
      .background = background
      .map = (0 .< height).map(h -> (0 .< @width).map(w -> @@background))

   F fillrect(x, y, width, height, colour = black)
      assert(x >= 0 & y >= 0 & width > 0 & height > 0)
      L(h) 0 .< height
         L(w) 0 .< width
            .map[y + h][x + w] = colour

   F chardisplay()
      V txt = .map.map(row -> row.map(bit -> (I bit == @@.background {‘ ’} E ‘@’)).join(‘’))
      txt = txt.map(row -> ‘|’row‘|’)
      txt.insert(0, ‘+’(‘-’ * .width)‘+’)
      txt.append(‘+’(‘-’ * .width)‘+’)
      print(reversed(txt).join("\n"))

   F set(x, y, colour = black)
      .map[y][x] = colour

   F get(x, y)
      R .map[y][x]

   F line(x0, y0, x1, y1)
      ‘Bresenham's line algorithm’
      V dx = abs(x1 - x0)
      V dy = abs(y1 - y0)
      V (x, y) = (x0, y0)
      V sx = I x0 > x1 {-1} E 1
      V sy = I y0 > y1 {-1} E 1
      I dx > dy
         V err = dx / 2.0
         L x != x1
            .set(x, y)
            err -= dy
            I err < 0
               y += sy
               err += dx
            x += sx
      E
         V err = dy / 2.0
         L y != y1
            .set(x, y)
            err -= dx
            I err < 0
               x += sx
               err += dy
            y += sy
      .set(x, y)

   F cubicbezier(x0, y0, x1, y1, x2, y2, x3, y3, n = 20)
      [(Int, Int)] pts
      L(i) 0 .. n
         V t = Float(i) / n
         V a = (1. - t) ^ 3
         V b = 3. * t * (1. - t) ^ 2
         V c = 3.0 * t ^ 2 * (1.0 - t)
         V d = t ^ 3

         V x = Int(a * x0 + b * x1 + c * x2 + d * x3)
         V y = Int(a * y0 + b * y1 + c * y2 + d * y3)
         pts.append((x, y))
      L(i) 0 .< n
         .line(pts[i][0], pts[i][1], pts[i + 1][0], pts[i + 1][1])

V bitmap = Bitmap(17, 17)
bitmap.cubicbezier(16, 1, 1, 4, 3, 16, 15, 11)
bitmap.chardisplay()


import math, sequtils, strformat, strutils

const
  headingNames: array[1..32, string] = [
    "North", "North by east", "North-northeast", "Northeast by north",
    "Northeast", "Northeast by east", "East-northeast", "East by north",
    "East", "East by south", "East-southeast", "Southeast by east",
    "Southeast", "Southeast by south","South-southeast", "South by east",
    "South", "South by west", "South-southwest", "Southwest by south",
    "Southwest", "Southwest by west", "West-southwest", "West by south",
    "West", "West by north", "West-northwest", "Northwest by west",
    "Northwest", "Northwest by north", "North-northwest", "North by west"]
  maxNameLength = headingNames.mapIt(it.len).max
  degreesPerHeading = 360 / 32

func toCompassIndex(degree: float): 1..32 =
  var degree = (degree + degreesPerHeading / 2).floorMod 360
  int(degree / degreesPerHeading) + 1

func toCompassHeading(degree: float): string = headingNames[degree.toCompassIndex]

for i in 0..32:
  let
    heading = float(i) * 11.25 + (case i mod 3
      of 1: 5.62
      of 2: -5.62
      else: 0)
    index = heading.toCompassIndex
    compassHeading = heading.toCompassHeading.alignLeft(maxNameLength)
  echo fmt"{index:>2} {compassHeading} {heading:6.2f}"


class BoxCompass {
  function : Main(args : String[]) ~ Nil {
    points := [
      "North             ", "North by east     ", "North-northeast   ",
      "Northeast by north", "Northeast         ", "Northeast by east ", "East-northeast    ",
      "East by north     ", "East              ", "East by south     ", "East-southeast    ",
      "Southeast by east ", "Southeast         ", "Southeast by south", "South-southeast   ",
      "South by east     ", "South             ", "South by west     ", "South-southwest   ",
      "Southwest by south", "Southwest         ", "Southwest by west ", "West-southwest    ",
      "West by south     ", "West              ", "West by north     ", "West-northwest    ",
      "Northwest by west ", "Northwest         ", "Northwest by north", "North-northwest   ",
      "North by west     " ];

    for(i := 0; i<= 32; i += 1;) {
      heading := i * 11.25;
      select(i % 3) {
        label 1: {
          heading += 5.62;
        }

        label 2: {
          heading -= 5.62;
        }
      };

      IO.Console->Print((i % 32) + 1)->Print('\t')->Print(points[GetPoint(heading)])
        ->Print('\t')->PrintLine(heading);
    };
  }

  function : GetPoint(degrees : Float) ~ Int {
    return (degrees / 11.25 + 0.5)->Floor()->As(Int) % 32;
  }
}


use IO;

bundle Default {
  class Test {
    function : Main(args : String[]) ~ Nil {
      BitWise(3, 4);
    }

    function : BitWise(a : Int, b : Int) ~ Nil {
        Console->GetInstance()->Print("a and b: ")->PrintLine(a and b);
      Console->GetInstance()->Print("a or b: ")->PrintLine(a or b);
      Console->GetInstance()->Print("a xor b: ")->PrintLine(a xor b);
      # shift left & right are supported by the compiler and VM but not
      # exposed to end-users; those instructions are used for optimizations
    }
  }
}


let bitwise a b =
  Printf.printf "a and b: %d\n" (a land b);
  Printf.printf "a or b: %d\n" (a lor b);
  Printf.printf "a xor b: %d\n" (a lxor b);
  Printf.printf "not a: %d\n" (lnot a);
  Printf.printf "a lsl b: %d\n" (a lsl b);  (* left shift *)
  Printf.printf "a asr b: %d\n" (a asr b);  (* arithmetic right shift *)
  Printf.printf "a lsr b: %d\n" (a lsr b);  (* logical right shift *)
;;


INCLUDE "H6:RGBLINE.ACT" ;from task Bresenham's line algorithm
INCLUDE "H6:REALMATH.ACT"

RGB black,yellow,violet,blue

TYPE IntPoint=[INT x,y]

PROC CubicBezier(RgbImage POINTER img
  IntPoint POINTER p1,p2,p3,p4 RGB POINTER col)
  INT i,n=[20],prevX,prevY,nextX,nextY
  REAL one,two,three,ri,rn,rt,ra,rb,rc,rd,tmp1,tmp2,tmp3
  REAL x1,y1,x2,y2,x3,y3,x4,y4

  IntToReal(p1.x,x1) IntToReal(p1.y,y1)
  IntToReal(p2.x,x2) IntToReal(p2.y,y2)
  IntToReal(p3.x,x3) IntToReal(p3.y,y3)
  IntToReal(p4.x,x4) IntToReal(p4.y,y4)
  IntToReal(1,one)   IntToReal(2,two)
  IntToReal(3,three) IntToReal(n,rn)
  FOR i=0 TO n
  DO
    prevX=nextX prevY=nextY

    IntToReal(i,ri)
    RealDiv(ri,rn,rt)        ;t=i/n

    RealSub(one,rt,tmp1)     ;tmp1=1-t
    RealMult(tmp1,tmp1,tmp2) ;tmp2=(1-t)^2
    RealMult(tmp2,tmp1,ra)   ;a=(1-t)^3

    RealMult(three,rt,tmp2)  ;tmp2=3*t
    RealMult(tmp1,tmp1,tmp3) ;tmp3=(1-t)^2
    RealMult(tmp2,tmp3,rb)   ;b=3*t*(1-t)^2

    RealMult(three,rt,tmp2)  ;tmp2=3*t
    RealMult(rt,tmp1,tmp3)   ;tmp3=t*(1-t)
    RealMult(tmp2,tmp3,rc)   ;c=3*t^2*(1-t)

    RealMult(rt,rt,tmp2)     ;tmp2=t^2
    RealMult(tmp2,rt,rd)     ;d=t^3

    RealMult(ra,x1,tmp1)     ;tmp1=a*x1
    RealMult(rb,x2,tmp2)     ;tmp2=b*x2
    RealAdd(tmp1,tmp2,tmp3)  ;tmp3=a*x1+b*x2
    RealMult(rc,x3,tmp1)     ;tmp1=c*x3
    RealAdd(tmp3,tmp1,tmp2)  ;tmp2=a*x1+b*x2+c*x3
    RealMult(rd,x4,tmp1)     ;tmp1=d*x4
    RealAdd(tmp2,tmp1,tmp3)  ;tmp3=a*x1+b*x2+c*x3+d*x4
    nextX=Round(tmp3)

    RealMult(ra,y1,tmp1)     ;tmp1=a*y1
    RealMult(rb,y2,tmp2)     ;tmp2=b*y2
    RealAdd(tmp1,tmp2,tmp3)  ;tmp3=a*y1+b*y2
    RealMult(rc,y3,tmp1)     ;tmp1=c*y3
    RealAdd(tmp3,tmp1,tmp2)  ;tmp2=a*y1+b*y2+c*y3
    RealMult(rd,y4,tmp1)     ;tmp1=d*y4
    RealAdd(tmp2,tmp1,tmp3)  ;tmp3=a*y1+b*y2+c*y3+d*y4
    nextY=Round(tmp3)

    IF i>0 THEN
      RgbLine(img,prevX,prevY,nextX,nextY,col)
    FI
  OD
RETURN

PROC DrawImage(RgbImage POINTER img BYTE x,y)
  RGB POINTER ptr
  BYTE i,j

  ptr=img.data
  FOR j=0 TO img.h-1
  DO
    FOR i=0 TO img.w-1
    DO
      IF RgbEqual(ptr,yellow) THEN
        Color=1
      ELSEIF RgbEqual(ptr,violet) THEN
        Color=2
      ELSEIF RgbEqual(ptr,blue) THEN
        Color=3
      ELSE
        Color=0
      FI
      Plot(x+i,y+j)
      ptr==+RGBSIZE
    OD
  OD
RETURN

PROC Main()
  RgbImage img
  BYTE CH=$02FC,width=[70],height=[40]
  BYTE ARRAY ptr(8400)
  IntPoint p1,p2,p3,p4

  Graphics(7+16)
  SetColor(0,13,12) ;yellow
  SetColor(1,4,8)   ;violet
  SetColor(2,8,6)   ;blue
  SetColor(4,0,0)   ;black

  RgbBlack(black)
  RgbYellow(yellow)
  RgbViolet(violet)
  RgbBlue(blue)

  InitRgbImage(img,width,height,ptr)
  FillRgbImage(img,black)

  p1.x=0  p1.y=3
  p2.x=10 p2.y=39
  p3.x=69 p3.y=31
  p4.x=40 p4.y=8
  RgbLine(img,p1.x,p1.y,p2.x,p2.y,blue)
  RgbLine(img,p2.x,p2.y,p3.x,p3.y,blue)
  RgbLine(img,p3.x,p3.y,p4.x,p4.y,blue)
  CubicBezier(img,p1,p2,p3,p4,yellow)
  SetRgbPixel(img,p1.x,p1.y,violet)
  SetRgbPixel(img,p2.x,p2.y,violet)
  SetRgbPixel(img,p3.x,p3.y,violet)
  SetRgbPixel(img,p4.x,p4.y,violet)

  DrawImage(img,(160-width)/2,(96-height)/2)

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN


procedure Cubic_Bezier
          (  Picture        : in out Image;
             P1, P2, P3, P4 : Point;
             Color          : Pixel;
             N              : Positive := 20
          )  is
   Points : array (0..N) of Point;
begin
   for I in Points'Range loop
      declare
         T : constant Float := Float (I) / Float (N);
         A : constant Float := (1.0 - T)**3;
         B : constant Float := 3.0 * T * (1.0 - T)**2;
         C : constant Float := 3.0 * T**2 * (1.0 - T);
         D : constant Float := T**3;
      begin
         Points (I).X := Positive (A * Float (P1.X) + B * Float (P2.X) + C * Float (P3.X) + D * Float (P4.X));
         Points (I).Y := Positive (A * Float (P1.Y) + B * Float (P2.Y) + C * Float (P3.Y) + D * Float (P4.Y));
      end;
   end loop;
   for I in Points'First..Points'Last - 1 loop
      Line (Picture, Points (I), Points (I + 1), Color);
   end loop;
end Cubic_Bezier;


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

cubic bezier OF class image :=
          (  REF IMAGE picture,
             POINT p1, p2, p3, p4,
             PIXEL color,
             UNION(INT, VOID) in n
          )VOID:
BEGIN
   INT n = (in n|(INT n):n|20); # default 20 #
   [0:n]POINT points;
   FOR i FROM LWB points TO UPB points DO
         REAL t = i / n,
              a = (1 - t)**3,
              b = 3 * t * (1 - t)**2,
              c = 3 * t**2 * (1 - t),
              d = t**3;
         x OF points [i] := ENTIER (0.5 + a * x OF p1 + b * x OF p2 + c * x OF p3 + d * x OF p4);
         y OF points [i] := ENTIER (0.5 + a * y OF p1 + b * y OF p2 + c * y OF p3 + d * y OF p4)
   OD;
   FOR i FROM LWB points TO UPB points - 1 DO
      (line OF class image)(picture, points (i), points (i + 1), color)
   OD
END # cubic bezier #;

SKIP


let test_cases = [0.0; 16.87; 16.88; 33.75; 50.62; 50.63; 67.5;
                  84.37; 84.38; 101.25; 118.12; 118.13; 135.0;
                  151.87; 151.88; 168.75; 185.62; 185.63; 202.5;
                  219.37; 219.38; 236.25; 253.12; 253.13; 270.0;
                  286.87; 286.88; 303.75; 320.62; 320.63; 337.5;
                  354.37; 354.38];;

let directions = ["North"; "North by East"; "North-Northeast";
                  "Northeast by North"; "Northeast";
                  "Northeast by East"; "East-Northeast"; "East by North";
                  "East"; "East by South"; "East-Southeast";
                  "Southeast by East"; "Southeast"; "Southeast by South";
                  "South-Southeast"; "South by East"; "South";
                  "South by West"; "South-Southwest"; "Southwest by South";
                  "Southwest"; "Southwest by West"; "West-Southwest";
                  "West by South"; "West"; "West by North";
                  "West-Northwest"; "Northwest by West"; "Northwest";
                  "Northwest by North"; "North-Northwest"; "North by West";];;

let get_direction_index input =
  let shifted = (input +. 5.6201) in
  let shifted = if shifted > 360. then shifted -. 360. else shifted in
  int_of_float (shifted /. 11.25);;

let print_direction input =
  let index = get_direction_index input in
  let direction = List.nth directions index in
  let test = Printf.printf "%3d %-20s %.2f\n" (index + 1) direction in
  test input;;

List.iter (print_direction) test_cases;;


function bitops(a, b)
  s = sprintf("%s %%s %s = %%s\n", dec2bin(a), dec2bin(b));
  printf(s, "or", dec2bin(bitor(a, b)));
  printf(s, "and", dec2bin(bitand(a, b)));
  printf(s, "xor", dec2bin(bitxor(a, b)));
  printf(s, "left shift", dec2bin(bitshift(a, abs(b))));
  printf(s, "right shift", dec2bin(bitshift(a, -abs(b))));
  printf("simul not %s = %s", dec2bin(a), dec2bin(bitxor(a, 0xffffffff)));
endfunction

bitops(0x1e, 0x3);


      Width% = 200
      Height% = 200

      REM Set window size:
      VDU 23,22,Width%;Height%;8,16,16,128

      REM Draw cubic Bézier curve:
      PROCbeziercubic(160,150, 10,120, 30,0, 150,50, 20, 0,0,0)
      END

      DEF PROCbeziercubic(x1,y1,x2,y2,x3,y3,x4,y4,n%,r%,g%,b%)
      LOCAL i%, t, t1, a, b, c, d, p{()}
      DIM p{(n%) x%,y%}

      FOR i% = 0 TO n%
        t = i% / n%
        t1 = 1 - t
        a = t1^3
        b = 3 * t * t1^2
        c = 3 * t^2 * t1
        d = t^3
        p{(i%)}.x% = INT(a * x1 + b * x2 + c * x3 + d * x4 + 0.5)
        p{(i%)}.y% = INT(a * y1 + b * y2 + c * y3 + d * y4 + 0.5)
      NEXT

      FOR i% = 0 TO n%-1
        PROCbresenham(p{(i%)}.x%,p{(i%)}.y%,p{(i%+1)}.x%,p{(i%+1)}.y%, \
        \             r%,g%,b%)
      NEXT
      ENDPROC

      DEF PROCbresenham(x1%,y1%,x2%,y2%,r%,g%,b%)
      LOCAL dx%, dy%, sx%, sy%, e
      dx% = ABS(x2% - x1%) : sx% = SGN(x2% - x1%)
      dy% = ABS(y2% - y1%) : sy% = SGN(y2% - y1%)
      IF dx% < dy% e = dx% / 2 ELSE e = dy% / 2
      REPEAT
        PROCsetpixel(x1%,y1%,r%,g%,b%)
        IF x1% = x2% IF y1% = y2% EXIT REPEAT
        IF dx% > dy% THEN
          x1% += sx% : e -= dy% : IF e < 0 e += dx% : y1% += sy%
        ELSE
          y1% += sy% : e -= dx% : IF e < 0 e += dy% : x1% += sx%
        ENDIF
      UNTIL FALSE
      ENDPROC

      DEF PROCsetpixel(x%,y%,r%,g%,b%)
      COLOUR 1,r%,g%,b%
      GCOL 1
      LINE x%*2,y%*2,x%*2,y%*2
      ENDPROC


void cubic_bezier(
       	image img,
        unsigned int x1, unsigned int y1,
        unsigned int x2, unsigned int y2,
        unsigned int x3, unsigned int y3,
        unsigned int x4, unsigned int y4,
        color_component r,
        color_component g,
        color_component b );


import grayscale_image, bitmap_bresenhams_line_algorithm;

struct Pt { int x, y; } // Signed.

void cubicBezier(size_t nSegments=20, Color)
                (Image!Color im,
                 in Pt p1, in Pt p2, in Pt p3, in Pt p4,
                 in Color color)
pure nothrow @nogc if (nSegments > 0) {
    Pt[nSegments + 1] points = void;

    foreach (immutable i, ref p; points) {
        immutable double t = i / double(nSegments),
                         a = (1.0 - t) ^^ 3,
                         b = 3.0 * t * (1.0 - t) ^^ 2,
                         c = 3.0 * t ^^ 2 * (1.0 - t),
                         d = t ^^ 3;

        alias T = typeof(Pt.x);
        p = Pt(cast(T)(a * p1.x + b * p2.x + c * p3.x + d * p4.x),
               cast(T)(a * p1.y + b * p2.y + c * p3.y + d * p4.y));
    }

    foreach (immutable i, immutable p; points[0 .. $ - 1])
        im.drawLine(p.x, p.y, points[i + 1].x, points[i + 1].y, color);
}

void main() {
    auto im = new Image!Gray(17, 17);
    im.clear(Gray.white);
    im.cubicBezier(Pt(16, 1), Pt(1, 4), Pt(3, 16), Pt(15, 11),
                   Gray.black);
    im.textualShow();
}


/* Rexx */

Do
  globs = '!DEG !MIN !SEC !FULL'
  Drop !DEG !MIN !SEC !FULL
  sign. = ''
  sign.!DEG = 'c2b0'x     -- degree sign  : U+00B0
  sign.!MIN = 'e280b2'x   -- prime        : U+2032
  sign.!SEC = 'e280b3'x   -- double prime : U+2033
  points. = ''

  Call display_compass_points

  Call display_sample
  Say

  headings. = ''
  headings.0 = 0
  Call make_headings

  Call flush_queue
  Do h_ = 1 to headings.0
    Queue headings.h_
    End h_

  Call display_sample
  Say

  Return
End
Exit

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
flush_queue:
Procedure
Do
  Do q_ = 1 to queued()
    Parse pull .
    End q_
  Return
End
Exit

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
display_sample:
Procedure Expose points. sign. (globs)
Do

  Do q_ = 1 to queued()
    Parse pull heading
    index = get_index(heading)
    Parse Value get_point(index) with p_abbrev p_full
    Say index~right(3),
        p_abbrev~left(4) p_full~left(20),
        heading~format(5, 3) || sign.!DEG '('format_degrees_minutes_seconds(heading)')',
        ''
    End q_

  Return
End
Exit

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
display_compass_points:
Procedure Expose points. sign. (globs)
Do

  points = 32
  one_pt = 360 / points

  Do h_ = 0 to points - 1
    heading = h_ * 360 / points
    hmin = heading - one_pt / 2
    hmax = heading + one_pt / 2

    If hmin < 0 then Do
      hmin = hmin + 360
      End
    If hmax >= 360 then Do
      hmax = hmax - 360
      End

    index = (h_ // points) + 1
    Parse Value get_point(index) with p_abbrev p_full

    Say index~right(3),
        p_abbrev~left(4) p_full~left(20),
        hmin~format(5, 3)    || sign.!DEG '('format_degrees_minutes_seconds(hmin)')',
        heading~format(5, 3) || sign.!DEG '('format_degrees_minutes_seconds(heading)')',
        hmax~format(5, 3)    || sign.!DEG '('format_degrees_minutes_seconds(hmax)')',
        ''
    End h_
  Say

  Return
End
Exit

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
make_headings:
Procedure Expose headings.
Do
  points = 32
  Do i_ = 0 to points
    heading = i_ * 360 / 32

    it = i_ // 3
    Select
      When it = 1 then Do
        heading_h = heading + 5.62
        End

      When it = 2 then Do
        heading_h = heading - 5.62
        End

      Otherwise Do
        heading_h = heading
        End
      End

    index = (i_ // points) + 1
    ix = headings.0 + 1; headings.0 = ix; headings.ix = heading_h
    End i_

  Return
End
Exit

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
get_index:
Procedure
Do
  Parse Arg heading .

  one_pt = 360 / 32
  hn = heading // 360
  hi = hn % one_pt

  If hn > hi * one_pt + one_pt / 2 then Do
    hi = hi + 1 -- greater than max range for this point; bump to next point
    End

  idx = hi // 32 + 1 -- add one to get index into points. stem

  Return idx
End
Exit

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
get_point:
Procedure Expose points. sign. (globs)
Do
  Parse arg index .

  Call get_points

  Return points.index points.index.!FULL
End
Exit

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
get_points:
Procedure Expose points. sign. (globs)
Do

  Drop !FULL

  points. = ''
  p_ = 0
  p_ = p_ + 1; points.0 = p_; points.p_ = 'N';    points.p_.!FULL = 'North'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'NbE';  points.p_.!FULL = 'North by East'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'NNE';  points.p_.!FULL = 'North-Northeast'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'NEbn'; points.p_.!FULL = 'Northeast by North'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'NE';   points.p_.!FULL = 'Northeast'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'NEbE'; points.p_.!FULL = 'Northeast by East'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'ENE';  points.p_.!FULL = 'East-Northeast'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'EbN';  points.p_.!FULL = 'East by North'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'E';    points.p_.!FULL = 'East'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'EbS';  points.p_.!FULL = 'East by South'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'ESE';  points.p_.!FULL = 'East-Southeast'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'SEbE'; points.p_.!FULL = 'Southeast by East'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'SE';   points.p_.!FULL = 'Southeast'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'SEbS'; points.p_.!FULL = 'Southeast by South'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'SSE';  points.p_.!FULL = 'South-Southeast'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'SbE';  points.p_.!FULL = 'South by East'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'S';    points.p_.!FULL = 'South'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'SbW';  points.p_.!FULL = 'South by West'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'SSW';  points.p_.!FULL = 'South-Southwest'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'SWbS'; points.p_.!FULL = 'Southwest by South'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'SW';   points.p_.!FULL = 'Southwest'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'SWbW'; points.p_.!FULL = 'Southwest by West'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'WSW';  points.p_.!FULL = 'Southwest'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'WbS';  points.p_.!FULL = 'West by South'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'W';    points.p_.!FULL = 'West'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'WbN';  points.p_.!FULL = 'West by North'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'WNW';  points.p_.!FULL = 'West-Northwest'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'NWbW'; points.p_.!FULL = 'Northwest by West'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'NW';   points.p_.!FULL = 'Northwest'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'NWbN'; points.p_.!FULL = 'Northwest by North'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'NNW';  points.p_.!FULL = 'North-Northwest'
  p_ = p_ + 1; points.0 = p_; points.p_ = 'NbW';  points.p_.!FULL = 'North by West'

  Return
End
Exit

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
get_decimal_angle:
Procedure Expose sign. (globs)
Do
  Parse Arg degrees ., minutes ., seconds .

  degrees = degrees * 10 % 10
  minutes = minutes * 10 % 10

  angle = degrees + minutes / 60 + seconds / 60 / 60

  Return angle
End
Exit

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
format_decimal_angle:
Procedure Expose sign. (globs)
Do
  Parse Arg degrees ., minutes ., seconds .

  Return get_decimal_angle(degrees, minutes, seconds)~format(5, 3) || sign.!DEG
End
Exit

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
get_degrees_minutes_seconds:
Procedure Expose sign. (globs)
Do
  Parse arg angle .

  degrees = angle * 100 % 100
  minutes = ((angle - degrees) * 60) * 100 % 100
  seconds = ((((angle - degrees) * 60) - minutes) * 60) * 100 % 100

  Return degrees minutes seconds
End
Exit

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
format_degrees_minutes_seconds:
Procedure Expose  sign. (globs)
Do
  Parse arg angle .

  Parse Value get_degrees_minutes_seconds(angle) with degrees minutes seconds .

  formatted = degrees~right(3) || sign.!DEG || minutes~right(2, 0) || sign.!MIN || seconds~right(2, 0) || sign.!SEC

  Return formatted
End
Exit


: bitwise(a, b)
   a b bitAnd println
   a b bitOr println
   a b bitXor println
   a bitLeft(b) println
   a bitRight(b) println ;


/* ooRexx *************************************************************
/ Bit Operations work as in Rexx (of course)
* Bit operations are performed up to the length of the shorter string.
* The rest of the longer string is copied to the result.
* ooRexx introduces the possibility to specify a padding character
* to be used for expanding the shorter string.
* 10.11.2012 Walter Pachl taken over from REXX and extended for ooRexx
**********************************************************************/
a=21
b=347
Say '          a :'c2b(a) '        'c2x(a)
Say '          b :'c2b(b)           c2x(b)
Say 'bitand(a,b) :'c2b(bitand(a,b)) c2x(bitand(a,b))
Say 'bitor(a,b)  :'c2b(bitor(a,b))  c2x(bitor(a,b))
Say 'bitxor(a,b) :'c2b(bitxor(a,b)) c2x(bitxor(a,b))
p='11111111'B
Say 'ooRexx only:'
Say 'a~bitor(b,p):'c2b(a~bitor(b,p)) c2x(a~bitor(b,p))
Exit
c2b: return x2b(c2x(arg(1)))


/// Uses Vector<float> from Microsoft.FSharp.Math (in F# PowerPack)
module CubicBezier

/// Create bezier curve from p1 to p4, using the control points p2, p3
/// Returns the requested number of segments
let cubic_bezier (p1:vector) (p2:vector) (p3:vector) (p4:vector) segments =
    [0 .. segments - 1]
        |> List.map(fun i ->
            let t = float i / float segments
            let a = (1. - t) ** 3.
            let b = 3. * t * ((1. - t) ** 2.)
            let c = 3. * (t ** 2.) * (1. - t)
            let d = t ** 3.
            let x = a * p1.[0] + b * p2.[0] + c * p3.[0] + d * p4.[0]
            let y = a * p1.[1] + b * p2.[1] + c * p3.[1] + d * p4.[1]
            vector [x; y])


USING: arrays kernel locals math math.functions
 rosettacode.raster.storage sequences ;
IN: rosettacode.raster.line

! this gives a function
:: (cubic-bezier) ( P0 P1 P2 P3 -- bezier )
    [ :> x
        1 x - 3 ^ P0 n*v
        1 x - sq 3 * x * P1 n*v
        1 x - 3 * x sq * P2 n*v
        x 3 ^ P3 n*v
        v+ v+ v+ ] ; inline
! gives an interval of x from 0 to 1 to map the bezier function
: t-interval ( x -- interval )
    [ iota ] keep 1 - [ / ] curry map ;
! turns a list of points into the list of lines between them
: points-to-lines ( seq -- seq )
    dup rest [ 2array ] 2map ;
: draw-lines ( {R,G,B} points image -- )
    [ [ first2 ] dip draw-line ] curry with each ;
:: bezier-lines ( {R,G,B} P0 P1 P2 P3 image -- )
    ! 100 is an arbitrary value.. could be given as a parameter..
    100 t-interval P0 P1 P2 P3 (cubic-bezier) map
    points-to-lines
    {R,G,B} swap image draw-lines ;


#DEFINE WM_LBUTTONDOWN 513
#DEFINE WM_CLOSE 16

FBSLSETTEXT(ME, "Bezier Cubic")
FBSLSETFORMCOLOR(ME, RGB(0, 255, 255)) ' Cyan: persistent background color
DRAWWIDTH(5) ' Adjust point size
FBSL.GETDC(ME) ' Use volatile FBSL.GETDC below to avoid extra assignments

RESIZE(ME, 0, 0, 235, 235)
CENTER(ME)
SHOW(ME)

DIM Height AS INTEGER
FBSL.GETCLIENTRECT(ME, 0, 0, 0, Height)

BEGIN EVENTS
	SELECT CASE CBMSG
		CASE WM_LBUTTONDOWN: BezierCube(160, 150, 10, 120, 30, 0, 150, 50, 20) ' Draw
		CASE WM_CLOSE: FBSL.RELEASEDC(ME, FBSL.GETDC) ' Clean up
	END SELECT
END EVENTS

SUB BezierCube(x1, y1, x2, y2, x3, y3, x4, y4, n)
	TYPE POINTAPI
		x AS INTEGER
		y AS INTEGER
	END TYPE

	DIM t, t1, a, b, c, d, p[n] AS POINTAPI

	FOR DIM i = 0 TO n
		t = i / n: t1 = 1 - t
		a = t1 ^ 3
		b = 3 * t * t1 ^ 2
		c = 3 * t ^ 2 * t1
		d = t ^ 3
		p[i].x = a * x1 + b * x2 + c * x3 + d * x4 + 0.5
		p[i].y = Height - (a * y1 + b * y2 + c * y3 + d * y4 + 0.5)
	NEXT

	FOR i = 0 TO n - 1
		Bresenham(p[i].x, p[i].y, p[i + 1].x, p[i + 1].y)
	NEXT

	SUB Bresenham(x0, y0, x1, y1)
		DIM dx = ABS(x0 - x1), sx = SGN(x0 - x1)
		DIM dy = ABS(y0 - y1), sy = SGN(y0 - y1)
		DIM tmp, er = IIF(dx > dy, dx, -dy) / 2

		WHILE NOT (x0 = x1 ANDALSO y0 = y1)
			PSET(FBSL.GETDC, x0, y0, &HFF) ' Red: Windows stores colors in BGR order
			tmp = er
			IF tmp > -dx THEN: er = er - dy: x0 = x0 + sx: END IF
			IF tmp < +dy THEN: er = er + dx: y0 = y0 + sy: END IF
		WEND
	END SUB
END SUB


box(x)={["North","North by east","North-northeast","Northeast by north","Northeast",
"Northeast by east","East-northeast","East by north","East","East by south","East-southeast",
"Southeast by east","Southeast","Southeast by south","South-southeast","South by east","South",
"South by west","South-southwest","Southwest by south","Southwest","Southwest by west","West-southwest",
"West by south","West","West by north","West-northwest","Northwest by west","Northwest",
"Northwest by north","North-northwest","North by west"][round(x*4/45)%32+1]};
for(i=0,32,print(i%32+1" "box(x=i*11.25+if(i%3==1,5.62,if(i%3==2,-5.62)))" "x))


bo(a,b)={
  print("And: "bitand(a,b));
  print("Or: "bitor(a,b));
  print("Not: "bitneg(a));
  print("Xor: "bitxor(a,b));
  print("Left shift: ",a<<b);
  print("Right shift: ",a>>b);
}


subroutine cubic_bezier(img, p1, p2, p3, p4, color)
  type(rgbimage), intent(inout) :: img
  type(point), intent(in) :: p1, p2, p3, p4
  type(rgb), intent(in) :: color

  integer :: i, j
  real :: pts(0:N_SEG,0:1), t, a, b, c, d, x, y

  do i = 0, N_SEG
     t = real(i) / real(N_SEG)
     a = (1.0 - t)**3.0
     b = 3.0 * t * (1.0 - t)**2
     c = 3.0 * (1.0 - t) * t**2
     d = t**3.0
     x = a * p1%x + b * p2%x + c * p3%x + d * p4%x
     y = a * p1%y + b * p2%y + c * p3%y + d * p4%y
     pts(i,0) = x
     pts(i,1) = y
  end do

  do i = 0, N_SEG-1
     j = i + 1
     call draw_line(img, point(pts(i,0), pts(i,1)), &
                    point(pts(j,0), pts(j,1)), color)
  end do

end subroutine cubic_bezier


' version 01-11-2016
' compile with: fbc -s console

' translation from Bitmap/Bresenham's line algorithm C entry
Sub Br_line(x0 As Integer, y0 As Integer, x1 As Integer, y1 As Integer, _
                                            Col As UInteger = &HFFFFFF)

    Dim As Integer dx = Abs(x1 - x0), dy = Abs(y1 - y0)
    Dim As Integer sx = IIf(x0 < x1, 1, -1)
    Dim As Integer sy = IIf(y0 < y1, 1, -1)
    Dim As Integer er = IIf(dx > dy, dx, -dy) \ 2, e2

    Do
        PSet(x0, y0), col
        If (x0 = x1) And (y0 = y1) Then Exit Do
        e2 = er
        If e2 > -dx Then Er -= dy : x0 += sx
        If e2 <  dy Then Er += dx : y0 += sy
    Loop

End Sub

' Bitmap/Bézier curves/Cubic BBC BASIC entry
Sub beziercubic(x1 As Double, y1 As Double, x2 As Double, y2 As Double, _
                x3 As Double, y3 As Double, x4 As Double, y4 As Double, _
                                n As ULong, col As UInteger = &HFFFFFF)

    Type point_
        x As Integer
        y As Integer
    End Type

    Dim As ULong i
    Dim As Double t, t1, a, b, c, d
    Dim As point_ p(n)

    For i = 0 To n
        t = i / n
        t1 = 1 - t
        a = t1 ^ 3
        b = t * t1 * t1 * 3
        c = t * t * t1 * 3
        d = t ^ 3
        p(i).x = Int(a * x1 + b * x2  + c * x3 + d * x4 + .5)
        p(i).y = Int(a * y1 + b * y2  + c * y3 + d * y4 + .5)
    Next

    For i = 0 To n -1
        Br_line(p(i).x, p(i).y, p(i +1).x, p(i +1).y, col)
    Next

End Sub

' ------=< MAIN >=------

ScreenRes 250,250,32     ' 0,0 in top left corner

beziercubic(160, 150, 10, 120, 30, 0, 150, 50, 20)

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


program BoxTheCompass(output);

function compasspoint(angle: real): string;
  const
    points: array [1..32] of string =
      ('North             ', 'North by east     ', 'North-northeast   ', 'Northeast by north',
       'Northeast         ', 'Northeast by east ', 'East-northeast    ', 'East by north     ',
       'East              ', 'East by south     ', 'East-southeast    ', 'Southeast by east ',
       'Southeast         ', 'Southeast by south', 'South-southeast   ', 'South by east     ',
       'South             ', 'South by west     ', 'South-southwest   ', 'Southwest by south',
       'Southwest         ', 'Southwest by west ', 'West-southwest    ', 'West by south     ',
       'West              ', 'West by north     ', 'West-northwest    ', 'Northwest by west ',
       'Northwest         ', 'Northwest by north', 'North-northwest   ', 'North by west     '
      );
  var
    index: integer;
  begin
    index := round (angle / 11.25);
    index := index mod 32 + 1;
    compasspoint := points[index];
  end;

var
  i:       integer;
  heading: real;

begin
  for i := 0 to 32 do
  begin
    heading := i * 11.25;
    case (i mod 3) of
      1: heading := heading + 5.62;
      2: heading := heading - 5.62;
    end;
    writeln((i mod 32) + 1:2, ' ', compasspoint(heading), ' ', heading:8:4);
  end;
end.


var
 a, b: integer;
begin
 a := 10; { binary 1010 }
 b := 12; { binary 1100 }
 writeln('a and b = ', a and b); {  8 = 1000 }
 writeln('a or b  = ', a or b);  { 14 = 1110 }
 writeln('a xor b = ', a xor b)  {  6 = 0110 }
end.


use integer;

sub bitwise($$) {
   ($a, $b) = @_;
   print 'a and b: '. ($a & $b) ."\n";
   print 'a or b: '.  ($a | $b) ."\n";
   print 'a xor b: '. ($a ^ $b) ."\n";
   print 'not a: '.   (~$a)     ."\n";
   print 'a >> b: ', $a >> $b, "\n"; # logical right shift

   use integer; # "use integer" enables bitwise operations to return signed ints
   print "after use integer:\n";
   print 'a << b: ', $a << $b, "\n"; # left shift
   print 'a >> b: ', $a >> $b, "\n"; # arithmetic right shift
}


package raster

const b3Seg = 30

func (b *Bitmap) Bézier3(x1, y1, x2, y2, x3, y3, x4, y4 int, p Pixel) {
    var px, py [b3Seg + 1]int
    fx1, fy1 := float64(x1), float64(y1)
    fx2, fy2 := float64(x2), float64(y2)
    fx3, fy3 := float64(x3), float64(y3)
    fx4, fy4 := float64(x4), float64(y4)
    for i := range px {
        d := float64(i) / b3Seg
        a := 1 - d
        b, c := a * a, d * d
        a, b, c, d = a*b, 3*b*d, 3*a*c, c*d
        px[i] = int(a*fx1 + b*fx2 + c*fx3 + d*fx4)
        py[i] = int(a*fy1 + b*fy2 + c*fy3 + d*fy4)
    }
    x0, y0 := px[0], py[0]
    for i := 1; i <= b3Seg; i++ {
        x1, y1 := px[i], py[i]
        b.Line(x0, y0, x1, y1, p)
        x0, y0 = x1, y1
    }
}

func (b *Bitmap) Bézier3Rgb(x1, y1, x2, y2, x3, y3, x4, y4 int, c Rgb) {
    b.Bézier3(x1, y1, x2, y2, x3, y3, x4, y4, c.Pixel())
}


require 'numeric'

bik=: 2 : '((*&(u!v))@(^&u * ^&(v-u)@-.))'
basiscoeffs=: <: 4 : 'x bik y t. i.>:y'"0~ i.
linearcomb=: [email protected]#@[
evalBernstein=: ([ +/ .* linearcomb) p. ]        NB. evaluate Bernstein Polynomial (general)

NB.*getBezierPoints v Returns points for bezier curve given control points (y)
NB. eg: getBezierPoints controlpoints
NB. y is: y0 x0, y1 x1, y2 x2 ...
getBezierPoints=: monad define
  ctrlpts=. (/: {:"1)  _2]\ y  NB. sort ctrlpts for increasing x
  xvals=. ({: ,~ {. + +:@:[email protected]<[email protected]:@-~/) ({:"1) 0 _1{ctrlpts
  tvals=.  ((] - {.) % ({: - {.)) xvals
  xvals ,.~ ({."1 ctrlpts) evalBernstein tvals
)

NB.*drawBezier v Draws bezier curve defined by (x) on image (y)
NB. eg: (42 40 10 30 186 269 26 187;255 0 0) drawBezier myimg
NB. x is: 2-item list of boxed (controlpoints) ; (color)
drawBezier=: (1&{:: ;~ 2 ]\ [: [email protected]"1 (0&{::))@[ drawLines ]


use utf8;

my @names = (
	"North",
	"North by east",
	"North-northeast",
	"Northeast by north",
	"Northeast",
	"Northeast by east",
	"East-northeast",
	"East by north",
	"East",
	"East by south",
	"East-southeast",
	"Southeast by east",
	"Southeast",
	"Southeast by south",
	"South-southeast",
	"South by east",
	"South",
	"South by west",
	"South-southwest",
	"Southwest by south",
	"Southwest",
	"Southwest by west",
	"West-southwest",
	"West by south",
	"West",
	"West by north",
	"West-northwest",
	"Northwest by west",
	"Northwest",
	"Northwest by north",
	"North-northwest",
	"North by west",
);
my @angles = (0.0, 16.87, 16.88, 33.75, 50.62, 50.63, 67.5, 84.37, 84.38,
	101.25, 118.12, 118.13, 135.0, 151.87, 151.88, 168.75, 185.62,
	185.63, 202.5, 219.37, 219.38, 236.25, 253.12, 253.13, 270.0,
	286.87, 286.88, 303.75, 320.62, 320.63, 337.5, 354.37, 354.38);

for (@angles) {
	my $i = int(($_ * 32 / 360) + .5) % 32;
	printf "%3d %18s %6.2f°\n", $i + 1, $names[$i], $_;
}


enum SHL, SAR, SHR, ROL, ROR
function bitop(atom a, integer b, integer op)
atom res
    #ilASM{
        [32]
            mov eax,[a]
            call :%pLoadMint
            mov ecx,[b]
            mov edx,[op]
            cmp dl,SHL
            jne @f
                shl eax,cl
                jmp :storeres
          @@:
            cmp dl,SAR
            jne @f
                sar eax,cl
                jmp :storeres
          @@:
            cmp dl,SHR
            jne @f
                shr eax,cl
                jmp :storeres
          @@:
            cmp dl,ROL
            jne @f
                rol eax,cl
                jmp :storeres
          @@:
            cmp dl,ROR
            jne @f
                ror eax,cl
                jmp :storeres
          @@:
            int3
          ::storeres
            lea edi,[res]
            call :%pStoreMint
        [64]
            mov rax,[a]
            mov rcx,[b]
            mov edx,[op]
            cmp dl,SHL
            jne @f
                shl rax,cl
                jmp :storeres
          @@:
            cmp dl,SAR
            jne @f
                sar rax,cl
                jmp :storeres
          @@:
            cmp dl,SHR
            jne @f
                shr rax,cl
                jmp :storeres
          @@:
            cmp dl,ROL
            jne @f
                rol rax,cl
                jmp :storeres
          @@:
            cmp dl,ROR
            jne @f
                ror eax,cl
                jmp :storeres
          @@:
            int3
          ::storeres
            lea rdi,[res]
            call :%pStoreMint
          }
    return res
end function

procedure bitwise(atom a, atom b)
    printf(1,"and_bits(%b,%b) = %032b\n",{a,b,and_bits(a,b)})
    printf(1," or_bits(%b,%b) = %032b\n",{a,b, or_bits(a,b)})
    printf(1,"xor_bits(%b,%b) = %032b\n",{a,b,xor_bits(a,b)})
    printf(1,"not_bits(%b)     = %032b\n",{a,not_bits(a)})
    printf(1,"     shl(%b,%b) = %032b\n",{a,b,bitop(a,b,SHL)})
    printf(1,"     sar(%b,%b) = %032b\n",{a,b,bitop(a,b,SAR)})
    printf(1,"     shr(%b,%b) = %032b\n",{a,b,bitop(a,b,SHR)})
    printf(1,"     rol(%b,%b) = %032b\n",{a,b,bitop(a,b,ROL)})
    printf(1,"     ror(%b,%b) = %032b\n",{a,b,bitop(a,b,ROR)})
end procedure

bitwise(0x800000FE,7)


  function draw() {
    var canvas = document.getElementById("container");
    context = canvas.getContext("2d");

    bezier3(20, 200, 700, 50, -300, 50, 380, 150);
//    bezier3(160, 10, 10, 40, 30, 160, 150, 110);
//    bezier3(0,149, 30,50, 120,130, 160,30, 0);
  }

  // http://rosettacode.org/wiki/Cubic_bezier_curves#C
  function bezier3(x1, y1, x2, y2, x3, y3, x4, y4) {
    var px = [], py = [];
    for (var i = 0; i <= b3Seg; i++) {
      var d = i / b3Seg;
      var a = 1 - d;
      var b = a * a;
      var c = d * d;
      a = a * b;
      b = 3 * b * d;
      c = 3 * a * c;
      d = c * d;
      px[i] = parseInt(a * x1 + b * x2 + c * x3 + d * x4);
      py[i] = parseInt(a * y1 + b * y2 + c * y3 + d * y4);
    }
    var x0 = px[0];
    var y0 = py[0];
    for (i = 1; i <= b3Seg; i++) {
      var x = px[i];
      var y = py[i];
      drawPolygon(context, [[x0, y0], [x, y]], "red", "red");
      x0 = x;
      y0 = y;
    }
  }
function drawPolygon(context, polygon, strokeStyle, fillStyle) {
  context.strokeStyle = strokeStyle;
  context.beginPath();

  context.moveTo(polygon[0][0],polygon[0][1]);
  for (i = 1; i < polygon.length; i++)
    context.lineTo(polygon[i][0],polygon[i][1]);

  context.closePath();
  context.stroke();

  if (fillStyle == undefined)
    return;
  context.fillStyle = fillStyle;
  context.fill();
}


with javascript_semantics
function get225(integer d, string p1, string p2, string p4)
    string p3 = p1&'-'&lower(p2)
           p2 &= " by "&lower(p1)
           p1 &= " by "&lower(p4)
    if d then
        return {p1,p3,p2}       -- eg {North by east,North-northeast,Northeast by north}
    else
        return {p2,p3,p1}       -- eg {Northeast by east,East-northeast,East by north}
    end if
end function

function get45(sequence res, integer d, string p1, string p2)
    string p3
    res = append(res,p1)        -- North/East/South/West
    if d then
        p3 = p1&lower(p2)       -- Northeast/Southwest
    else
        p3 = p2&lower(p1)       -- Southeast/Northwest
    end if
    res &= get225(1,p1,p3,p2)   -- eg get225(1,North,Northeast,East)
                                -- -> {North by east,North-northeast,Northeast by north}
    res = append(res,p3)        -- Northeast/Southeast/Southwest/Northwest
    res &= get225(0,p2,p3,p1)   -- eg get225(0,East,Northeast,North)
                                -- -> {Northeast by east,East-northeast,East by north}
    return res
end function

function get90(sequence points)
    sequence res = {}
    for i=1 to length(points) do
        res = get45(res,remainder(i,2),points[i],points[remainder(i,4)+1])
    end for -- ie get45(1,North,East)
            --    get45(0,East,South)
            --    get45(1,South,West)
            --    get45(0,West,North)
    return res
end function

constant compass_points = get90({"North","East","South","West"})

for i = 1 to 33 do
    atom test_point = (i-1)*11.25 + 5.62*(remainder(i,3)-1)
    integer compass_point = remainder(floor(test_point*32/360+0.5),32)+1
    printf(1, "%2d  %-22s  %6.2f\n", {compass_point, compass_points[compass_point], test_point})
end for


6 var a 3 var b

def tab
    9 tochar print
enddef

def printBits
    8 int>bit reverse print nl
enddef

a print " = " print tab a printBits
b print " = " print tab b printBits
tab "------------------------" print nl
"AND = " print tab a b bitand printBits
"OR =  " print tab a b bitor printBits
"XOR = " print tab a b bitxor printBits
"NOT = " print tab a bitnot printBits


function bitwise($a, $b)
{
    function zerofill($a,$b) {
        if($a>=0) return $a>>$b;
        if($b==0) return (($a>>1)&0x7fffffff)*2+(($a>>$b)&1); // this line shifts a 0 into the sign bit for compatibility, replace with "if($b==0) return $a;" if you need $b=0 to mean that nothing happens
        return ((~$a)>>$b)^(0x7fffffff>>($b-1));

    echo '$a AND $b: ' . $a & $b . '\n';
    echo '$a OR $b: ' . $a | $b . '\n';
    echo '$a XOR $b: ' . $a ^ $b . '\n';
    echo 'NOT $a: ' . ~$a . '\n';
    echo '$a << $b: ' . $a << $b . '\n'; // left shift
    echo '$a >> $b: ' . $a >> $b . '\n'; // arithmetic right shift
    echo 'zerofill($a, $b): ' . zerofill($a, $b) . '\n'; // logical right shift
}


using Images

function cubicbezier!(xy::Matrix,
                      img::Matrix = fill(RGB(255.0, 255.0, 255.0), 17, 17),
                      col::ColorTypes.Color = convert(eltype(img), Gray(0.0)),
                      n::Int = 20)
    t = collect(0:n) ./ n
    M = hcat((1 .- t) .^ 3, # a
             3t .* (1 .- t) .^ 2, # b
             3t .^ 2 .* (1 .- t), # c
             t .^ 3) # d
    p = floor.(Int, M * xy)
    for i in 1:n
        drawline!(img, p[i, :]..., p[i+1, :]..., col)
    end
    return img
end

xy = [16 1; 1 4; 3 16; 15 11]
cubicbezier!(xy)