#include <iostream>

void bitwise(int a, int b)
{
  std::cout << "a and b: " << (a & b)  << '\n'; // Note: parentheses are needed because & has lower precedence than <<
  std::cout << "a or b:  " << (a | b)  << '\n';
  std::cout << "a xor b: " << (a ^ b)  << '\n';
  std::cout << "not a:   " << ~a       << '\n';

  // Note: the C/C++ shift operators are not guaranteed to work if the shift count (that is, b)
  // is negative, or is greater or equal to the number of bits in the integer being shifted.
  std::cout << "a shl b: " << (a << b) << '\n'; // Note: "<<" is used both for output and for left shift
  std::cout << "a shr b: " << (a >> b) << '\n'; // typically arithmetic right shift, but not guaranteed
  unsigned int ua = a;
  std::cout << "a lsr b: " << (ua >> b) << '\n'; // logical right shift (guaranteed)

  // there are no rotation operators in C++, but as of c++20 there is a standard-library rotate function.
  // The rotate function works for all rotation amounts, but the integer being rotated must always be an
  // unsigned integer.
  std::cout << "a rol b: " << std::rotl(ua, b) << '\n';
  std::cout << "a ror b: " << std::rotr(ua, b) << '\n';

}


>>::"}"9**\4+3%79*9*5-*79*9*5--+:5>>>06p:55+%68*+v
^[email protected]#!`*84:+1<v*9"}"*+55,,,".",,,$$_^#!:-1g60/+55\<
>_06g:v>55+,^>/5+55+/48*::::,,,,%:1+.9,:06p48*\-0v
|p60-1<|<!p80:<N|Ev"northwest"0"North by west"0p8<
>:#,_>>>_08g1-^W|S>"-htroN"0"htron yb tsewhtroN"0v
#v"est-northwest"0"Northwest by west"0"Northwest"<
N>"W"0"htron yb tseW"0"tseW"0"htuos yb tseW"0"ts"v
#v0"Southwest"0"Southwest by west"0"West-southwe"<
S>"htuos yb tsewhtuoS"0"tsewhtuos-htuoS"0"tsew y"v
#v"h-southeast"0"South by east"0"South"0"South b"<
E>"tuoS"0"htuos yb tsaehtuoS"0"tsaehtuoS"0"tsae "v
#v"East by south"0"East-southeast"0"Southeast by"<
W>0"tsaE"0"htron yb tsaE"0"tsaehtron-tsaE"0"tsae"v
#v"rtheast by north"0"Northeast"0"Northeast by "<<
^>"oN"0"tsaehtron-htroN"0"tsae yb htroN"0"htroN"01


#include <stdio.h>

int main()
{
        int i, j;
        double degrees[] = { 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 };
        const char * 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         "
                              "North                 ";

        for (i = 0; i < 33; i++) {
                j = .5 + degrees[i] * 32 / 360;

                printf("%2d  %.22s  %6.2f\n", (j % 32) + 1, names + (j % 32) * 22,
                        degrees[i]);
        }

        return 0;
}


(bit-and x y)
(bit-or x y)
(bit-xor x y)
(bit-not x)
(bit-shift-left x n)
(bit-shift-right x n)
;;There is no built-in for rotation.


       IDENTIFICATION DIVISION.
       PROGRAM-ID. bitwise-ops.

       DATA DIVISION.
       LOCAL-STORAGE SECTION.
       01  a                       PIC 1(32) USAGE BIT.
       01  b                       PIC 1(32) USAGE BIT.

       01  result                  PIC 1(32) USAGE BIT.
       01  result-disp             REDEFINES result PIC S9(9) COMP.

       LINKAGE SECTION.
       01  a-int                   USAGE BINARY-LONG.
       01  b-int                   USAGE BINARY-LONG.

       PROCEDURE DIVISION USING a-int, b-int.
           MOVE FUNCTION BOOLEAN-OF-INTEGER(a-int, 32) TO a
           MOVE FUNCTION BOOLEAN-OF-INTEGER(b-int, 32) TO b

           COMPUTE result = a B-AND b
           DISPLAY "a and b is " result-disp

           COMPUTE result = a B-OR b
           DISPLAY "a or b is " result-disp

           COMPUTE result = B-NOT a
           DISPLAY "Not a is " result-disp

           COMPUTE result = a B-XOR b
           DISPLAY "a exclusive-or b is " result-disp

           *> COBOL does not have shift or rotation operators.

           GOBACK
           .


using System;
using System.Collections.Generic;

namespace BoxTheCompass
{
    class Compass
    {
        string[] cp = new 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", "North"};

        public void compassHeading(float a)
        {
            int h = Convert.ToInt32(Math.Floor(a / 11.25f + .5f)) % 32;
            Console.WriteLine( "{0,2}: {1,-22} : {2,6:N}",h + 1, cp[h], a );
        }
    };
    class Program
    {
        static void Main(string[] args)
       {
            Compass c = new Compass();
            float[] degs = new float[] {0.0f, 16.87f, 16.88f, 33.75f, 50.62f, 50.63f, 67.5f, 84.37f, 84.38f, 101.25f,
                118.12f, 118.13f, 135.0f, 151.87f, 151.88f, 168.75f, 185.62f, 185.63f, 202.5f, 219.37f, 219.38f, 236.25f,
                253.12f, 253.13f, 270.0f, 286.87f, 286.88f, 303.75f, 320.62f, 320.63f, 337.5f, 354.37f, 354.38f};

            foreach (float d in degs)
                c.compassHeading(d);

            Console.WriteLine("\nPress any key to continue...");
            Console.ReadKey();
        }
    }
}


f = (a, b) ->
  p "and", a & b
  p "or", a | b
  p "xor", a ^ b
  p "not", ~a
  p "<<", a << b
  p ">>", a >> b
  # no rotation shifts that I know of

p = (label, n) -> console.log label, n

f(10,2)


(defun bitwise (a b)
  (print (logand a b))  ; AND
  (print (logior a b))  ; OR ("ior" = inclusive or)
  (print (logxor a b))  ; XOR
  (print (lognot a))    ; NOT
  (print (ash a b))     ; arithmetic left shift (positive 2nd arg)
  (print (ash a (- b))) ; arithmetic right shift (negative 2nd arg)
                        ; no logical shift
)


#include <string>
#include <boost/array.hpp>
#include <boost/assign/list_of.hpp>
#include <boost/format.hpp>
#include <boost/foreach.hpp>
#include <iostream>
#include <math.h>
using std::string;
using namespace boost::assign;

int get_Index(float angle)
{
   return static_cast<int>(floor(angle / 11.25 +0.5 )) % 32 + 1;
}

string get_Abbr_From_Index(int i)
{
    static boost::array<std::string, 32> points(list_of
            ("N")("NbE")("NNE")("NEbN")("NE")("NEbE")("ENE")("EbN")
            ("E")("EbS")("ESE")("SEbE")("SE")("SEbS")("SSE")("SbE")
            ("S")("SbW")("SSW")("SWbS")("SW")("SWbW")("WSW")("WbS")
            ("W")("WbN")("WNW")("NWbW")("NW")("NWbN")("NNW")("NbW"));
    return points[i-1];
}

string Build_Name_From_Abbreviation(string a)
{
    string retval;
    for (int i = 0; i < a.size(); ++i){
        if ((1 == i) && (a[i] != 'b') && (a.size() == 3)) retval += "-";
        switch (a[i]){
            case 'N' : retval += "north"; break;
            case 'S' : retval += "south"; break;
            case 'E' : retval += "east";  break;
            case 'W' : retval += "west";  break;
            case 'b' : retval += " by ";  break;
        }
    }
    retval[0] = toupper(retval[0]);
    return retval;
}

int main()
{
    boost::array<float,33> headings(list_of
            (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));
    int i;
    boost::format f("%1$4d %2$-20s %3$_7.2f");

    BOOST_FOREACH(float a, headings)
    {
        i = get_Index(a);
        std::cout << f % i %  Build_Name_From_Abbreviation(get_Abbr_From_Index(i)) % a << std::endl;
    }
    return 0;
}


T rot(T)(in T x, in int shift) pure nothrow @nogc {
    return (x >>> shift) | (x << (T.sizeof * 8 - shift));
}

void testBit(in int a, in int b) {
  import std.stdio;
  writefln("Input: a = %d, b = %d", a, b);
  writefln("AND  : %8b  & %08b = %032b (%4d)", a, b, a & b, a & b);
  writefln(" OR  : %8b  | %08b = %032b (%4d)", a, b, a | b, a | b);
  writefln("XOR  : %8b  ^ %08b = %032b (%4d)", a, b, a ^ b, a ^ b);
  writefln("LSH  : %8b << %08b = %032b (%4d)", a, b, a << b, a << b);
  writefln("RSH  : %8b >> %08b = %032b (%4d)", a, b, a >> b, a >> b);
  writefln("NOT  : %8s  ~ %08b = %032b (%4d)", "", a, ~a, ~a);
  writefln("ROT  : rot(%8b, %d)     = %032b (%4d)",
           a, b, rot(a, b), rot(a, b));
}

void main() {
  immutable int a = 0b_1111_1111; // bit literal 255
  immutable int b = 0b_0000_0010; // bit literal 2

  testBit(a, b);
}


(ns boxing-the-compass
  (:use [clojure.string :only [capitalize]]))

(def headings
     (for [i (range 0 (inc 32))]
       (let [heading (* i 11.25)]
	 (case (mod i 3)
	       1 (+ heading 5.62)
	       2 (- heading 5.62)
	       heading))))

(defn angle2compass
  [angle]
  (let [dirs ["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"]
	unpack {\N "north" \E "east" \W "west" \S "south" \b " by " \- "-"}
	sep  (/ 360 (count dirs))
	dir  (int (/ (mod (+ angle (/ sep 2)) 360) sep))]
    (capitalize (apply str (map unpack (dirs dir))))))

(print
 (apply str (map-indexed #(format "%2s %-18s %7.2f\n"
				  (inc (mod %1 32)) (angle2compass %2) %2)
			 headings)))


program Bitwise;

{$APPTYPE CONSOLE}

begin
  Writeln('2 and 3 = ', 2 and 3);
  Writeln('2 or 3 = ', 2 or 3);
  Writeln('2 xor 3 = ', 2 xor 3);
  Writeln('not 2 = ', not 2);
  Writeln('2 shl 3 = ', 2 shl 3);
  Writeln('2 shr 3 = ', 2 shr 3);
// there are no built-in rotation operators in Delphi
  Readln;
end.


PrintLn('2 and 3 = '+IntToStr(2 and 3));
PrintLn('2 or 3 = '+IntToStr(2 or 3));
PrintLn('2 xor 3 = '+IntToStr(2 xor 3));
PrintLn('not 2 = '+IntToStr(not 2));
PrintLn('2 shl 3 = '+IntToStr(2 shl 3));
PrintLn('2 shr 3 = '+IntToStr(2 shr 3));


       identification division.
       program-id. box-compass.
       data division.
       working-storage section.
       01 point                pic 99.
       01 degrees              usage float-short.
       01 degrees-rounded      pic 999v99.
       01 show-degrees         pic zz9.99.
       01 box                  pic z9.
       01 fudge                pic 9.
       01 compass              pic x(4).
       01 compass-point        pic x(18).
       01 shortform            pic x.
       01 short-names.
          05 short-name        pic x(4) occurs 33 times.
       01 overlay.
          05 value "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   ".

       procedure division.
       display "Index Compass point      Degree"

       move overlay to short-names.
       perform varying point from 0 by 1 until point > 32
           compute box = function mod(point 32) + 1
           compute degrees = point * 11.25
           compute fudge = function mod(point 3)
           evaluate fudge
              when equal 1
                  add 5.62 to degrees
              when equal 2
                  subtract 5.62 from degrees
           end-evaluate

           compute degrees-rounded rounded = degrees
           move degrees-rounded to show-degrees
           inspect show-degrees replacing trailing '00' by '0 '
           inspect show-degrees replacing trailing '50' by '5 '

           move short-name(point + 1) to compass
           move spaces to compass-point
           display space box space space space with no advancing
           perform varying tally from 1 by 1 until tally > 4
               move compass(tally:1) to shortform
               move function concatenate(function trim(compass-point),
                    function substitute(shortform,
                        "N", "North",
                        "E", "East",
                        "S", "South",
                        "W", "West",
                        "b", " byZ",
                        "-", "-"))
                 to compass-point
           end-perform
           move function substitute(compass-point, "Z", " ")
             to compass-point
           move function lower-case(compass-point) to compass-point
           move function upper-case(compass-point(1:1))
             to compass-point(1:1)
           display compass-point space show-degrees
       end-perform
       goback.


def bitwise(a :int, b :int) {
   println(`Bitwise operations:
   a AND b: ${a & b}
   a OR b: ${a | b}
   a XOR b: ${a ^ b}
   NOT a: " + ${~a}
   a left shift b: ${a << b}
   a right shift b: ${a >> b}
`)
}


BitwiseOperations(INTEGER A, INTEGER B) := FUNCTION
  BitAND := A & B;
  BitOR  := A | B;
  BitXOR := A ^ B;
  BitNOT := BNOT A;
  BitSL  := A << B;
  BitSR  := A >> B;
  DS     := DATASET([{A,B,'Bitwise AND:',BitAND},
	             {A,B,'Bitwise OR:',BitOR},
		     {A,B,'Bitwise XOR',BitXOR},
		     {A,B,'Bitwise NOT A:',BitNOT},
		     {A,B,'ShiftLeft A:',BitSL},
		     {A,B,'ShiftRight A:',BitSR}],
		     {INTEGER AVal,INTEGER BVal,STRING15 valuetype,INTEGER val});
  RETURN DS;
END;

BitwiseOperations(255,5);
//right arithmetic shift, left and right rotate not implemented
/*
   OUTPUT:
   255	5	Bitwise AND:   	5
   255	5	Bitwise OR:    	255
   255	5	Bitwise XOR    	250
   255	5	Bitwise NOT A: 	-256
   255	5	ShiftLeft A:   	8160
   255	5	ShiftRight A:  	7

*/


import std.stdio, std.string, std.math, std.array;

struct boxTheCompass {
    immutable static string[32] points;

    pure nothrow static this() {
        immutable cardinal = ["north", "east", "south", "west"];
        immutable desc = ["1", "1 by 2", "1-C", "C by 1", "C",
                          "C by 2", "2-C", "2 by 1"];

        foreach (immutable i; 0 .. 4) {
            immutable s1 = cardinal[i];
            immutable s2 = cardinal[(i + 1) % 4];
            immutable sc = (s1 == "north" || s1 == "south") ?
                           (s1 ~ s2) : (s2 ~ s1);
            foreach (immutable j; 0 .. 8)
                points[i * 8 + j] = desc[j].replace("1", s1).
                                    replace("2", s2).replace("C", sc);
        }
    }

    static string opCall(in double degrees) pure /*nothrow*/ {
        immutable testD = (degrees / 11.25) + 0.5;
        return points[cast(int)floor(testD % 32)].capitalize;
    }
}

void main() {
    foreach (immutable i; 0 .. 33) {
        immutable heading = i * 11.25 + [0, 5.62, -5.62][i % 3];
        writefln("%s\t%18s\t%s", i % 32 + 1,
                 heading.boxTheCompass, heading);
    }
}


import extensions;

extension testOp
{
    bitwiseTest(y)
    {
        console.printLine(self," and ",y," = ",self.and(y));
        console.printLine(self," or ",y," = ",self.or(y));
        console.printLine(self," xor ",y," = ",self.xor(y));
        console.printLine("not ",self," = ",self.Inverted);
        console.printLine(self," shr ",y," = ",self.shiftRight(y));
        console.printLine(self," shl ",y," = ",self.shiftLeft(y));
    }
}

public program()
{
    console.loadLineTo(new Integer()).bitwiseTest(console.loadLineTo(new Integer()))
}


defmodule Bitwise_operation do
  use Bitwise

  def test(a \\ 255, b \\ 170, c \\ 2) do
    IO.puts "Bitwise function:"
    IO.puts "band(#{a}, #{b}) = #{band(a, b)}"
    IO.puts "bor(#{a}, #{b}) = #{bor(a, b)}"
    IO.puts "bxor(#{a}, #{b}) = #{bxor(a, b)}"
    IO.puts "bnot(#{a}) = #{bnot(a)}"
    IO.puts "bsl(#{a}, #{c}) = #{bsl(a, c)}"
    IO.puts "bsr(#{a}, #{c}) = #{bsr(a, c)}"
    IO.puts "\nBitwise as operator:"
    IO.puts "#{a} &&& #{b} = #{a &&& b}"
    IO.puts "#{a} ||| #{b} = #{a ||| b}"
    IO.puts "#{a} ^^^ #{b} = #{a ^^^ b}"
    IO.puts "~~~#{a} = #{~~~a}"
    IO.puts "#{a} <<< #{c} = #{a <<< c}"
    IO.puts "#{a} >>> #{c} = #{a >>> c}"
  end
end

Bitwise_operation.test


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 QuadraticBezier(RgbImage POINTER img
  IntPoint POINTER p1,p2,p3 RGB POINTER col)
  INT i,n=[20],prevX,prevY,nextX,nextY
  REAL one,two,ri,rn,rt,ra,rb,rc,tmp1,tmp2,tmp3
  REAL x1,y1,x2,y2,x3,y3

  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(1,one)   IntToReal(2,two)
  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,ra)  ;a=(1-t)^2

    RealMult(two,rt,tmp2)   ;tmp2=2*t
    RealMult(tmp2,tmp1,rb)  ;b=2*t*(1-t)

    RealMult(rt,rt,rc)      ;c=t^2

    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
    nextX=Round(tmp2)

    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
    nextY=Round(tmp2)

    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

  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=47 p2.y=39
  p3.x=69 p3.y=12
  RgbLine(img,p1.x,p1.y,p2.x,p2.y,blue)
  RgbLine(img,p2.x,p2.y,p3.x,p3.y,blue)
  QuadraticBezier(img,p1,p2,p3,yellow)
  SetRgbPixel(img,p1.x,p1.y,violet)
  SetRgbPixel(img,p2.x,p2.y,violet)
  SetRgbPixel(img,p3.x,p3.y,violet)

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

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


defmodule Box do
  defp head do
    Enum.chunk(~w(north east south west north), 2, 1)
    |> Enum.flat_map(fn [a,b] ->
         c = if a=="north" or a=="south", do: "#{a}#{b}", else: "#{b}#{a}"
         [ a, "#{a} by #{b}", "#{a}-#{c}", "#{c} by #{a}",
           c, "#{c} by #{b}", "#{b}-#{c}", "#{b} by #{a}" ]
       end)
    |> Enum.with_index
    |> Enum.map(fn {s, i} -> {i+1, String.capitalize(s)} end)
    |> Map.new
  end

  def compass do
    header = head()
    angles = Enum.map(0..32, fn i -> i * 11.25 + elem({0, 5.62, -5.62}, rem(i, 3)) end)
    Enum.each(angles, fn degrees ->
      index = rem(round(32 * degrees / 360), 32) + 1
      :io.format "~2w  ~-20s ~6.2f~n", [index, header[index], degrees]
    end)
  end
end

Box.compass


-module(bitwise_operations).

-export([test/0]).

test() ->
   A = 255,
   B = 170,
   io:format("~p band ~p = ~p\n",[A,B,A band B]),
   io:format("~p bor ~p = ~p\n",[A,B,A bor B]),
   io:format("~p bxor ~p = ~p\n",[A,B,A bxor B]),
   io:format("not ~p = ~p\n",[A,bnot A]),
   io:format("~p bsl ~p = ~p\n",[A,B,A bsl B]),
   io:format("~p bsr ~p = ~p\n",[A,B,A bsr B]).


procedure Quadratic_Bezier
          (  Picture    : in out Image;
             P1, P2, P3 : 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)**2;
         B : constant Float := 2.0 * T * (1.0 - T);
         C : constant Float := T**2;
      begin
         Points (I).X := Positive (A * Float (P1.X) + B * Float (P2.X) + C * Float (P3.X));
         Points (I).Y := Positive (A * Float (P1.Y) + B * Float (P2.Y) + C * Float (P3.Y));
      end;
   end loop;
   for I in Points'First..Points'Last - 1 loop
      Line (Picture, Points (I), Points (I + 1), Color);
   end loop;
end Quadratic_Bezier;


      Width% = 200
      Height% = 200

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

      REM Draw quadratic Bézier curve:
      PROCbezierquad(10,100, 250,270, 150,20, 20, 0,0,0)
      END

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

      FOR i% = 0 TO n%
        t = i% / n%
        t1 = 1 - t
        a = t1^2
        b = 2 * t * t1
        c = t^2
        p{(i%)}.x% = INT(a * x1 + b * x2 + c * x3 + 0.5)
        p{(i%)}.y% = INT(a * y1 + b * y2 + c * y3 + 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 quad_bezier(
        image img,
        unsigned int x1, unsigned int y1,
        unsigned int x2, unsigned int y2,
        unsigned int x3, unsigned int y3,
        color_component r,
        color_component g,
        color_component b );


   10 rem bezier curve algorihm
   20 rem translated from purebasic
   30 ns=25 : rem num segments
   40 dim pt(ns,2) : rem points in line
   50 sc=1024 : rem start of screen memory
   60 sw=40   : rem screen width
   70 sh=25   : rem screen height
   80 pc=42   : rem plot character '*'
   90 dim bp(2,1) : rem bezier curve points
  100 bp(0,0)=1:bp(1,0)=70:bp(2,0)=1
  110 bp(0,1)=1:bp(1,1)=8:bp(2,1)=23
  120 dim pt%(ns,2) : rem individual lines in curve
  130 gosub 3000
  140 end
 1000 rem plot line
 1010 se=0 : rem 0 = steep 1 = !steep
 1020 if abs(y1-y0)>abs(x1-x0) then se=1:tp=y0:y0=x0:x0=tp:tp=y1:y1=x1:x1=tp
 1030 if x0>x1 then tp=x1:x1=x0:x0=tp:tp=y1:y1=y0:y0=tp
 1040 dx=x1-x0
 1050 dy=abs(y1-y0)
 1060 er=dx/2
 1070 y=y0
 1080 ys=-1
 1090 if y0<y1 then ys = 1
 1100 for x=x0 to x1
 1110 if se=1 then p0=y: p1=x:gosub 2000:goto 1130
 1120 p0=x: p1=y: gosub 2000
 1130 er=er-dy
 1140 if er<0 then y=y+ys:er=er+dx
 1150 next x
 1160 return
 2000 rem plot individual point
 2010 rem p0 == plot point x
 2020 rem p1 == plot point y
 2030 sl=p0+(p1*sw)
 2040 rem make sure we dont write beyond screen memory
 2050 if sl<(sw*sh) then poke sc+sl,pc
 2060 return
 3000 rem bezier curve
 3010 for i=0 to ns
 3020 t=i/ns
 3030 t1=1.0-t
 3040 a=t1^2
 3050 b=2.0*t*t1
 3060 c=t^2
 3070 pt(i,0)=a*bp(0,0)+b*bp(1,0)+c*bp(2,0)
 3080 pt(i,1)=a*bp(0,1)+b*bp(1,1)+c*bp(2,1)
 3090 next i
 3100 for i=0 to ns-1
 3110 x0=int(pt(i,0))
 3120 y0=int(pt(i,1))
 3130 x1=int(pt(i+1,0))
 3140 y1=int(pt(i+1,1))
 3150 gosub 1000
 3160 next i
 3170 return


constant 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"}

function deg2ind(atom degree)
    return remainder(floor(degree*32/360+.5),32)+1
end function

sequence degrees
degrees = {}
for i = 0 to 32 do
    degrees &= i*11.25 + 5.62*(remainder(i+1,3)-1)
end for

integer j
for i = 1 to length(degrees) do
    j = deg2ind(degrees[i])
    printf(1, "%6.2f  %2d  %-22s\n", {degrees[i], j, names[j]})
end for


let bitwise a b =
    printfn "a and b: %d" (a &&& b)
    printfn "a or  b: %d" (a ||| b)
    printfn "a xor b: %d" (a ^^^ b)
    printfn "not a: %d"   (~~~a)
    printfn "a shl b: %d" (a <<< b)
    printfn "a shr b: %d" (a >>> b)          // arithmetic shift
    printfn "a shr b: %d" ((uint32 a) >>> b) // logical shift
    // No rotation operators.


"a=" "b=" [ write readln string>number ] [email protected]
{
    [ bitand "a AND b: " write . ]
    [ bitor "a OR b: " write . ]
    [ bitxor "a XOR b: " write . ]
    [ drop bitnot "NOT a: " write . ]
    [ abs shift "a asl b: " write . ]
    [ neg shift "a asr b: " write . ]
} 2cleave


import grayscale_image, bitmap_bresenhams_line_algorithm;

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

void quadraticBezier(size_t nSegments=20, Color)
                    (Image!Color im, in Pt p1, in Pt p2, in Pt p3,
                     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) ^^ 2,
                         b = 2.0 * t * (1.0 - t),
                         c = t ^^ 2;
        p = Pt(cast(typeof(Pt.x))(a * p1.x + b * p2.x + c * p3.x),
               cast(typeof(Pt.y))(a * p1.y + b * p2.y + c * p3.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(20, 20);
    im.clear(Gray.white);
    im.quadraticBezier(Pt(1,10), Pt(25,27), Pt(15,2), Gray.black);
    im.textualShow();
}


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

! This gives a function
:: (quadratic-bezier) ( P0 P1 P2 -- bezier )
    [ :> x
        1 x - sq P0 n*v
        2 1 x - x * * P1 n*v
        x sq P2 n*v
        v+ v+ ] ; inline

! Same code from the cubic bezier task
: t-interval ( x -- interval )
    [ iota ] keep 1 - [ / ] curry map ;
: 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 image -- )
    100 t-interval P0 P1 P2 (quadratic-bezier) map
    points-to-lines
    {R,G,B} swap image draw-lines ;


INCLUDE "H6:LOADPPM5.ACT"

DEFINE HISTSIZE="256"

PROC PutBigPixel(INT x,y BYTE col)
  IF x>=0 AND x<=79 AND y>=0 AND y<=47 THEN
    y==LSH 2
    col==RSH 4
    IF col<0 THEN col=0
    ELSEIF col>15 THEN col=15 FI
    Color=col
    Plot(x,y)
    DrawTo(x,y+3)
  FI
RETURN

PROC DrawImage(GrayImage POINTER image INT x,y)
  INT i,j
  BYTE c

  FOR j=0 TO image.gh-1
  DO
    FOR i=0 TO image.gw-1
    DO
      c=GetGrayPixel(image,i,j)
      PutBigPixel(x+i,y+j,c)
    OD
  OD
RETURN

PROC CalcHistogram(GrayImage POINTER image INT ARRAY hist)
  INT i,j
  BYTE c

  Zero(hist,HISTSIZE*2)
  FOR j=0 TO image.gh-1
  DO
    FOR i=0 TO image.gw-1
    DO
      c=GetGrayPixel(image,i,j)
      hist(c)==+1
    OD
  OD
RETURN

BYTE FUNC CalcThresholdValue(INT width,height INT ARRAY hist)
  INT i,sum,total,curr

  total=width*height
  sum=0
  FOR i=0 TO HISTSIZE-1
  DO
    curr=hist(i)
    IF sum>=(total-curr)/2 THEN
      RETURN (i)
    FI
    sum==+curr
  OD
RETURN (HISTSIZE-1)

PROC Binarize(GrayImage POINTER src,dst BYTE threshold)
  INT i,j
  BYTE c

  FOR j=0 TO src.gh-1
  DO
    FOR i=0 TO src.gw-1
    DO
      c=GetGrayPixel(src,i,j)
      IF c<threshold THEN
        c=0
      ELSE
        c=255
      FI
      SetGrayPixel(dst,i,j,c)
    OD
  OD
RETURN

PROC Main()
  BYTE CH=$02FC ;Internal hardware value for last key pressed
  BYTE ARRAY dataIn(900),dataOut(900)
  GrayImage in,out
  INT ARRAY hist(HISTSIZE)
  BYTE threshold
  INT size=[30],x,y

  Put(125) PutE() ;clear the screen

  InitGrayImage(in,size,size,dataIn)
  InitGrayImage(out,size,size,dataOut)
  PrintE("Loading source image...")
  LoadPPM5(in,"H6:LENA30G.PPM")
  PrintE("Calc histogram...")
  CalcHistogram(in,hist)
  PrintE("Calc threshold value...")
  threshold=CalcThresholdValue(in.gw,in.gh,hist)
  PrintE("Binarization...")
  Binarize(in,out,threshold)

  Graphics(9)
  x=(40-size)/2
  y=(48-size)/2
  DrawImage(in,x,y)
  DrawImage(out,x+40,y)

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


let 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" |]

[ 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 ]
|> List.iter (fun phi ->
    let i =  (int (phi * 32. / 360. + 0.5)) % 32
    printf "%3d %18s %6.2f°\n" (i + 1) box.[i] phi)


10 3
\[email protected][email protected][email protected][email protected]\  { 3 copies }
"a & b = "&."
a | b  = "|."
~a = "%~."
"


: arshift 0 ?do 2/ loop ;            \ 2/ is an arithmetic shift right by one bit (2* shifts left one bit)
: bitwise ( a b -- )
  cr ." a = " over . ." b = " dup .
  cr ." a and b = " 2dup and .
  cr ." a  or b = " 2dup  or .
  cr ." a xor b = " 2dup xor .
  cr ." not a = " over invert .
  cr ." a shl b = " 2dup lshift .
  cr ." a shr b = " 2dup rshift .
  cr ." a ashr b = " 2dup arshift .
  2drop ;


#DEFINE WM_LBUTTONDOWN 513
#DEFINE WM_CLOSE 16

FBSLSETTEXT(ME, "Bezier Quadratic")
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: BezierQuad(10, 100, 250, 270, 150, 20, 20) ' Draw
		CASE WM_CLOSE: FBSL.RELEASEDC(ME, FBSL.GETDC) ' Clean up
	END SELECT
END EVENTS

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

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

	FOR DIM i = 0 TO n
		t = i / n: t1 = 1 - t
		a = t1 ^ 2
		b = 2 * t * t1
		c = t ^ 2
		p[i].x = a * x1 + b * x2 + c * x3 + 0.5
		p[i].y = Height - (a * y1 + b * y2 + c * y3 + 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


type Pixel_Count is mod 2**64;
type Histogram is array (Luminance) of Pixel_Count;

function Get_Histogram (Picture : Grayscale_Image) return Histogram is
   Result : Histogram := (others => 0);
begin
   for I in Picture'Range (1) loop
      for J in Picture'Range (2) loop
         declare
            Count : Pixel_Count renames Result (Picture (I, J));
         begin
            Count := Count + 1;
         end;
      end loop;
   end loop;
   return Result;
end Get_Histogram;


      INSTALL @lib$+"SORTLIB"
      Sort% = FN_sortinit(0,0)

      Width% = 200
      Height% = 200

      VDU 23,22,Width%;Height%;8,16,16,128
      *display c:\lenagrey

      DIM hist%(255), idx%(255)
      FOR i% = 0 TO 255 : idx%(i%) = i% : NEXT

      REM Build histogram:
      FOR y% = 0 TO Height%-1
        FOR x% = 0 TO Width%-1
          l% = FNgetpixel(x%,y%) AND &FF
          hist%(l%) += 1
        NEXT
      NEXT y%

      REM Sort histogram:
      C% = 256
      CALL Sort%, hist%(0), idx%(0)

      REM Find median:
      total% = SUM(hist%())
      half% = 0
      FOR i% = 0 TO 255
        half% += hist%(i%)
        IF half% >= total%/2 THEN
          median% = idx%(i%)
          EXIT FOR
        ENDIF
      NEXT

      REM Display black & white version:
      FOR y% = 0 TO Height%-1
        FOR x% = 0 TO Width%-1
          l% = FNgetpixel(x%,y%) AND &FF
          IF l% > median% THEN
            PROCsetpixel(x%,y%,255,255,255)
          ELSE
            PROCsetpixel(x%,y%,0,0,0)
          ENDIF
        NEXT
      NEXT y%
      END

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

      DEF FNgetpixel(x%,y%)
      LOCAL col%
      col% = TINT(x%*2,y%*2)
      SWAP ?^col%,?(^col%+2)
      = col%


typedef unsigned int histogram_t;
typedef histogram_t *histogram;

#define GET_LUM(IMG, X, Y) ( (IMG)->buf[ (Y) * (IMG)->width + (X)][0] )

histogram get_histogram(grayimage im);
luminance histogram_median(histogram h);


(defpackage #:histogram
  (:use #:cl
        #:opticl))

(in-package #:histogram)

(defun color->gray-image (image)
  (check-type image 8-bit-rgb-image)
  (let ((gray-image (with-image-bounds (height width) image
                      (make-8-bit-gray-image height width :initial-element 0))))
    (do-pixels (i j) image
      (multiple-value-bind (r g b) (pixel image i j)
        (let ((gray (+ (* 0.2126 r) (* 0.7152 g) (* 0.0722 b))))
          (setf (pixel gray-image i j) (round gray)))))
    gray-image))

(defun make-histogram (image)
  (check-type image 8-bit-gray-image)
  (let ((histogram (make-array 256 :element-type 'fixnum :initial-element 0)))
    (do-pixels (i j) image
      (incf (aref histogram (pixel image i j))))
    histogram))

(defun find-median (histogram)
  (loop with num-pixels = (loop for count across histogram sum count)
        with half = (/ num-pixels 2)
        for count across histogram
        for i from 0
        sum count into acc
        when (>= acc half)
          return i))

(defun gray->black&white-image (image)
  (check-type image 8-bit-gray-image)
  (let* ((histogram (make-histogram image))
         (median (find-median histogram))
         (bw-image (with-image-bounds (height width) image
                     (make-1-bit-gray-image height width :initial-element 0))))
    (do-pixels (i j) image
      (setf (pixel bw-image i j) (if (<= (pixel image i j) median) 1 0)))
    bw-image))

(defun main ()
  (let* ((image (read-jpeg-file "lenna.jpg"))
         (bw-image (gray->black&white-image (color->gray-image image))))
    (write-pbm-file "lenna-bw.pbm" bw-image)))


USING: formatting kernel math sequences ;

CONSTANT: 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"
}

{
    0 16.87 16.88 33.75 50.62 50.63 67.5 84.37 84.38 101.25
    118.12 118.13 135 151.87 151.88 168.75 185.62 185.63 202.5
    219.37 219.38 236.25 253.12 253.13 270 286.87 286.88 303.75
    320.62 320.63 337.5 354.37 354.38
}

[
    dup 32 * 360 /f 0.5 + >integer 32 mod [ 1 + ] [ box nth ] bi
    "%6.2f°  %2d  %s\n" printf
] each


integer :: i, j = -1, k = 42
logical :: a

i = bit_size(j)       ! returns the number of bits in the given INTEGER variable

! bitwise boolean operations on integers
i = iand(k, j)        ! returns bitwise AND of K and J
i = ior(k, j)         ! returns bitwise OR of K and J
i = ieor(k, j)        ! returns bitwise EXCLUSIVE OR of K and J
i = not(j)            ! returns bitwise NOT of J

! single-bit integer/logical operations (bit positions are zero-based)
a = btest(i, 4)       ! returns logical .TRUE. if bit position 4 of I is 1, .FALSE. if 0
i = ibclr(k, 8)       ! returns value of K with 8th bit position "cleared" (set to 0)
i = ibset(k, 13)      ! returns value of K with 13th bit position "set" (set to 1)

! multi-bit integer operations
i = ishft(k, j)       ! returns value of K shifted by J bit positions, with ZERO fill
                      !    (right shift if J < 0 and left shift if J > 0).
i = ishftc(k, j)      ! returns value of K shifted CIRCULARLY by J bit positions
                      !    (right circular shift if J < 0 and left if J > 0)
i = ishftc(k, j, 20)  ! returns value as before except that ONLY the 20 lowest order
                      !    (rightmost) bits are circularly shifted
i = ibits(k, 7, 8)    ! extracts 8 contiguous bits from K starting at position 7 and
                      !    returns them as the rightmost bits of an otherwise
                      !    zero-filled integer. For non-negative K this is
                      !    arithmetically equivalent to:   MOD((K / 2**7), 2**8)


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

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

  do i = 0, N_SEG
     t = real(i) / real(N_SEG)
     a = (1.0 - t)**2.0
     b = 2.0 * t * (1.0 - t)
     c = t**2.0
     x = a * p1%x + b * p2%x + c * p3%x
     y = a * p1%y + b * p2%y + c * p3%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 quad_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/Quadratic BBC BASIC entry
Sub bezierquad(x1 As Double, y1 As Double, x2 As Double, y2 As Double, _
    x3 As Double, y3 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 ^ 2
        b = t * t1 * 2
        c = t ^ 2
        p(i).x = Int(a * x1 + b * x2  + c * x3 + .5)
        p(i).y = Int(a * y1 + b * y2  + c * y3 + .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

bezierquad(10, 100, 250, 270, 150, 20, 20)

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


import grayscale_image;

Color findSingleChannelMedian(Color)(in Image!Color img)
pure nothrow @nogc if (Color.tupleof.length == 1) // Hack.
in {
    assert(img !is null);
} body {
    size_t[Color.max + 1] hist;
    foreach (immutable c; img.image)
        hist[c]++;

    // Slower indexes, but not significantly so.
    auto from = Color(0);
    auto to = Color(hist.length - 1);

    auto left = hist[from];
    auto right = hist[to];

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

    return from;
}

Image!Color binarizeInPlace(Color)(Image!Color img,
                                   in Color thresh)
pure nothrow @nogc in {
    assert(img !is null);
} body {
    foreach (immutable i, ref c; img.image)
        c = (c < thresh) ? Color.min : Color.max;
    return img;
}

void main() {
    Image!RGB im;
    im.loadPPM6("quantum_frog.ppm");
    auto img = im.rgb2grayImage();
    img.binarizeInPlace(img.findSingleChannelMedian())
       .savePGM("quantum_frog_bin.pgm");
}


#DEFINE WM_CLOSE 16

DIM colored = ".\LenaClr.bmp", grayscale = ".\LenaGry.bmp", blackwhite = ".\LenaBnw.bmp"
DIM head, tail, r, g, b, l, m, ptr, blobsize = 54 ' sizeof BMP headers

FILEGET(FILEOPEN(colored, BINARY), FILELEN(colored)): FILECLOSE(FILEOPEN) ' fill buffer
head = @FILEGET + blobsize: tail = @FILEGET + FILELEN ' get buffer bounds

ToGrayScale() ' derive grayscale image and save it to disk
ToBlackAndWhite() ' ditto, black-and-white image

FBSLSETTEXT(ME, "Clr") ' display colored image
FBSLTILE(ME, FBSLLOADIMAGE(colored))
RESIZE(ME, 0, 0, 136, 162): CENTER(ME): SHOW(ME)

FBSLTILE(FBSLFORM("Gry"), FBSLLOADIMAGE(grayscale)) ' ditto, grayscale
RESIZE(FBSLFORM, 0, 0, 136, 162): CENTER(FBSLFORM): SHOW(FBSLFORM)

FBSLTILE(FBSLFORM("B/w"), FBSLLOADIMAGE(blackwhite)) ' ditto, black-and-white
RESIZE(FBSLFORM, 0, 0, 136, 162): CENTER(FBSLFORM): SHOW(FBSLFORM)

BEGIN EVENTS ' main message loop
	IF CBMSG = WM_CLOSE THEN DESTROY(ME) ' click any [X] button to quit
END EVENTS

SUB ToGrayScale()
	FOR ptr = head TO tail STEP 3
		b = PEEK(ptr + 0, 1) ' Windows stores colors in BGR order
		g = PEEK(ptr + 1, 1)
		r = PEEK(ptr + 2, 1)
		l = 0.2126 * r + 0.7152 * g + 0.0722 * b ' derive luminance
		POKE(ptr + 0, CHR(l))(ptr + 1, CHR)(ptr + 2, CHR) ' set pixel to shade of gray
		m = m + l
	NEXT
	FILEPUT(FILEOPEN(grayscale, BINARY_NEW), FILEGET): FILECLOSE(FILEOPEN) ' save grayscale image
END SUB

SUB ToBlackAndWhite()
	STATIC b = CHR(0), w = CHR(255) ' initialize once

	m = m / (tail - head) * 3 ' derive median
	FOR ptr = head TO tail STEP 3
		IF PEEK(ptr + 0, 1) < m THEN ' set pixel black
			POKE(ptr + 0, b)(ptr + 1, b)(ptr + 2, b)
		ELSE ' set pixel white
			POKE(ptr + 0, w)(ptr + 1, w)(ptr + 2, w)
		END IF
	NEXT
	FILEPUT(FILEOPEN(blackwhite, BINARY_NEW), FILEGET): FILECLOSE(FILEOPEN) ' save b/w image
END SUB


Program Compass
  implicit none

  integer :: i, ind
  real :: heading

  do i = 0, 32
    heading = i * 11.25
    if (mod(i, 3) == 1) then
      heading = heading + 5.62
    else if (mod(i, 3) == 2) then
            heading = heading - 5.62
    end if
    ind = mod(i, 32) + 1
    write(*, "(i2, a20, f8.2)") ind, compasspoint(heading), heading
  end do

contains

function compasspoint(h)
  character(18) :: compasspoint
  character(18) :: points(32) = (/ "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     "  /)
  real, intent(in) :: h
  real :: x

  x = h / 11.25 + 1.5
  if (x >= 33.0) x = x - 32.0
  compasspoint = points(int(x))
end function compasspoint
end program Compass


program Bitwise;
{$mode objfpc}
var
  // Pascal uses a native int type as a default literal type
  // Make sure the operants work on an exact type.
  x:shortint = 2;
  y:ShortInt = 3;
begin
  Writeln('2 and 3 = ', x and y);
  Writeln('2 or 3 = ', x or y);
  Writeln('2 xor 3 = ', x xor y);
  Writeln('not 2 = ', not x);
  Writeln('2 shl 3 = ', x >> y);
  Writeln('2 shr 3 = ', x << y);
  writeln('2 rol 3 = ', rolbyte(x,y));
  writeln('2 ror 3 = ', rorbyte(x,y));
  writeln('2 sar 3 = ', sarshortint(x,y));
  Readln;
end.


' FB 1.05.0 Win64 (Note the (U)Integer type is 64 bits)

' FB doesn't have built-in logical shift right or rotation operators
' but, as they're not difficult to implement, I've done so below.

Function lsr(x As Const Integer, y As Const Integer) As Integer
  Dim As UInteger z = x
  Return z Shr y
End Function

Function rol(x As Const Integer, y As Const UInteger) As Integer
  Dim z As Integer = x
  Dim high As Integer
  For i As Integer = 1 To y
    high = Bit(z, 63)
    For j As Integer = 62 To 0 Step -1
      If Bit(z, j) Then
        z = BitSet(z, j + 1)
      Else
        z = BitReset (z, j + 1)
      End If
    Next j
    If high Then
      z = BitSet(z, 0)
    Else
      z = BitReset(z, 0)
    End If
  Next i
  Return z
End Function

Function ror(x As Const Integer, y As Const UInteger) As Integer
  Dim z As Integer = x
  Dim low As Integer
  For i As Integer = 1 To y
    low = Bit(z, 0)
    For j As Integer = 1 To 63
      If Bit(z, j) Then
        z = BitSet(z, j - 1)
      Else
        z = BitReset (z, j - 1)
      End If
    Next j
    If low Then
      z = BitSet(z, 63)
    Else
      z = BitReset(z, 63)
    End If
  Next i
  Return z
End Function

Sub bitwise(x As Integer, y As Integer)
  Print "x       = "; x
  Print "y       = "; y
  Print "x AND y = "; x And y
  Print "x OR y  = "; x Or y
  Print "x XOR y = "; x XOr y
  Print "NOT x   = "; Not x
  Print "x SHL y = "; x Shl y
  Print "x SHR y = "; x Shr y
  Print "x LSR y = "; lsr(x, y)
  Print "x ROL y = "; rol(x, y)
  Print "x ROR y = "; ror(x, y)
End Sub

bitwise -15, 3
Print
Print "Press any key to quit"
Sleep


package raster

const b2Seg = 20

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

func (b *Bitmap) Bézier2Rgb(x1, y1, x2, y2, x3, y3 int, c Rgb) {
    b.Bézier2(x1, y1, x2, y2, x3, y3, c.Pixel())
}


{-# LANGUAGE
    FlexibleInstances, TypeSynonymInstances,
    ViewPatterns #-}

import Bitmap
import Bitmap.Line
import Control.Monad
import Control.Monad.ST

type Point = (Double, Double)
fromPixel (Pixel (x, y)) = (toEnum x, toEnum y)
toPixel (x, y) = Pixel (round x, round y)

pmap :: (Double -> Double) -> Point -> Point
pmap f (x, y) = (f x, f y)

onCoordinates :: (Double -> Double -> Double) -> Point -> Point -> Point
onCoordinates f (xa, ya) (xb, yb) = (f xa xb, f ya yb)

instance Num Point where
    (+) = onCoordinates (+)
    (-) = onCoordinates (-)
    (*) = onCoordinates (*)
    negate = pmap negate
    abs = pmap abs
    signum = pmap signum
    fromInteger i = (i', i')
      where i' = fromInteger i

bézier :: Color c =>
    Image s c -> Pixel -> Pixel -> Pixel -> c -> Int ->
    ST s ()
bézier
  i
  (fromPixel -> p1) (fromPixel -> p2) (fromPixel -> p3)
  c samples =
    zipWithM_ f ts (tail ts)
  where ts = map (/ top) [0 .. top]
          where top = toEnum $ samples - 1
        curvePoint t =
            pt (t' ^^ 2) p1 +
            pt (2 * t * t') p2 +
            pt (t ^^ 2) p3
          where t' = 1 - t
                pt n p = pmap (*n) p
        f (curvePoint -> p1) (curvePoint -> p2) =
            line i (toPixel p1) (toPixel p2) c


: histogram ( array gmp -- )
  over 256 cells erase
  dup bdim * over bdata +  swap bdata
  do 1 over i [email protected] cells + +! loop drop ;


module RCImageProcess
  use RCImageBasic
  implicit none
contains

  subroutine get_histogram(img, histogram)
    type(scimage), intent(in) :: img
    integer, dimension(0:255), intent(out) :: histogram

    integer :: i

    histogram = 0
    do i = 0,255
       histogram(i) = sum(img%channel, img%channel == i)
    end do
  end subroutine get_histogram

  function histogram_median(histogram)
    integer, dimension(0:255), intent(in) :: histogram
    integer :: histogram_median

    integer :: from, to, left, right

    from = 0
    to = 255
    left = histogram(from)
    right = histogram(to)
    do while ( from /= to )
       if ( left < right ) then
          from = from + 1
          left = left + histogram(from)
       else
          to = to - 1
          right = right + histogram(to)
       end if
    end do
    histogram_median = from
  end function histogram_median

end module RCImageProcess


package raster

import "math"

func (g *Grmap) Histogram(bins int) []int {
    if bins <= 0 {
        bins = g.cols
    }
    h := make([]int, bins)
    for _, p := range g.px {
        h[int(p)*(bins-1)/math.MaxUint16]++
    }
    return h
}

func (g *Grmap) Threshold(t uint16) {
    for i, p := range g.px {
        if p < t {
            g.px[i] = 0
        } else {
            g.px[i] = math.MaxUint16
        }
    }
}


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

Dim As String names(0 To ...) = { "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" }

Dim As Double degrees(0 To ...) = { 0, 16.87, 16.88, 33.75, 50.62, 50.63, _
 67.5, 84.37, 84.38, 101.25, 118.12, 118.13, 135, 151.87, 151.88, 168.75, _
      185.62, 185.63, 202.5, 219.37, 219.38, 236.25, 253.12, 253.13, 270, _
           286.87, 286.88, 303.75, 320.62, 320.63, 337.5, 354.37, 354.38 }

Dim As ULong i, j

For i = LBound(degrees) To UBound(degrees)
    j = Int((degrees(i) + 5.625) / 11.25)
    If j > 31 Then j = j - 32
    Print Using "####.##  ##  "; degrees(i); j;
    Print names(j)
Next

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


window 1, @"Bitwise Operations", (0,0,650,270)

def fn rotl( b as long, n as long ) as long = ( ( 2^n * b) mod 256) or (b > 127)
def fn rotr( b as long, n as long ) as long = (b >> n mod 32) or ( b << (32-n) mod 32)

local fn bitwise( a as long, b as long )
  print @"Input: a = "; a; @"  b = "; b
  print
  print @"AND  :", @"a && b = ", bin(a && b), @": "; a && b
  print @"NAND :", @"a ^& b = ", bin(a ^& b), @": "; a ^& b
  print @"OR   :", @"a || b = ", bin(a || b), @": "; a || b
  print @"NOR  :", @"a ^| b = ", bin(a ^| b), @": "; a ^| b
  print @"XOR  :", @"a ^^ b = ", bin(a ^^ b), @": "; a ^^ b
  print @"NOT  :", @" not a = ", bin( not a), @": ";  not a
  print
  print @"Left shift   :", @"a << b =", bin(a << b), @": "; a << b
  print @"Right shift  :", @"a >> b =", bin(a >> b), @": "; a >> b
  print
  print @"Rotate left  :", @"fn rotl( a, b ) = ", bin(fn rotl( a, b)), @": "; fn rotl( a, b )
  print @"Rotate right :", @"fn rotr( a, b ) = ", bin(fn rotr( a, b )),@": "; fn rotr( a, b )
end fn

fn bitwise( 255, 2 )

HandleEvents


package main

import "fmt"

func bitwise(a, b int16) {
	fmt.Printf("a:   %016b\n", uint16(a))
	fmt.Printf("b:   %016b\n", uint16(b))

	// Bitwise logical operations
	fmt.Printf("and: %016b\n", uint16(a&b))
	fmt.Printf("or:  %016b\n", uint16(a|b))
	fmt.Printf("xor: %016b\n", uint16(a^b))
	fmt.Printf("not: %016b\n", uint16(^a))

	if b < 0 {
		fmt.Println("Right operand is negative, but all shifts require an unsigned right operand (shift distance).")
		return
	}
	ua := uint16(a)
	ub := uint32(b)

	// Logical shifts (unsigned left operand)
	fmt.Printf("shl: %016b\n", uint16(ua<<ub))
	fmt.Printf("shr: %016b\n", uint16(ua>>ub))

	// Arithmetic shifts (signed left operand)
	fmt.Printf("las: %016b\n", uint16(a<<ub))
	fmt.Printf("ras: %016b\n", uint16(a>>ub))

	// Rotations
	fmt.Printf("rol: %016b\n", uint16(a<<ub|int16(uint16(a)>>(16-ub))))
	fmt.Printf("ror: %016b\n", uint16(int16(uint16(a)>>ub)|a<<(16-ub)))
}

func main() {
	var a, b int16 = -460, 6
	bitwise(a, b)
}


// Version 1.2.40

import java.awt.Color
import java.awt.Graphics
import java.awt.image.BufferedImage
import kotlin.math.abs
import java.io.File
import javax.imageio.ImageIO

class Point(var x: Int, var y: Int)

class BasicBitmapStorage(width: Int, height: Int) {
    val image = BufferedImage(width, height, BufferedImage.TYPE_3BYTE_BGR)

    fun fill(c: Color) {
        val g = image.graphics
        g.color = c
        g.fillRect(0, 0, image.width, image.height)
    }

    fun setPixel(x: Int, y: Int, c: Color) = image.setRGB(x, y, c.getRGB())

    fun getPixel(x: Int, y: Int) = Color(image.getRGB(x, y))

    fun drawLine(x0: Int, y0: Int, x1: Int, y1: Int, c: Color) {
        val dx = abs(x1 - x0)
        val dy = abs(y1 - y0)
        val sx = if (x0 < x1) 1 else -1
        val sy = if (y0 < y1) 1 else -1
        var xx = x0
        var yy = y0
        var e1 = (if (dx > dy) dx else -dy) / 2
        var e2: Int
        while (true) {
            setPixel(xx, yy, c)
            if (xx == x1 && yy == y1) break
            e2 = e1
            if (e2 > -dx) { e1 -= dy; xx += sx }
            if (e2 <  dy) { e1 += dx; yy += sy }
        }
    }

    fun quadraticBezier(p1: Point, p2: Point, p3: Point, clr: Color, n: Int) {
        val pts = List(n + 1) { Point(0, 0) }
        for (i in 0..n) {
            val t = i.toDouble() / n
            val u = 1.0 - t
            val a = u * u
            val b = 2.0 * t * u
            val c = t * t
            pts[i].x = (a * p1.x + b * p2.x + c * p3.x).toInt()
            pts[i].y = (a * p1.y + b * p2.y + c * p3.y).toInt()
            setPixel(pts[i].x, pts[i].y, clr)
        }
        for (i in 0 until n) {
            val j = i + 1
            drawLine(pts[i].x, pts[i].y, pts[j].x, pts[j].y, clr)
        }
    }
}

fun main(args: Array<String>) {
    val width = 320
    val height = 320
    val bbs = BasicBitmapStorage(width, height)
    with (bbs) {
        fill(Color.cyan)
        val p1 = Point(10, 100)
        val p2 = Point(250, 270)
        val p3 = Point(150, 20)
        quadraticBezier(p1, p2, p3, Color.black, 20)
        val qbFile = File("quadratic_bezier.jpg")
        ImageIO.write(image, "jpg", qbFile)
    }
}


module Bitmap.BW(module Bitmap.BW) where

import Bitmap
import Control.Monad.ST

newtype BW = BW Bool deriving (Eq, Ord)

instance Color BW where
    luminance (BW False) = 0
    luminance _          = 255
    black = BW False
    white = BW True
    toNetpbm [] = ""
    toNetpbm l = init (concatMap f line) ++ "\n" ++ toNetpbm rest
      where (line, rest) = splitAt 35 l
            f (BW False) = "1 "
            f _          = "0 "
    fromNetpbm = map f
      where f 1 = black
            f _ = white
    netpbmMagicNumber _ = "P1"
    netpbmMaxval _ = ""

toBWImage :: Color c => Image s c -> ST s (Image s BW)
toBWImage = toBWImage' 128

toBWImage' :: Color c => Int -> Image s c -> ST s (Image s BW)
{- The first argument gives the darkest luminance assigned
to white. -}
toBWImage' darkestWhite = mapImage $ f . luminance
  where f x | x < darkestWhite = black
            | otherwise        = white


import java.awt.image.BufferedImage;
import java.io.File;
import java.io.IOException;
import javax.imageio.ImageIO;

public enum ImageProcessing {
    ;

    public static void main(String[] args) throws IOException {
        BufferedImage img = ImageIO.read(new File("example.png"));

        BufferedImage bwimg = toBlackAndWhite(img);

        ImageIO.write(bwimg, "png", new File("example-bw.png"));
    }

    private static int luminance(int rgb) {
        int r = (rgb >> 16) & 0xFF;
        int g = (rgb >> 8) & 0xFF;
        int b = rgb & 0xFF;
        return (r + b + g) / 3;
    }

    private static BufferedImage toBlackAndWhite(BufferedImage img) {
        int width = img.getWidth();
        int height = img.getHeight();

        int[] histo = computeHistogram(img);

        int median = getMedian(width * height, histo);

        BufferedImage bwimg = new BufferedImage(width, height, img.getType());
        for (int y = 0; y < height; y++) {
            for (int x = 0; x < width; x++) {
                bwimg.setRGB(x, y, luminance(img.getRGB(x, y)) >= median ? 0xFFFFFFFF : 0xFF000000);
            }
        }
        return bwimg;
    }

    private static int[] computeHistogram(BufferedImage img) {
        int width = img.getWidth();
        int height = img.getHeight();

        int[] histo = new int[256];
        for (int y = 0; y < height; y++) {
            for (int x = 0; x < width; x++) {
                histo[luminance(img.getRGB(x, y))]++;
            }
        }
        return histo;
    }

    private static int getMedian(int total, int[] histo) {
        int median = 0;
        int sum = 0;
        for (int i = 0; i < histo.length && sum + histo[i] < total / 2; i++) {
            sum += histo[i];
            median++;
        }
        return median;
    }
}


Public Sub Main()
Dim fDeg As Float[] = [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]
Dim cHeading As Collection = ["N": "North", "S": "South", "W": "West", "E": "East", "b": "by"]
Dim sHeading As String[] = ["N", "NbE", "NNE", "NEbE", "NE", "NEbE", "ENE", "EbN", "E", "EbS", "ESE", "SEbE", "SE", "SEbS", "SSE", "SbE", "S", "SbW", "SSW", "SWbS", "SW", "SWbW", "WSW", "WbS", "W", "WbN", "WNW", "NWbW", "NW", "NWbN", "NNW", "NbW"]
Dim siLoop As Short
Dim sDirection As String
Dim fCount, fTemp As Float

For Each fCount In fDeg
   fTemp = Round(fCount / 11.25)
   If fTemp = 32 Then fTemp = 0
    For siLoop = 0 To Len(sHeading[fTemp])
      sDirection &= cHeading[Mid(sHeading[fTemp], siLoop + 1, 1)] & " "
    Next
  Print "Index=" & Format(fTemp + 1, "#0") & "  " & Format(Str(fCount), "##0.00") & " degrees = " & sDirection
  sDirection = ""
Next

End


PROCEDURE Main(...)
   local n1 := 42, n2 := 2
   local aPar := hb_AParams()
   local nRot

   if ! Empty( aPar )
      n1 := Val( aPar[1] )
      hb_Adel( aPar, 1, .T. )
      if ! Empty( aPar )
         n2 := Val( aPar[1] )
      endif
   endif
   clear screen

   ? "Bitwise operations with two integers"
   ? "n1 =", hb_ntos(n1)
   ? "n2 =", hb_ntos(n2)
   ? "------------------------------------"
   ? "AND          -->", hb_BitAnd( n1, n2 )
   ? "OR           -->", hb_BitOr( n1, n2 )
   ? "XOR          -->", hb_BitXor( n1, n2 )
   ? "NOT          -->", hb_BitNot( n1 )
   ? "LSHIFT       -->", hb_bitShift( n1, n2 )
   ? "RSHIFT       -->", hb_bitShift( n1, -n2 )
   ? "RarSHIFT     -->", hb_bitShift( n1, -n2 )

   /* left/right rotation is not implemented, but we can use inline C-code to do it */
   /* rotate n1 to the left by n2 bits */
   nRot := hb_Inline( n1, n2 ) {
      HB_UINT x = hb_parni( 1 ), s = hb_parni( 2 );
      hb_retni( (x << s) | (x >> (-s & 31)) );
   }            // (x << s) | (x >> (32 - s));
   ? "Rotate left  -->", nRot

   /* rotate n1 to the right by n2 bits */
   nRot := HB_INLINE( n1, n2 ){
      HB_UINT x = hb_parni( 1 ), s = hb_parni( 2 );
      hb_retni( (x >> s) | (x << (32 - s)) );
   }
   ? "Rotate right -->", nRot

   return


using Images, FileIO

ima = load("data/lenna50.jpg")
imb = Gray.(ima)

medcol = median(imb)
imb[imb .≤ medcol] = Gray(0.0)
imb[imb .> medcol] = Gray(1.0)
save("data/lennaGray.jpg", imb)


// version 1.2.10

import java.io.File
import java.awt.image.BufferedImage
import javax.imageio.ImageIO

const val BLACK = 0xff000000.toInt()
const val WHITE = 0xffffffff.toInt()

fun luminance(argb: Int): Int {
    val red   = (argb shr 16) and 0xFF
    val green = (argb shr  8) and 0xFF
    val blue  =  argb and 0xFF
    return (0.2126 * red + 0.7152 * green + 0.0722 * blue).toInt()
}

val BufferedImage.histogram: IntArray
    get() {
        val lumCount = IntArray(256)
        for (x in 0 until width) {
            for (y in 0 until height) {
                var argb = getRGB(x, y)
                lumCount[luminance(argb)]++
            }
        }
        return lumCount
    }

fun findMedian(histogram: IntArray): Int {
    var lSum  = 0
    var rSum  = 0
    var left  = 0
    var right = 255
    do {
        if (lSum < rSum) lSum += histogram[left++]
        else             rSum += histogram[right--]
    }
    while (left != right)
    return left
}

fun BufferedImage.toBlackAndWhite(median: Int) {
    for (x in 0 until width) {
        for (y in 0 until height) {
            val argb = getRGB(x, y)
            val lum  = luminance(argb)
            if (lum < median)
                setRGB(x, y, BLACK)
            else
                setRGB(x, y, WHITE)
        }
    }
}

fun main(args: Array<String>) {
    val image = ImageIO.read(File("Lenna100.jpg"))
    val median = findMedian(image.histogram)
    image.toBlackAndWhite(median)
    val bwFile = File("Lenna_bw.jpg")
    ImageIO.write(image, "jpg", bwFile)
}


package main

import "fmt"

// function required by task
func degrees2compasspoint(h float32) string {
    return compassPoint[cpx(h)]
}

// cpx returns integer index from 0 to 31 corresponding to compass point.
// input heading h is in degrees.  Note this index is a zero-based index
// suitable for indexing into the table of printable compass points,
// and is not the same as the index specified to be printed in the output.
func cpx(h float32) int {
    x := int(h/11.25+.5) % 32
    if x < 0 {
        x += 32
    }
    return x
}

// printable compass points
var compassPoint = []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",
}

func main() {
    fmt.Println("Index  Compass point         Degree")
    for i, h := range []float32{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} {
        index := i%32 + 1 // printable index computed per pseudocode
        fmt.Printf("%4d   %-19s %7.2f°\n", index, degrees2compasspoint(h), h)
    }
}


import Data.Bits

bitwise :: Int -> Int -> IO ()
bitwise a b =
  mapM_
    print
    [ a .&. b
    , a .|. b
    , a `xor` b
    , complement a
    , shiftL a b -- left shift
    , shiftR a b -- arithmetic right shift
    , shift a b -- You can also use the "unified" shift function;
      -- positive is for left shift, negative is for right shift
    , shift a (-b)
    , rotateL a b -- rotate left
    , rotateR a b -- rotate right
    , rotate a b -- You can also use the "unified" rotate function;
      -- positive is for left rotate, negative is for right rotate
    , rotate a (-b)
    ]

main :: IO ()
main = bitwise 255 170


i = IAND(k, j)
i = IOR( k, j)
i = IEOR(k, j)
i = NOT( k   )


function Histogram( image )
    local size_x, size_y = #image, #image[1]

    local histo = {}
    for i = 0, 255 do
        histo[i] = 0
    end

    for i = 1, size_x do
        for j = 1, size_y do
            histo[ image[i][j] ] = histo[ image[i][j] ] + 1
        end
    end

    return histo
end

function FindMedian( histogram )
    local sum_l, sum_r = 0, 0
    local left, right = 0, 255

    repeat
        if sum_l < sum_r then
            sum_l = sum_l + histogram[left]
            left = left + 1
        else
            sum_r = sum_r + histogram[right]
            right = right - 1
        end
    until left == right

    return left
end

bitmap = Read_PPM( "inputimage.ppm" )
gray_im = ConvertToGrayscaleImage( bitmap )
histogram = Histogram( gray_im )
median = FindMedian( histogram )

for i = 1, #gray_im do
    for j = 1, #gray_im[1] do
        if gray_im[i][j] < median then
            gray_im[i][j] = 0
        else
            gray_im[i][j] = 255
        end
    end
end

bitmap = ConvertToColorImage( gray_im )
Write_PPM( "outputimage.ppm", bitmap )


EXPORT BITOPS(a, b)
BEGIN
	PRINT(BITAND(a, b));
	PRINT(BITOR(a, b));
	PRINT(BITXOR(a, b));
	PRINT(BITNOT(a));
	PRINT(BITSL(a, b));
	PRINT(BITSR(a, b));
	// HPPPL has no builtin rotates or arithmetic right shift.
END;


procedure main()
bitdemo(255,2)
bitdemo(-15,3)
end

procedure bitdemo(i,i2)
   write()
   demowrite("i",i)
   demowrite("i2",i2)
   demowrite("complement i",icom(i))
   demowrite("i or i2",ior(i,i2))
   demowrite("i and i2",iand(i,i2))
   demowrite("i xor i2",ixor(i,i2))
   demowrite("i shift " || i2,ishift(i,i2))
   demowrite("i shift -" || i2,ishift(i,-i2))
   return
end

procedure demowrite(vs,v)
return write(vs, ": ", v, " = ", int2bit(v),"b")
end


Bitmap.quadraticbezier = function(self, x1, y1, x2, y2, x3, y3, nseg)
  nseg = nseg or 10
  local prevx, prevy, currx, curry
  for i = 0, nseg do
    local t = i / nseg
    local a, b, c = (1-t)^2, 2*t*(1-t), t^2
    prevx, prevy = currx, curry
    currx = math.floor(a * x1 + b * x2 + c * x3 + 0.5)
    curry = math.floor(a * y1 + b * y2 + c * y3 + 0.5)
    if i > 0 then
      self:line(prevx, prevy, currx, curry)
    end
  end
end

local bitmap = Bitmap(61,21)
bitmap:clear()
bitmap:quadraticbezier( 1,1, 30,37, 59,1 )
bitmap:render({[0x000000]='.', [0xFFFFFFFF]='X'})


pts = {{0, 0}, {1, -1}, {2, 1}};
Graphics[{BSplineCurve[pts], Green, Line[pts], Red, Point[pts]}]


function bezierQuad(obj,pixel_0,pixel_1,pixel_2,color,varargin)

    if( isempty(varargin) )
        resolution = 20;
    else
        resolution = varargin{1};
    end

    %Calculate time axis
    time = (0:1/resolution:1)';
    timeMinus = 1-time;

    %The formula for the curve is expanded for clarity, the lack of
    %loops is because its calculation has been vectorized
    curve = (timeMinus.^2)*pixel_0; %First term of polynomial
    curve = curve + (2.*time.*timeMinus)*pixel_1; %second term of polynomial
    curve = curve + (time.^2)*pixel_2; %third term of polynomial

    curve = round(curve); %round each of the points to the nearest integer

    %connect each of the points in the curve with a line using the
    %Bresenham Line algorithm
    for i = (1:length(curve)-1)
        obj.bresenhamLine(curve(i,:),curve(i+1,:),color);
    end

    assignin('caller',inputname(1),obj); %saves the changes to the object

end


import bitmap
import grayscale_image

type Histogram = array[Luminance, Natural]

#---------------------------------------------------------------------------------------------------

func histogram*(img: GrayImage): Histogram =
  ## Build and return gray scale image histogram.
  for lum in img.pixels:
    inc result[lum]

#---------------------------------------------------------------------------------------------------

func median*(hist: Histogram): Luminance =
  # Return the median luminance of a histogram.
  var
    inf = byte(0)
    sup = Luminance.high
    infCount, supCount = 0

  while inf != sup:
    if infCount < supCount:
      inc infCount, hist[inf]
      inc inf
    else:
      inc supCount, hist[sup]
      dec sup

  result = inf

#———————————————————————————————————————————————————————————————————————————————————————————————————

when isMainModule:

  import ppm_read, ppm_write

  # Read an image.
  let image = readPPM("house.ppm")

  # Build its histogram and find the median luminance.
  let grayImage = image.toGrayImage
  let hist = grayImage.histogram()
  let m = hist.median()
  echo "Median luminance: ", m

  # Convert to black and white.
  for pt in image.indices:
    image[pt.x, pt.y] = if grayImage[pt.x, pt.y] < m: Black else: White

  # Save image as a PPM file.
  image.writePPM("house_bw.ppm")


type histogram = int array

let get_histogram ~img:gray_channel =
  let width = Bigarray.Array2.dim1 gray_channel
  and height = Bigarray.Array2.dim2 gray_channel in
  let t = Array.make 256 0 in
  for x = 0 to pred width do
    for y = 0 to pred height do
      let v = gray_get_pixel_unsafe gray_channel x y in
      t.(v) <- t.(v) + 1;
    done;
  done;
  (t: histogram)
;;


function h = imagehistogram(imago)
  if ( isgray(imago) )
    for j = 0:255
      h(j+1) = numel(imago( imago == j ));
    endfor
  else
    error("histogram on gray img only");
  endif
endfunction

% test
im = jpgread("Lenna100.jpg");
img = rgb2gray(im);
h = imagehistogram(img);
% let's try to show the histogram
bar(h);
pause;

% in order to obtain the requested filtering, we
% can use median directly on the img, and then
% use that value, this way:
m = median(reshape(img, 1, numel(img)));
disp(m);
ibw = img;
ibw( img > m ) = 255;
ibw( img <= m ) = 0;
jpgwrite("lennamed_.jpg", ibw, 100);
% which disagree (128) with the m computed with histog_med (130).
% If we compute it this way:
% m = sort(reshape(img, 1, numel(img)))(ceil(numel(img)/2));
% we obtain 130... but builtin median works as expected, since
% N (number of pixel of Lenna) is even, not odd.

% but let's use our histogram h instead
function m = histog_med(histog)
  from = 0; to = 255;
  left = histog(from + 1); right = histog(to+1);
  while ( from != to )
    if ( left < right )
      from++; left += histog(from+1);
    else
      to--; right += histog(to+1);
    endif
  endwhile
  m = from;
endfunction

m = histog_med(h);
disp(m);
ibw( img > m ) = 255;
ibw( img <= m ) = 0;
jpgwrite("lennamed.jpg", ibw, 100);


import Data.Char (toUpper)

import Data.Maybe (fromMaybe)

import Text.Printf (PrintfType, printf)

dirs :: [String]
dirs =
  [ "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"
  ]

-- Index between 0 and 31 ->  the corresponding compass point name.
pointName :: Int -> String
pointName = capitalize . concatMap (fromMaybe "?" . fromChar) . (dirs !!)
  where
    fromChar c =
      lookup
        c
        [ ('N', "north")
        , ('S', "south")
        , ('E', "east")
        , ('W', "west")
        , ('b', " by ")
        , ('-', "-")
        ]
    capitalize (c:cs) = toUpper c : cs

-- Degrees -> compass point index between 0 and 31.
pointIndex :: Double -> Int
pointIndex d = (round (d * 1000) + 5625) `mod` 360000 `div` 11250

printPointName :: PrintfType t => String -> t
printPointName d =
  let deg = read d :: Double
      idx = pointIndex deg
  in printf "%2d  %-18s  %6.2f°\n" (idx + 1) (pointName idx) deg

main :: IO ()
main = mapM_ (printPointName . show) [0 .. 31]


[ bitwise a b temp;
  print "a and b: ", a & b, "^";
  print "a or b: ", a | b, "^";
  print "not a: ", ~a, "^";
  @art_shift a b -> temp;
  print "a << b (arithmetic): ", temp, "^";
  temp = -b;
  @art_shift a temp -> temp;
  print "a >> b (arithmetic): ", temp, "^";
  @log_shift a b -> temp;
  print "a << b (logical): ", temp, "^";
  temp = -b;
  @log_shift a temp -> temp;
  print "a >> b (logical): ", temp, "^";
];


bAND=:  17 b.  NB. 16+#.0 0 0 1
bOR=:   23 b.  NB. 16+#.0 1 1 1
bXOR=:  22 b.  NB. 16+#.0 1 1 0
b1NOT=: 28 b.  NB. 16+#.1 1 0 0
bLshift=:  33 b.~ NB. see http://www.jsoftware.com/help/release/bdot.htm
bRshift=:  33 b.~ -
bRAshift=: 34 b.~ -
bLrot=:    32 b.~
bRrot=:    32 b.~ -


import bitmap
import bresenham
import lenientops

proc drawQuadraticBezier*(
        image: Image; pt1, pt2, pt3: Point; color: Color; nseg: Positive = 20) =

  var points = newSeq[Point](nseg + 1)

  for i in 0..nseg:
    let t = i / nseg
    let a = (1 - t) * (1 - t)
    let b = 2 * t * (1 - t)
    let c = t * t

    points[i] = (x: (a * pt1.x + b * pt2.x + c * pt3.x).toInt,
                 y: (a * pt1.y + b * pt2.y + c * pt3.y).toInt)

  for i in 1..points.high:
    image.drawLine(points[i - 1], points[i], color)

#———————————————————————————————————————————————————————————————————————————————————————————————————

when isMainModule:
  var img = newImage(16, 12)
  img.fill(White)
  img.drawQuadraticBezier((1, 7), (7, 12), (14, 1), Black)
  img.print


let quad_bezier ~img ~color
        ~p1:(_x1, _y1)
        ~p2:(_x2, _y2)
        ~p3:(_x3, _y3) =
  let (x1, y1, x2, y2, x3, y3) =
    (float _x1, float _y1, float _x2, float _y2, float _x3, float _y3)
  in
  let bz t =
    let a = (1.0 -. t) ** 2.0
    and b = 2.0 *. t *. (1.0 -. t)
    and c = t ** 2.0
    in
    let x = a *. x1 +. b *. x2 +. c *. x3
    and y = a *. y1 +. b *. y2 +. c *. y3
    in
    (int_of_float x, int_of_float y)
  in
  let rec loop _t acc =
    if _t > 20 then acc else
    begin
      let t = (float _t) /. 20.0 in
      let x, y = bz t in
      loop (succ _t) ((x,y)::acc)
    end
  in
  let pts = loop 0 [] in

  (*
  (* draw only points *)
  List.iter (fun (x, y) -> put_pixel img color x y) pts;
  *)

  (* draw segments *)
  let line = draw_line ~img ~color in
  let by_pair li f =
    ignore (List.fold_left (fun prev x -> f prev x; x) (List.hd li) (List.tl li))
  in
  by_pair pts (fun p0 p1 -> line ~p0 ~p1);
;;


-- demo\rosetta\Bitmap_BezierQuadratic.exw
include ppm.e -- black, green, red, white, new_image(), write_ppm(), bresLine()  -- (covers above requirements)

function quadratic_bezier(sequence img, atom x1, y1, x2, y2, x3, y3, integer colour, segments)
    sequence pts = repeat(0,segments*2)
    for i=0 to segments*2-1 by 2 do
        atom t = i/segments,
            t1 = 1-t,
             a = power(t1,2),
             b = 2*t*t1,
             c = power(t,2)
        pts[i+1] = floor(a*x1+b*x2+c*x3)
        pts[i+2] = floor(a*y1+b*y2+c*y3)
    end for
    for i=1 to segments*2-2 by 2 do
        img = bresLine(img, pts[i], pts[i+1], pts[i+2], pts[i+3], colour)
    end for
    return img
end function

sequence img = new_image(200,200,black)
img = quadratic_bezier(img, 0,100, 100,200, 200,0, white, 40)
img = bresLine(img,0,100,100,200,green)
img = bresLine(img,100,200,200,0,green)
img[1][100] = red
img[100][200] = red
img[200][1] = red
write_ppm("BezierQ.ppm",img)


-- demo\rosetta\Bitmap_Histogram.exw  (runnable version)
include ppm.e  -- black, white, read_ppm(), write_ppm()  (covers above requirements)

function to_bw(sequence image)
    sequence hist = repeat(0,256)
    for x=1 to length(image) do
        for y=1 to length(image[x]) do
            integer pixel = image[x][y]          -- red,green,blue
            sequence r_g_b  =  sq_and_bits(pixel,{#FF0000,#FF00,#FF})
            integer {r,g,b} = sq_floor_div(r_g_b,{#010000,#0100,#01}),
                    lum = floor(0.2126*r + 0.7152*g + 0.0722*b)
            image[x][y] = lum
            hist[lum+1] += 1
        end for
    end for
    integer lo = 1, hi = 256,
            ltot = hist[lo],
            rtot = hist[hi]
    while lo!=hi do
        if ltot<rtot then
            lo += 1
            ltot += hist[lo]
        else
            hi -= 1
            rtot += hist[hi]
        end if
    end while
    integer lum = lo
    for i=1 to length(image) do
        for j=1 to length(image[i]) do
            image[i][j] = iff(image[i][j]<lum?black:white)
        end for
    end for
    return image
end function

sequence img = read_ppm("Lena.ppm")
img = to_bw(img)
write_ppm("LenaBW.ppm",img)


define('src_name', 'input.jpg');	// source image
define('dest_name', 'output.jpg');	// destination image

$img = imagecreatefromjpeg(src_name);	// read image

if(empty($img)){
	echo 'Image could not be loaded!';
	exit;
}

$black = imagecolorallocate($img, 0, 0, 0);
$white = imagecolorallocate($img, 255, 255, 255);
$width = imagesx($img);
$height = imagesy($img);

$array_lum = array(); 	// for storage of luminosity of each pixel
$sum_lum = 0;		// total sum of luminosity
$average_lum = 0;	// average luminosity of whole image

for($x = 0; $x < $width; $x++){
	for($y = 0; $y < $height; $y++){
		// read pixel value
		$color = imagecolorat($img, $x, $y);
		$r = ($color >> 16) & 0xFF;
		$g = ($color >> 8) & 0xFF;
		$b = $color & 0xFF;
		// save pixel luminosity in temporary array
		$array_lum[$x][$y] = ($r + $g + $b);
		// add pixel luminosity to sum
		$sum_lum += $array_lum[$x][$y];
	}
}

// calculate average luminosity
$average_lum = $sum_lum / ($width * $height);

for($x = 0; $x < $width; $x++){
	for($y = 0; $y < $height; $y++){
		// pixel is brighter than average -> set white
		// else -> set black
		if($array_lum[$x][$y] > $average_lum){
			imagesetpixel($img, $x, $y, $white);
		}
		else{
			imagesetpixel($img, $x, $y, $black);
		}
	}
}
// save black and white image to dest_name
imagejpeg($img, dest_name);

if(!file_exists(dest_name)){
	echo 'Image not saved! Check permission!';
}


import Algorithms as algo;
import Text as text;

class Compass {
  _majors = none;
  _quarter1 = none;
  _quarter2 = none;
  constructor() {
    _majors = algo.materialize( text.split( "north east south west", " " ), tuple );
    _majors += _majors;
    _quarter1 = text.split( "N,N by E,N-NE,NE by N,NE,NE by E,E-NE,E by N", "," );
    _quarter2 = algo.materialize( algo.map( _quarter1, @( s ){ copy( s ).replace( "NE", "EN" ); } ), list );
  }
  degrees_to_compasspoint( d ) {
    d = d % 360. + 360. / 64.;
    majorindex, minor = ( integer( d ) / 90, d % 90. );
    minorindex  = integer( minor * 4. ) / 45;
    p1, p2 = _majors[majorindex: majorindex + 2];
    q = none;
    if ( p1 ∈ { "north", "south" } ) {
      q = _quarter1;
    } else {
      q = _quarter2;
    }
    return ( text.capitalize( copy( q[minorindex] ).replace( "N", p1 ).replace( "E", p2 ) ) );
  }
}

main() {
  print(
    " # |  Angle  | Compass point\n"
    "---+---------|-------------------\n"
  );
  c = Compass();
  for ( i : algo.range( 33 ) ) {
    d = real( i ) * 11.25;
    m = i % 3;
    if ( m == 1 ) {
      d += 5.62;
    } else if ( m == 2 ) {
      d -= 5.62;
    }
    n = i % 32 + 1;
    print( "{:2d} | {:6.2f}° | {}\n".format( n, d, c.degrees_to_compasspoint( d ) ) );
  }
}


public static void bitwise(int a, int b){
  System.out.println("a AND b: " + (a & b));
  System.out.println("a OR b: "+ (a | b));
  System.out.println("a XOR b: "+ (a ^ b));
  System.out.println("NOT a: " + ~a);
  System.out.println("a << b: " + (a << b)); // left shift
  System.out.println("a >> b: " + (a >> b)); // arithmetic right shift
  System.out.println("a >>> b: " + (a >>> b)); // logical right shift
  System.out.println("a rol b: " + Integer.rotateLeft(a, b)); //rotate left, Java 1.5+
  System.out.println("a ror b: " + Integer.rotateRight(a, b)); //rotate right, Java 1.5+
}


Procedure quad_bezier(img, p1x, p1y, p2x, p2y, p3x, p3y, Color, n_seg)
  Protected i
  Protected.f T, t1, a, b, c, d
  Dim pts.POINT(n_seg)

  For i = 0 To n_seg
    T = i / n_seg
    t1 = 1.0 - T
    a = Pow(t1, 2)
    b = 2.0 * T * t1
    c = Pow(T, 2)
    pts(i)\x = a * p1x + b * p2x + c * p3x
    pts(i)\y = a * p1y + b * p2y + c * p3y
  Next

  StartDrawing(ImageOutput(img))
    FrontColor(Color)
    For i = 0 To n_seg - 1
      BresenhamLine(pts(i)\x, pts(i)\y, pts(i + 1)\x, pts(i + 1)\y)
    Next
  StopDrawing()
EndProcedure

Define w, h, img
w = 200: h = 200: img = 1
CreateImage(img, w, h) ;img is internal id of the image

OpenWindow(0, 0, 0, w, h,"Bezier curve, quadratic", #PB_Window_SystemMenu)
quad_bezier(1, 80,20, 130,80, 20,150, RGB(255, 255, 255), 20)
ImageGadget(0, 0, 0, w, h, ImageID(1))

Define event
Repeat
  event = WaitWindowEvent()
Until event = #PB_Event_CloseWindow


#lang racket
(require racket/draw)

(define (draw-line dc p q)
  (match* (p q) [((list x y) (list s t)) (send dc draw-line x y s t)]))

(define (draw-lines dc ps)
  (void
   (for/fold ([p0 (first ps)]) ([p (rest ps)])
     (draw-line dc p0 p)
     p)))

(define (int t p q)
  (define ((int1 t) x0 x1) (+ (* (- 1 t) x0) (* t x1)))
  (map (int1 t) p q))

(define (bezier-points p0 p1 p2)
  (for/list ([t (in-range 0.0 1.0 (/ 1.0 20))])
    (int t (int t p0 p1) (int t p1 p2))))

(define bm (make-object bitmap% 17 17))
(define dc (new bitmap-dc% [bitmap bm]))
(send dc set-smoothing 'unsmoothed)
(send dc set-pen "red" 1 'solid)
(draw-lines dc (bezier-points '(16 1) '(1 4) '(3 16)))
bm


(de histogram (Pgm)
   (let H (need 256 0)
      (for L Pgm
         (for G L
            (inc (nth H (inc G))) ) )
      H ) )


Procedure getHistogram(image, Array histogram(1))
  Protected w = ImageWidth(image) - 1
  Protected h = ImageHeight(image) - 1
  Dim histogram(255) ;output

  StartDrawing(ImageOutput(image))
    For x = 0 To w
      For y = 0 To h
        lum = Red(Point(x, y)) ;the Green or Blue color components could be used also
        histogram(lum) + 1
      Next
    Next
  StopDrawing()
EndProcedure

Procedure median(Array histogram(1))
  Protected low, high = 255, left, right

  While low <> high
    If left < right
      low + 1
      left + histogram(low)
    Else
      high - 1
      right + histogram(high)
    EndIf
  Wend
  ProcedureReturn low
EndProcedure

Procedure blackAndWhite(image, median)
  Protected w = ImageWidth(image) - 1
  Protected h = ImageHeight(image) - 1
  CallDebugger
  StartDrawing(ImageOutput(image))
    For x = 0 To w
      For y = 0 To h
        If Red(Point(x, y)) < median ;the Green or Blue color components could be used also
          Plot(x, y, $000000) ;black
        Else
          Plot(x, y, $FFFFFF) ;white
        EndIf
      Next
    Next
  StopDrawing()
EndProcedure

Define sourceFile.s, outputFile.s, image = 3, m
Dim histogram(255)

sourceFile = OpenFileRequester("Select source image file", "*.ppm", "PPM image (*.ppm)|PPM", 0)

If sourceFile And LCase(GetExtensionPart(sourceFile)) = "ppm"
  LoadImagePPM(image, sourceFile)
  ImageGrayout(image)

  getHistogram(image,histogram())
  m = median(histogram())
  blackAndWhite(image, m)

  outputFile = Left(sourceFile, Len(sourceFile) - Len(GetExtensionPart(sourceFile))) + "_bw." + GetExtensionPart(sourceFile)
  SaveImageAsPPM(image, outputFile, 1)
EndIf


link strings,numbers

procedure main()

every heading := 11.25 * (i := 0 to 32) do {
   case i%3 of {
      1: heading +:= 5.62
      2: heading -:= 5.62
      }
   write(right(i+1,3)," ",left(direction(heading),20)," ",fix(heading,,7,2))
   }
end

procedure direction(d)  # compass heading given +/- degrees
static dirs
initial {
   every put(dirs := [],
             replacem(!["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","north","E","east","W","west","S","south","b"," by "))
   }

   return dirs[round(((((d%360)+360)%360)/11.25)%32 + 1)]
end


function bitwise(a, b){
   alert("a AND b: " + (a & b));
   alert("a OR b: "+ (a | b));
   alert("a XOR b: "+ (a ^ b));
   alert("NOT a: " + ~a);
   alert("a << b: " + (a << b)); // left shift
   alert("a >> b: " + (a >> b)); // arithmetic right shift
   alert("a >>> b: " + (a >>> b)); // logical right shift
}


# Version 5.2
@show 1 & 2   # AND
@show 1 | 2   # OR
@show 1 ^ 2   # XOR -- for Julia 6.0 the operator is `⊻`
@show ~1      # NOT
@show 1 >>> 2 # SHIFT RIGHT (LOGICAL)
@show 1 >> 2  # SHIFT RIGHT (ARITMETIC)
@show 1 << 2  # SHIFT LEFT (ARITMETIC/LOGICAL)

A = BitArray([true, true, false, false, true])
@show A ror(A,1) ror(A,2) ror(A,5) # ROTATION RIGHT
@show rol(A,1) rol(A,2) rol(A,5) # ROTATION LEFT


class Pixel { has UInt ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @!data;

    method fill(Pixel $p) {
        @!data = $p.clone xx ($!width*$!height)
    }
    method pixel(
	  $i where ^$!width,
	  $j where ^$!height
	  --> Pixel
    ) is rw { @!data[$i + $j * $!width] }

    method set-pixel ($i, $j, Pixel $p) {
        return if $j >= $!height;
        self.pixel($i, $j) = $p.clone;
    }
    method get-pixel ($i, $j) returns Pixel {
	    self.pixel($i, $j);
    }

    method line(($x0 is copy, $y0 is copy), ($x1 is copy, $y1 is copy), $pix) {
        my $steep = abs($y1 - $y0) > abs($x1 - $x0);
        if $steep {
            ($x0, $y0) = ($y0, $x0);
            ($x1, $y1) = ($y1, $x1);
        }
        if $x0 > $x1 {
            ($x0, $x1) = ($x1, $x0);
            ($y0, $y1) = ($y1, $y0);
        }
        my $Δx = $x1 - $x0;
        my $Δy = abs($y1 - $y0);
        my $error = 0;
        my $Δerror = $Δy / $Δx;
        my $y-step = $y0 < $y1 ?? 1 !! -1;
        my $y = $y0;
        for $x0 .. $x1 -> $x {
            if $steep {
                self.set-pixel($y, $x, $pix);
            } else {
                self.set-pixel($x, $y, $pix);
            }
            $error += $Δerror;
            if $error >= 0.5 {
                $y += $y-step;
                $error -= 1.0;
            }
        }
    }

    method dot (($px, $py), $pix, $radius = 2) {
        for $px - $radius .. $px + $radius -> $x {
            for $py - $radius .. $py + $radius -> $y {
                self.set-pixel($x, $y, $pix) if ( $px - $x + ($py - $y) * i ).abs <= $radius;
            }
        }
    }

    method quadratic ( ($x1, $y1), ($x2, $y2), ($x3, $y3), $pix, $segments = 30 ) {
        my @line-segments = map -> $t {
            my \a = (1-$t)²;
            my \b = $t * (1-$t) * 2;
            my \c = $t²;
            (a*$x1 + b*$x2 + c*$x3).round(1),(a*$y1 + b*$y2 + c*$y3).round(1)
        }, (0, 1/$segments, 2/$segments ... 1);
        for @line-segments.rotor(2=>-1) -> ($p1, $p2) { self.line( $p1, $p2, $pix) };
    }

    method data { @!data }
}

role PPM {
    method P6 returns Blob {
	"P6\n{self.width} {self.height}\n255\n".encode('ascii')
	~ Blob.new: flat map { .R, .G, .B }, self.data
    }
}

sub color( $r, $g, $b) { Pixel.new(R => $r, G => $g, B => $b) }

my Bitmap $b = Bitmap.new( width => 600, height => 400) but PPM;

$b.fill( color(2,2,2) );

my @points = (65,25), (85,380), (570,15);

my %seen;
my $c = 0;
for @points.permutations -> @this {
    %seen{@this.reverse.join.Str}++;
    next if %seen{@this.join.Str};
    $b.quadratic( |@this, color(255-$c,127,$c+=80) );
}

@points.map: { $b.dot( $_, color(255,0,0), 3 )}

$*OUT.write: $b.P6;


from PIL import Image

# Open the image
image = Image.open("lena.jpg")
# Get the width and height of the image
width, height = image.size
# Calculate the amount of pixels
amount = width * height

# Total amount of greyscale
total = 0
# B/W image
bw_image = Image.new('L', (width, height), 0)
# Bitmap image
bm_image = Image.new('1', (width, height), 0)

for h in range(0, height):
    for w in range(0, width):
        r, g, b = image.getpixel((w, h))

        greyscale = int((r + g + b) / 3)
        total += greyscale

        bw_image.putpixel((w, h), gray_scale)

# The average greyscale
avg = total / amount

black = 0
white = 1

for h in range(0, height):
    for w in range(0, width):
        v = bw_image.getpixel((w, h))

        if v >= avg:
            bm_image.putpixel((w, h), white)
        else:
            bm_image.putpixel((w, h), black)

bw_image.show()
bm_image.show()


 #lang racket
(require racket/draw math/statistics racket/require
         (filtered-in
          (lambda (name) (regexp-replace #rx"unsafe-" name ""))
          racket/unsafe/ops))

;; CIE formula as discussed in "Greyscale image" task
(define (L r g b)
  ;; In fact there is no need, statistically for L to be divided by 10000
  (fx+ (fx* r 2126) (fx+ (fx* g 7152) (fx* b 722))))

(define (prepare-bytes bm depth load-content?)
  (define w (send bm get-width))
  (define h (send bm get-height))
  (define rv (make-bytes (* w h depth)))
  (define just-alpha? #f)
  (define pre-multiply? #t); let racket cope with alpha-ness
  (when load-content? (send bm get-argb-pixels 0 0 w h rv just-alpha? pre-multiply?))
  rv)

(define (bitmap-histogram bm)
  (unless (send bm is-color?) (error 'bitmap->histogram "bitmap must be colour"))
  (define pxls (prepare-bytes bm 4 #t))
  (define l# (make-hash))
  (for ((r (in-bytes pxls 1 #f 4)) (g (in-bytes pxls 2 #f 4)) (b (in-bytes pxls 3 #f 4)))
    (hash-update! l# (L r g b) add1 0))
  (define xs (hash-keys l#))   ; the colour values
  (define ws (hash-values l#)) ; the "weights" i.e. counts for median
  (values xs ws))

(define (bitmap-quantile q bm (hist-xs #f) (hist-ws #f))
  (define-values (xs ws) (if (and hist-xs hist-ws)
                             (values hist-xs hist-ws)
                             (bitmap-histogram bm)))
  (quantile q < xs ws))

;; we don't return a 1-depth bitmap, so we can do more interesting things with colour
(define (bitmap->monochrome q bm (hist-xs #f) (hist-ws #f))
  (define Q (bitmap-quantile q bm hist-xs hist-ws))
  (define pxls (prepare-bytes bm 4 #t))
  (for ((r (in-bytes pxls 1 #f 4))
        (g (in-bytes pxls 2 #f 4))
        (b (in-bytes pxls 3 #f 4))
        (i (sequence-map (curry fx* 4) (in-naturals))))
    (define l (L r g b))
    (define rgb+ (cond [(fx< l Q) 0] [else 255]))
    (bytes-set! pxls (fx+ i 1) rgb+)
    (bytes-set! pxls (fx+ i 2) rgb+)
    (bytes-set! pxls (fx+ i 3) rgb+))
  (define w (send bm get-width))
  (define h (send bm get-height))
  (define rv (make-bitmap w h #f))
  (send rv set-argb-pixels 0 0 w h pxls)
  rv)

(module+ main
  (define bm (read-bitmap "271px-John_Constable_002.jpg"))
  (define-values (xs ws) (bitmap-histogram bm))
  (void
   (send (bitmap->monochrome 1/4 bm) save-file "histogram-racket-0.25.png" 'png)
   (send (bitmap->monochrome 1/2 bm) save-file "histogram-racket-0.50.png" 'png) ; median
   (send (bitmap->monochrome 3/4 bm xs ws) save-file "histogram-racket-0.75.png" 'png)))


class Pixel { has UInt ($.R, $.G, $.B) }
class Bitmap {
    has UInt ($.width, $.height);
    has Pixel @.data;
}

role PBM {
    has @.BM;
    method P4 returns Blob {
	"P4\n{self.width} {self.height}\n".encode('ascii')
	~ Blob.new: self.BM
    }
}

sub getline ( $fh ) {
    my $line = '#'; # skip comments when reading image file
    $line = $fh.get while $line.substr(0,1) eq '#';
    $line;
}

sub load-ppm ( $ppm ) {
    my $fh    = $ppm.IO.open( :enc('ISO-8859-1') );
    my $type  = $fh.&getline;
    my ($width, $height) = $fh.&getline.split: ' ';
    my $depth = $fh.&getline;
    Bitmap.new( width => $width.Int, height => $height.Int,
      data => ( $fh.slurp.ords.rotor(3).map:
        { Pixel.new(R => $_[0], G => $_[1], B => $_[2]) } )
    )
}

sub grayscale ( Bitmap $bmp ) {
    map { (.R*0.2126 + .G*0.7152 + .B*0.0722).round(1) min 255 }, $bmp.data;
}

sub histogram ( Bitmap $bmp ) {
    my @gray = grayscale($bmp);
    my $threshold = @gray.sum / @gray;
    for @gray.rotor($bmp.width) {
        my @row = $_.list;
        @row.push(0) while @row % 8;
        $bmp.BM.append: @row.rotor(8).map: { :2(($_ X< $threshold)».Numeric.join) }
    }
}

my $filename = './Lenna.ppm';

my Bitmap $b = load-ppm( $filename ) but PBM;

histogram($b);

'./Lenna-bw.pbm'.IO.open(:bin, :w).write: $b.P4;


100 PROGRAM "Compass.bas"
110 STRING DR$(1 TO 33)*18
120 FOR I=1 TO 33
130   READ DR$(I)
140 NEXT
150 DO
160   READ IF MISSING EXIT DO:D
170   LET DIR=COMP(D)
180   PRINT D;TAB(12);DIR,DR$(DIR)
190 LOOP
200 DEF COMP(D)=CEIL(MOD((D+360/64),360)*32/360)
210 DATA 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
220 DATA 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
230 DATA 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


require'strings'
subs=: 'N,north,S,south,E,east,W,west,b, by ,'
dirs=: subs ([email protected]{., }.)@rplc~L:1 0&(<;._2) 0 :0 -. ' ',LF
  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,
)
indice=: 32 | 0.5 <[email protected]+ %&11.25
deg2pnt=: dirs {~ indice


/*  for symmetry with Kotlin's other binary bitwise operators
    we wrap Java's 'rotate' methods as infix functions */
infix fun Int.rol(distance: Int): Int = Integer.rotateLeft(this, distance)
infix fun Int.ror(distance: Int): Int = Integer.rotateRight(this, distance)

fun main(args: Array<String>) {
    // inferred type of x and y is Int i.e. 32 bit signed integers
    val x = 10
    val y = 2
    println("x       = $x")
    println("y       = $y")
    println("NOT x   = ${x.inv()}")
    println("x AND y = ${x and y}")
    println("x OR  y = ${x or y}")
    println("x XOR y = ${x xor y}")
    println("x SHL y = ${x shl y}")
    println("x ASR y = ${x shr y}")   // arithmetic shift right (sign bit filled)
    println("x LSR y = ${x ushr y}")  // logical shift right    (zero filled)
    println("x ROL y = ${x rol y}")
    println("x ROR y = ${x ror y}")
}


(defun bitwise (a b)
  (lists:map
    (lambda (x) (io:format "~p~n" `(,x)))
    `(,(band a b)
      ,(bor a b)
      ,(bxor a b)
      ,(bnot a)
      ,(bsl a b)
      ,(bsr a b)))
  'ok)

(defun dec->bin (x)
  (integer_to_list x 2))

(defun describe (func arg1 arg2 result)
  (io:format "(~s ~s ~s): ~s~n"
             (list func (dec->bin arg1) (dec->bin arg2) (dec->bin result))))

(defun bitwise
  ((a b 'binary)
    (describe "band" a b (band a b))
    (describe "bor" a b (bor a b))
    (describe "bxor" a b (bxor a b))
    (describe "bnot" a b (bnot a))
    (describe "bsl" a b (bsl a b))
    (describe "bsr" a b (bsr a b))))


Define cubic(p1,p2,p3,segs) = Prgm
  Local i,t,u,prev,pt
  0 → pt
  For i,1,segs+1
    (i-1.0)/segs → t   © Decimal to avoid slow exact arithetic
    (1-t) → u
    pt → prev
    u^2*p1 + 2*t*u*p2 + t^2*p3 → pt
    If i>1 Then
      PxlLine floor(prev[1,1]), floor(prev[1,2]), floor(pt[1,1]), floor(pt[1,2])
    EndIf
  EndFor
EndPrgm


class Pixmap
  def histogram
    histogram = Hash.new(0)
    @height.times do |y|
      @width.times do |x|
        histogram[self[x,y].luminosity] += 1
      end
    end
    histogram
  end

  def to_blackandwhite
    hist = histogram

    # find the median luminosity
    median = nil
    sum = 0
    hist.keys.sort.each do |lum|
      sum += hist[lum]
      if sum > @height * @width / 2
        median = lum
        break
      end
    end

    # create the black and white image
    bw = self.class.new(@width, @height)
    @height.times do |y|
      @width.times do |x|
        bw[x,y] = self[x,y].luminosity < median ? RGBColour::BLACK : RGBColour::WHITE
      end
    end
    bw
  end

  def save_as_blackandwhite(filename)
    to_blackandwhite.save(filename)
  end
end

Pixmap.open('file.ppm').save_as_blackandwhite('file_bw.ppm')