-- Wedges.mesa
-- m.stone October 2, 1980  12:36 PM
-- Last edit by Doug Wyatt, 17-Aug-81 12:06:55

DIRECTORY
  BitBlt USING [AlignedBBTable, BBptr, BBTableSpace, BITBLT],
  ColorDisplay,
  JaMFnsDefs USING [GetReal, PopInteger, Register],
  Real,
  RealFns;

Wedges: PROGRAM
IMPORTS BitBlt, ColorDisplay, JaMFnsDefs, RealFns, Real = {

bbspace: BitBlt.BBTableSpace;
bb: BitBlt.BBptr _ BitBlt.AlignedBBTable[@bbspace];

bitmap: LONG POINTER _ NIL;
wpl: CARDINAL _ 0;
xSize,ySize: [0..LAST[INTEGER]];

ClipAndRotate: PROC[lx,ty,rx,by: INTEGER] RETURNS[x,y,w,h: CARDINAL] = {
  lx _ MAX[lx,0]; ty _ MAX[ty,0];
  rx _ MIN[rx,xSize]; by _ MIN[by,ySize];
  IF rx>lx AND by>ty THEN RETURN[ySize-by,lx,by-ty,rx-lx]
  ELSE RETURN[0,0,0,0];
  };

Oops: SIGNAL = CODE;

Rect: PROC[pix,lx,ty,rx,by: INTEGER] = {
  --Rectangle[pix,ty,MAX[0,xSize-rx],by,MAX[0,xSize-lx]];
  Rectangle[pix,lx,ty,rx,by];
  };

Rectangle: PROC[pix,lx,ty,rx,by: CARDINAL] = {
  xlim: CARDINAL = ColorDisplay.width;
  ylim: CARDINAL = ColorDisplay.height;
  source: CARDINAL _ 256*pix + pix;
  dbit: [0..16);
  x,y,w,h: CARDINAL;
  [x,y,w,h] _ ClipAndRotate[lx,ty,rx,by];
  IF w=0 OR h=0 THEN RETURN;
  dbit _ 8*(x MOD 2);
  bb^ _ [
    dst: [word: bitmap + LONG[y]*wpl + x/2, bit: dbit],
    dstBpl: 16*wpl,
    src: [word: @source, bit: dbit],
    srcDesc: [gray[[yOffset: 0, widthMinusOne: 0, heightMinusOne: 0]]],
    width: 8*w, height: h,
    flags: [disjoint: TRUE, gray: TRUE]
    ];
  IF NOT(x IN[0..xlim) AND y IN[0..ylim)
   AND (x+w)<=xlim AND (y+h)<=ylim) THEN { SIGNAL Oops; RETURN };
  BitBlt.BITBLT[bb];
  };

HalfTone: PROC[pixa,pixb,lx,ty,rx,by: CARDINAL] = {
  source: ARRAY[0..2) OF CARDINAL _ [256*pixa + pixb, 256*pixb + pixa];
  dbit: [0..16);
  yoff: [0..2);
  x,y,w,h: CARDINAL;
  [x,y,w,h] _ ClipAndRotate[lx,ty,rx,by];
  IF w=0 OR h=0 THEN RETURN;
  dbit _ 8*(x MOD 2);
  yoff _ y MOD 2;
  bb^ _ [
    dst: [word: bitmap + LONG[y]*wpl + x/2, bit: dbit],
    dstBpl: 16*wpl,
    src: [word: @source + yoff, bit: dbit],
    srcDesc: [gray[[yOffset: yoff, widthMinusOne: 0, heightMinusOne: 1]]],
    width: 8*w, height: h,
    flags: [disjoint: TRUE, gray: TRUE]
    ];
  BitBlt.BITBLT[bb];
  };


black: CARDINAL = 253;
middl: CARDINAL = 254;
white: CARDINAL = 255;
mortar: CARDINAL = 252;

SetColor: PROC[n: CARDINAL, r,g,b: [0..256)] = INLINE { ColorDisplay.SetColor[n,0,r,g,b] };

SetUpColorMap: PROC = {
  base: REAL _ RealFns.SqRt[2];
  value: REAL _ base;
  x,v: INTEGER;
  -- set background color
  SetColor[0, background, background, background];
  --make the colormap [1-16] logarithmic grey
  FOR x IN [1..16] DO
    v _ Real.RoundI[value];
    IF v = 256 THEN v _ 255;
    SetColor[x, v, v, v];
  --IODefs.WriteDecimal[v];
  --IODefs.WriteChar[' ];
    value _ value*base;
    ENDLOOP;
--IODefs.WriteLine[" "];
  --make the colormap [17..32] compensated logarithmic grey
  value _ base;
  FOR x IN [17..32] DO
    v _ Real.RoundI[Comp[value]];
    SetColor[x, v, v, v];
  --IODefs.WriteDecimal[v];
  --IODefs.WriteChar[' ];
    value _ value*base;
    ENDLOOP;
--IODefs.WriteLine[" "];
  --make the colormap [33-48] linear grey
  v _ 15;
  FOR x IN [33..48] DO
    SetColor[x, v, v, v];
  --IODefs.WriteDecimal[v];
  --IODefs.WriteChar[' ];
    v _ v + 16;
    ENDLOOP;
--IODefs.WriteLine[" "];
  --make the colormap [49..64] compensated linear grey
  v _ 15;
  FOR x IN [49..64] DO
    n: CARDINAL _ Real.RoundI[Comp[v]];
    SetColor[x, n, n, n];
  --IODefs.WriteDecimal[n];
  --IODefs.WriteChar[' ];
    v _ v + 16;
    ENDLOOP;
  v _ Real.RoundI[Comp[level]];
  SetColor[black, 0,0,0];
  SetColor[middl, v,v,v];
  SetColor[white, 255, 255, 255];
  SetColor[mortar, 127,127,127];
  };

ShowWedges: PROCEDURE = {
  nsteps: CARDINAL = 16;
  hsteps: CARDINAL = 23;
  bwidth: INTEGER _ xSize/nsteps;
  h: INTEGER _ ySize/hsteps; -- height unit
  bheight: INTEGER _ 4*h; -- band height
  width: INTEGER _ nsteps*bwidth;
  height: INTEGER _ hsteps*h;
  leftX: INTEGER _ (xSize - width)/2;
  topY: INTEGER _ (ySize - height)/2;
  lx, ty: INTEGER;
  base: REAL _ RealFns.SqRt[2];  --2^1/2
  SetUpColorMap[];
  ClearScreen[];
--IODefs.WriteLine[" "];
  --draw the log grey scale
  lx _ leftX;
  ty _ topY + h;
  FOR x: CARDINAL IN [1..16] DO
    Rectangle[x, lx, ty, lx + bwidth, ty + bheight];
    lx _ lx + bwidth;
    ENDLOOP;
  lx _ leftX;
  ty _ ty + bheight + h/2;
  --draw the compensated log grey scale
  FOR x: CARDINAL IN [17..32] DO
    Rectangle[x, lx, ty, lx + bwidth, ty + bheight];
    lx _ lx + bwidth;
    ENDLOOP;
  --draw the linear grey scale
  lx _ leftX;
  ty _ ty + bheight + h;
  FOR x: CARDINAL IN [33..48] DO
    Rectangle[x, lx, ty, lx + bwidth, ty + bheight];
    lx _ lx + bwidth;
    ENDLOOP;
  lx _ leftX;
  ty _ ty + bheight + h/2;
  FOR x: CARDINAL IN [49..64] DO
    Rectangle[x, lx, ty, lx + bwidth, ty + bheight];
    lx _ lx + bwidth;
    ENDLOOP;
  ty _ ty + bheight + h;
  HalfTone[black, white, leftX, ty, leftX + width, ty + 2*h];
  };

background: CARDINAL _ 0;
ClearScreen: PROCEDURE = {
  Rectangle[0, 0, 0, xSize, ySize];
  };

level: INTEGER _ 128;
screen: CARDINAL _ 125B;
ShowBlocks: PROCEDURE = {
  lx, ty: CARDINAL;
  ClearScreen[];
  lx _ 100;
  ty _ 120;
  Rectangle[middl, lx, ty, lx + 200, ty + 300];
  lx _ lx + 200;
  HalfTone[black, white, lx, ty, lx + 200, ty + 300]; -- screen value currently ignored
  };

  b: CARDINAL _ 100;
  w: CARDINAL _ 100;
  d: CARDINAL _ 50;
  h: CARDINAL _ 80;
  m: CARDINAL _ 2;

ShowIllusion: PROC = {
  x,y: CARDINAL _ 0;
  flag: BOOLEAN _ FALSE;
  WHILE y<ySize DO
    x _ 0;
    IF flag THEN { Rect[white,x,y,x+d,y+h]; x _ x+d };
    WHILE x<xSize DO
      Rect[black,x,y,x+b,y+h]; x _ x+b;
      Rect[white,x,y,x+w,y+h]; x _ x+w;
      ENDLOOP;
    Rect[mortar,0,y+h,xSize,y+h+m];
    y _ y+h+m; flag _ NOT flag;
    ENDLOOP;
  };

ShowCorners: PROCEDURE = {
  s: CARDINAL = 8;
  Rectangle[white,       0,       0,     s,     s];
  Rectangle[white, xSize-s,       0, xSize,     s];
  Rectangle[white,       0, ySize-s,     s, ySize];
  Rectangle[white, xSize-s, ySize-s, xSize, ySize];
  };

gamma: REAL _ 1.0/2.3;
Comp: PROCEDURE [intensity: REAL] RETURNS [REAL] = {
  intensity _ intensity/255;
  intensity _ RealFns.Power[intensity, gamma];
  RETURN[intensity*255];
  };

SetGamma: PROC = {
  r: REAL _ JaMFnsDefs.GetReal[];
  gamma _ 1/MAX[1.1,r];
  SetUpColorMap[];
  };

SetLevel: PROC = {
  i: INTEGER _ JaMFnsDefs.PopInteger[];
  level _ MAX[0,MIN[i,255]];
  SetUpColorMap[];
  };

SetMortar: PROC = {
  i: INTEGER _ JaMFnsDefs.PopInteger[];
  m: [0..256) _ MAX[0,MIN[i,255]];
  SetColor[mortar,m,m,m];
  };

SetB: PROC = {
  i: INTEGER _ JaMFnsDefs.PopInteger[];
  b _ MAX[1,MIN[i,1000]]; ShowIllusion[];
  };

SetW: PROC = {
  i: INTEGER _ JaMFnsDefs.PopInteger[];
  w _ MAX[1,MIN[i,1000]]; ShowIllusion[];
  };

SetD: PROC = {
  i: INTEGER _ JaMFnsDefs.PopInteger[];
  d _ MAX[0,MIN[i,1000]]; ShowIllusion[];
  };

SetH: PROC = {
  i: INTEGER _ JaMFnsDefs.PopInteger[];
  h _ MAX[1,MIN[i,1000]]; ShowIllusion[];
  };

SetM: PROC = {
  i: INTEGER _ JaMFnsDefs.PopInteger[];
  m _ MAX[0,MIN[i,1000]]; ShowIllusion[];
  };

SetBackground: PROC = {
  r: REAL _ JaMFnsDefs.GetReal[];
  background _ Real.RoundI[Comp[MAX[0,MIN[r,255]]]];
  SetUpColorMap[];
  };

Real.InitReals[];
IF NOT ColorDisplay.SetMode[[full: FALSE, bitsPerPixelA: 8, bitsPerPixelB: 0]] THEN ERROR;
bitmap _ ColorDisplay.baseA;
wpl _ ColorDisplay.wplA;
-- Note: assume display is on its side
xSize _ ColorDisplay.height;
ySize _ ColorDisplay.width;

ClearScreen[];
SetUpColorMap[];
ColorDisplay.TurnOn[];

JaMFnsDefs.Register[".wedges"L, ShowWedges];
JaMFnsDefs.Register[".blocks"L, ShowBlocks];
JaMFnsDefs.Register[".clearscreen"L, ClearScreen];
JaMFnsDefs.Register[".setgamma"L, SetGamma];
JaMFnsDefs.Register[".setlevel"L, SetLevel];
JaMFnsDefs.Register[".setmortar"L, SetMortar];
JaMFnsDefs.Register[".setbackground"L, SetBackground];
JaMFnsDefs.Register[".corners"L, ShowCorners];
JaMFnsDefs.Register[".illusion"L, ShowIllusion];
JaMFnsDefs.Register[".setb"L, SetB];
JaMFnsDefs.Register[".setw"L, SetW];
JaMFnsDefs.Register[".setd"L, SetD];
JaMFnsDefs.Register[".seth"L, SetH];
JaMFnsDefs.Register[".setm"L, SetM];

}.