(*******************************************************************)
(** Release history:                                              **)
(**    17th January 1985   version 1.0.0 First port to new world  **)
(*******************************************************************)
IMPLEMENTATION MODULE BBC;
(*
    Title:   BBC Device driver
    LastEdit:   Tue Jan  8 15:43:38 1985
    Author:   Graham Toal
    Acorn Computers VLSI Design Aids Group
*)
IMPORT Defaults;
IMPORT Dict;
IMPORT FileStream;
IMPORT Polysys;
IMPORT Streams;
IMPORT Strings;
(*IMPORT dbgstore;  (* init, chalkup, analysis, logging;                  *)*)
IMPORT rawBBC;
IMPORT SysStreams;
FROM WriteF IMPORT WriteF0, WriteF1, WriteF2, WriteF3, WriteF4,
  H, S, R, FormatKey;
FROM TextIO IMPORT NumberBase,
  ReadCHAR, ReadINTEGER, ReadCARDINAL, ReadBOOLEAN,
  ReadREAL, ReadChars, ReadString, WhiteSpace, EndOfLine, TermProc,
  ReadBasedCARDINAL, ReadBITSET,
  WriteCHAR, NewLine, WriteINTEGER, WriteCARDINAL, WriteBOOLEAN,
  WriteREAL, WriteBasedCARDINAL, WriteChars, WriteString, WriteBITSET;
FROM ScanS IMPORT ParseF0, ParseF1, ParseF2, ParseF3, ParseF4;
FROM MULDIV IMPORT Muldiv;
FROM BBCStar IMPORT IssueStarCommand;
FROM Dict IMPORT DICT, KeyAttr, KeyMatchOptions;
FROM Graphics IMPORT GSTREAM, COLOUR, TEXT, MARKER, CURSOR,
  gstream, colour, text, marker, cursor;
FROM GraphicsIP IMPORT gstreamIP, colourIP, textIP, markerIP, cursorIP,
  DeviceDriver;
FROM Polysys IMPORT POLYGON;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM Strings IMPORT String;
FROM SYSTEM IMPORT WORD;
TYPE
  DrawType = (AreaFill, Outline);
  BBCTextHook = POINTER TO RECORD
    Temp: INTEGER
  END;
  BBCMarkerHook = POINTER TO RECORD
    Temp: INTEGER
  END;
  BBCCursorHook = POINTER TO RECORD
    Temp: INTEGER
  END;
  OutlineColour = POINTER TO RECORD
    Name: String;
    Colour: [0..3] (* Why was this 1.. once???                              *)
  END;
  AreaColour = POINTER TO RECORD
    Name: String;
    NW, NE, SW, SE: [0..3]
  END;
(*--------------------------------------------------------------------------*)
(*  ColourHook: contains two sets of information to be                      *)
(*  returned when asked for a colour: 1) the colour                         *)
(*  to be used when drawing lines, and 2) The drawing                       *)
(*  style(filled or outlined) and colours to be used                        *)
(*  when drawing coherent polygons.                                         *)
(*--------------------------------------------------------------------------*)
  BBCColourHook = POINTER TO RECORD
    LineColour: [0..3];
    CASE How: DrawType OF
    (*|*) AreaFill:
      AreaFill: AreaColour
    | Outline:
      Outline: OutlineColour
    END
  END;
  BBCDeviceState = POINTER TO RECORD
    TXl, TYb, TXr, TYt: INTEGER; (* Text window                             *)
    WXl, WYb, WXr, WYt: INTEGER; (* Graphics window                         *)
    mode: INTEGER;   (* Global environment data                             *)
  END;            (* not kept anywhere else                                 *)
VAR
  Debugging, (* FALSE unless changed by 'Command' interface                 *)
  VirginDebug,
  Dormant: BOOLEAN; (* TRUE until first call to open an BBC stream,
                   at which point all the BBC control structures
                   are built.                                               *)
  DefaultColour: BBCColourHook;
  DefaultText: BBCTextHook;
  DefaultCursor: BBCCursorHook;
  DefaultOutlineColour: OutlineColour;
  DefaultLineColour: INTEGER;
  DefaultAreaColour: AreaColour;
  BBCTextStyle, (* DICT  [StyleName] OF TEXT                                *)
  BBCCursor, (* DICT [CursorName] OF CURSOR                                 *)
  BBCMarker, (* DICT [MarkerName] OF MARKER                                 *)
  BBCStipple, (* DICT [ColourName] OF AreaColour                            *)
  BBCColour, (* DICT [ColourName] OF[0..3]                                  *)
  BBCOutlineColour, (* DICT  [LayerName] OF OutlineColour*)
  BBCAreaFillColour, (* DICT  [LayerName] OF AreaColour                     *)
  BBCMaster            (* DICT  [DictName] OF DICT                          *)
: DICT;

(*--------------------------------------------------------------------------*)
(*  TYPE CASTS: The only type casts allowed in this code are                *)
(*    xxxIP( Implementation: xxx )                                          *)
(* & BBCxxxHook(DeviceHook: WORD)                                           *)
(*--------------------------------------------------------------------------*)

(*--------------------------------------------------------------------------*)
(*              DEBUGGING PROCEDURES                                        *)
(*--------------------------------------------------------------------------*)

  PROCEDURE PrintBBCColour(VAR Key: ARRAY OF CHAR; Val: WORD;
    VAR Count: WORD): BOOLEAN;
  CONST AndContinue = FALSE;
  BEGIN
    WriteF2(SysStreams.sysErr, "device colour %S = %I\N", H(Key), Val);
    Count := WORD(INTEGER(Count)+1);
    RETURN(AndContinue)
  END PrintBBCColour;

  PROCEDURE PrintOutlineColour(VAR Key: ARRAY OF CHAR; Val: WORD;
    VAR Count: WORD): BOOLEAN;
  VAR Outline: OutlineColour;
  CONST AndContinue = FALSE;
  BEGIN
    Outline := OutlineColour(Val);
    WriteF2(SysStreams.sysErr, "outline colour %S = %I\N",
     H(Key), Outline^.Colour);
    Count := WORD(INTEGER(Count)+1);
    RETURN(AndContinue)
  END PrintOutlineColour;

  PROCEDURE PrintAreaColour(VAR Key: ARRAY OF CHAR; Val: WORD;
    VAR Count: WORD): BOOLEAN;
  VAR Area: AreaColour;
  CONST AndContinue = FALSE;
  BEGIN
    Area := AreaColour(Val);
    WriteF2(SysStreams.sysErr, "area colour %S = %S\N",
     H(Key), S(Area^.Name));
    Count := WORD(INTEGER(Count)+1);
    RETURN(AndContinue)
  END PrintAreaColour;

PROCEDURE DebugLineColours();
VAR Total: INTEGER;
BEGIN
  Total := 0; IF Dict.ForAllIn(BBCColour, PrintBBCColour, Total) THEN END;
  WriteF1(SysStreams.sysErr, "Total = %I\N", Total)
END DebugLineColours;

PROCEDURE DebugOutlineColours();
VAR Total: INTEGER;
BEGIN
  Total := 0;
  IF Dict.ForAllIn(BBCOutlineColour, PrintOutlineColour, Total) THEN END;
  WriteF1(SysStreams.sysErr, "Total = %I\N", Total);
END DebugOutlineColours;

PROCEDURE DebugStipple();
VAR Total: INTEGER;
BEGIN
  WriteF1(SysStreams.sysErr, "Stipples:\N", 0);
  Total := 0;
  IF Dict.ForAllIn(BBCStipple, PrintAreaColour, Total) THEN END;
  WriteF1(SysStreams.sysErr, "Total = %I\N", Total);
END DebugStipple;

PROCEDURE DebugAreaColours();
VAR Total: INTEGER;
BEGIN
  Total := 0;
  IF Dict.ForAllIn(BBCAreaFillColour, PrintAreaColour, Total) THEN END;
  WriteF1(SysStreams.sysErr, "Total = %I\N", Total);
END DebugAreaColours;

(*--------------------------------------------------------------------------*)
(*               INTERNAL PROCEDURES                                        *)
(*--------------------------------------------------------------------------*)
PROCEDURE Readln(PromptStr: ARRAY OF CHAR; VAR Line: ARRAY OF CHAR);
VAR Ch: CHAR;
  Next: CARDINAL;
BEGIN
  WriteF0(SysStreams.sysOut, PromptStr);
  Streams.Flush(SysStreams.sysOut);
  Next := 0;
  LOOP
    Ch := CHAR(Streams.Get(SysStreams.sysIn));
    IF SysStreams.sysIn^.status <> Streams.Success THEN EXIT END;
    IF ORD(Ch)<32 THEN EXIT END;
    Line[Next] := Ch;
    Next := Next+1
  END;
  Line[Next] := CHR(0);
END Readln;

VAR BBCDriver: gstreamIP;
(*--------------------------------------------------------------------------*)
PROCEDURE ColourVal(Colour: String): INTEGER; (*******CRASH if not found    *)
VAR BBCColourNo: INTEGER;
BEGIN
  IF Dict.Found(BBCColour, Colour, BBCColourNo) THEN
    RETURN(BBCColourNo)
  END;
END ColourVal;
(*--------------------------------------------------------------------------*)
PROCEDURE OutlineVal(Colour: ARRAY OF CHAR): OutlineColour;
VAR Outline: OutlineColour; (**************** CRASH if not found **********)
  ColourS: String;
BEGIN
  ColourS := Strings.CopyCS(Colour);
  IF Dict.Found(BBCOutlineColour, ColourS, Outline) THEN
    Strings.Dispose(ColourS);
    RETURN(Outline)
  END;
END OutlineVal;
(*--------------------------------------------------------------------------*)
PROCEDURE AreaVal(Colour: ARRAY OF CHAR): AreaColour;
VAR Area: AreaColour; (******************* CRASH if not found **********)
  ColourS: String;
BEGIN
  ColourS := Strings.CopyCS(Colour);
  IF Dict.Found(BBCAreaFillColour, ColourS, Area) THEN
    Strings.Dispose(ColourS);
    RETURN(Area)
  END;
END AreaVal;
(*--------------------------------------------------------------------------*)
CONST Internal = TRUE; External = FALSE;
PROCEDURE MixColours(colourName, primaryList: ARRAY OF CHAR;
  internal: BOOLEAN);
VAR cs0, cs1, cs2, cs3: String;
  mix: AreaColour;
  sourceS: String;
BEGIN
  sourceS := Strings.CopyCS(primaryList);
  IF NOT ParseF4("^@,* ^@,* ^@,* ^@", sourceS,
   "%^0", cs0, "%^1", cs1, "%^2", cs2, "%^3", cs3) THEN
    IF internal THEN
      WriteF0(SysStreams.sysErr, "MixColours: stipple format faulty\N");
    ELSE
      IF Debugging THEN
        WriteF1(SysStreams.sysErr, "Invalid stipple definition: %S\N",
         S(sourceS))
      END
    END
  ELSE
    NEW(mix); WITH mix^ DO
      NW := ColourVal(cs0); NE := ColourVal(cs1);
      SW := ColourVal(cs2); SE := ColourVal(cs3);
      Name := Strings.CopyCS(colourName);
    END;
    Strings.Dispose(cs0); Strings.Dispose(cs1);
    Strings.Dispose(cs2); Strings.Dispose(cs3);
    Dict.Enter(BBCStipple, colourName, KeyAttr{}, mix)
  END;
  Strings.Dispose(sourceS);
END MixColours;

(*--------------------------------------------------------------------------*)
(*  The following block are procedures compatible with type Dict.CSCANPROC*)
(*  and are used below when translating from user-supplied string tables    *)
(*  into tokenised tables for later look-up.                                *)
(*--------------------------------------------------------------------------*)

PROCEDURE ScanColour(VAR fullKey: ARRAY OF CHAR; item: WORD;
  VAR environParam: WORD): BOOLEAN;
BEGIN

END ScanColour;

PROCEDURE ScanStipple(VAR fullKey: ARRAY OF CHAR; item: WORD;
  VAR environParam: WORD): BOOLEAN;
BEGIN

END ScanStipple;

PROCEDURE ScanOutline(VAR fullKey: ARRAY OF CHAR; item: WORD;
  VAR environParam: WORD): BOOLEAN;
BEGIN

END ScanOutline;

PROCEDURE ScanAreaFill(VAR fullKey: ARRAY OF CHAR; item: WORD;
                VAR environParam: WORD): BOOLEAN;
BEGIN

END ScanAreaFill;

(*--------------------------------------------------------------------------*)

PROCEDURE ReConfigure();
  PROCEDURE Find(VAR dict: DICT;  dictName: ARRAY OF CHAR): BOOLEAN;
  VAR dictS: String; success: BOOLEAN;
  BEGIN
    dictS := Strings.CopyCS(dictName);
    success := Dict.FoundWith(KeyAttr{ExactLength},
     Defaults.Contents, dictS, dict);
    Strings.Dispose(dictS);
    RETURN(success)
  END Find;
  VAR tempColour, tempStipple, tempOutline, tempAreaFill: DICT;
    Env: WORD;
BEGIN
(* The following dicts need to be treated:-                                 *)
(* integers-leave alone                                                     *)
(* strings -leave alone                                                     *)
(* text   -unused                                                           *)
(* colour  -convert strings to integers via lookup                          *)
(*:  BBCColour                                                              *)

(* For all in "colour", check that values are in range 0..3                 *)
(* then take "default" and insert value into appropriate variable           *)
(* finally, remove dict "colour'" and re-build from "colour"                *)
(* don't forget to remove "default" from "colour".                          *)
  IF Find(tempColour, "colour") THEN
    IF Dict.ForAllIn(tempColour, ScanColour, Env) THEN END;
(* Tidy-up and rename here                                                  *)
  END;

(* stipple -parse into colours & mix                                        *)
(*:  BBCStipple                                                             *)
(************ MIXCOLOURS HERE *************)
(* mixColours(External, Key, Val)                                           *)
  IF Find(tempStipple, "stipple") THEN
    IF Dict.ForAllIn(tempStipple, ScanColour, Env) THEN END;
  END;
(* Tidy-up and rename here                                                  *)

(* outline -convert to pointers to "Colour"s via table                      *)
(*:  BBCOutlineColour                                                       *)
(* PROCEDURE DefOutline(LayerName, ColourName: ARRAY OF CHAR);
  VAR Outline: OutlineColour;
     ColourNameSTR: String;
  BEGIN
    ColourNameSTR := Strings.CopyCS(ColourName);
    NEW(Outline);
    IF Dict.FoundWith(KeyAttr{ExactLength},
                 BBCColour, ColourNameSTR, Outline^.Colour) THEN
      Outline^.Name := ColourNameSTR
(* DO NOT dispose ColourNameSTR when leaving in dictionary                  *)
    ELSE
(* Soft error???                                                            *)
      Strings.Dispose(ColourNameSTR);
      Outline := DefaultOutlineColour
    END;
    Dict.Enter(BBCOutlineColour, LayerName, KeyAttr{}, Outline)
  END DefOutline;
*)
  IF Find(tempOutline, "outline") THEN
    IF Dict.ForAllIn(tempOutline, ScanColour, Env) THEN END;
  END;
(* Tidy-up and rename here                                                  *)

(* areafill-convert to stipple tokens                                       *)
(*:  BBCAreaFillColour                                                      *)
(*PROCEDURE DefArea(LayerName, ColourName: ARRAY OF CHAR);
  VAR AreaFillColour: AreaColour; ColourS: String;
  BEGIN
   ColourS := Strings.CopyCS(ColourName);
   IF Dict.Found(BBCStipple, ColourS, AreaFillColour) THEN
(* AreaFillColour implicitly assigned                                       *)
   ELSE
(* Soft error again???                                                      *)
    WriteF1(SysStreams.sysErr, "Cannot find area colour %S\N", S(ColourS));
    AreaFillColour := DefaultAreaColour
   END;
   Strings.Dispose(ColourS);
   Dict.Enter(BBCAreaFillColour, LayerName, KeyAttr{}, AreaFillColour)
  END DefArea;
*)
  IF Find(tempAreaFill, "areafill") THEN
    IF Dict.ForAllIn(tempAreaFill, ScanColour, Env) THEN END;
  END;
(* Tidy-up and rename here                                                  *)

END ReConfigure;

(*--------------------------------------------------------------------------*)

PROCEDURE BBCGenesis(); (* Bring the BBC world into being.                  *)
  PROCEDURE DefLColour(ColourName: ARRAY OF CHAR; ColourNo: INTEGER);
  BEGIN
    Dict.Enter(BBCColour, ColourName, KeyAttr{}, ColourNo)
  END DefLColour;

  PROCEDURE DefOutline(LayerName, ColourName: ARRAY OF CHAR);
  VAR Outline: OutlineColour;
    ColourNameSTR: String;
  BEGIN
    ColourNameSTR := Strings.CopyCS(ColourName);
    NEW(Outline);
    IF Dict.FoundWith(KeyAttr{ExactLength},
     BBCColour, ColourNameSTR, Outline^.Colour) THEN
      Outline^.Name := ColourNameSTR
(* DO NOT dispose ColourNameSTR when leaving in dictionary                  *)
    ELSE
(* Soft error???                                                            *)
      Strings.Dispose(ColourNameSTR);
      Outline := DefaultOutlineColour
    END;
    Dict.Enter(BBCOutlineColour, LayerName, KeyAttr{}, Outline)
  END DefOutline;

  PROCEDURE DefArea(LayerName, ColourName: ARRAY OF CHAR);
  VAR AreaFillColour: AreaColour;
    ColourS: String;
  BEGIN
    ColourS := Strings.CopyCS(ColourName);
    IF Dict.Found(BBCStipple, ColourS, AreaFillColour) THEN
    ELSE
(* Soft error again???                                                      *)
      WriteF1(SysStreams.sysErr, "Cannot find area colour %S\N", S(ColourS));
      AreaFillColour := DefaultAreaColour
    END;
    Strings.Dispose(ColourS);
    Dict.Enter(BBCAreaFillColour, LayerName, KeyAttr{}, AreaFillColour)
  END DefArea;

VAR DevName: String;
  strDict: DICT;
BEGIN
  NEW(BBCDriver);
  NEW(BBCDriver^.Procedure);
  BBCDriver^.StreamNo := 0;
(* Fill in all the fields with the implementation procedures                *)
  BBCDriver^.Procedure^.Colour := ColourIP;
  BBCDriver^.Procedure^.TextStyle := TextStyleIP;
  BBCDriver^.Procedure^.Marker := MarkerIP;
  BBCDriver^.Procedure^.Cursor := CursorIP;
  BBCDriver^.Procedure^.SetLineColour := SetLineColourIP;
  BBCDriver^.Procedure^.SetAreaColour := SetAreaColourIP;
  BBCDriver^.Procedure^.SetTextStyle := SetTextStyleIP;
  BBCDriver^.Procedure^.SetCursor := SetCursorIP;
  BBCDriver^.Procedure^.Surface := SurfaceIP;
  BBCDriver^.Procedure^.Command := CommandIP;
  BBCDriver^.Procedure^.MoveTo := MoveToIP;
  BBCDriver^.Procedure^.LineTo := LineToIP;
  BBCDriver^.Procedure^.MarkerAt := MarkerAtIP;
  BBCDriver^.Procedure^.Box := BoxIP;
  BBCDriver^.Procedure^.TextAt := TextAtIP;
  BBCDriver^.Procedure^.TextBox := TextBoxIP;
  BBCDriver^.Procedure^.DrawPolygon := DrawPolygonIP;
  BBCDriver^.Procedure^.ReadCursor := ReadCursorIP;
  BBCDriver^.Procedure^.Delete := DeleteIP;
  BBCDriver^.Procedure^.Update := UpdateIP;
(*--------------------------------------------------------------------------*)
  BBCMaster := Dict.NewDict("bbc");
    Dict.Enter(Defaults.Contents, "bbc", KeyAttr{}, BBCMaster);
  strDict := Dict.NewDict("strings");
    Dict.Enter(BBCMaster, "strings", KeyAttr{}, strDict);
    DevName := Strings.CopyCS("/dev/tty");
    Dict.Enter(strDict, "output_file", KeyAttr{}, DevName);
(*--------------------------------------------------------------------------*)
  BBCTextStyle := Dict.NewDict("text");
    Dict.Enter(BBCMaster, "text", KeyAttr{}, BBCTextStyle);
(* Styles are demand-driven. No point in inventing unused features.         *)
(*--------------------------------------------------------------------------*)

  BBCColour := Dict.NewDict("colour tokens");
    Dict.Enter(BBCMaster, "colour'", KeyAttr{}, BBCColour);
    DefLColour("black", 0);
    DefLColour("red", 1);
    DefLColour("green", 2);
    DefLColour("blue", 3);
  DefaultLineColour := 1; (* Red                                            *)
  BBCColour^.Silent := TRUE;

  BBCStipple := Dict.NewDict("stipple tokens");
    Dict.Enter(BBCMaster, "stipple'", KeyAttr{}, BBCStipple);
    MixColours("red_green", "red, black, black, green", Internal);
    MixColours("grey", "green, red, blue, green", Internal);
    MixColours("dark_green", "green, black, black, green", Internal);
    MixColours("purple", "red, blue, blue, red", Internal);
    MixColours("dark_purple", "black, red, blue, black", Internal);
    MixColours("light_blue", "green, blue, blue, green", Internal);
    MixColours("gold", "green, red, red, green", Internal);
    MixColours("dark_blue", "blue, blue, blue, black", Internal);
    MixColours("hatched_blue", "black, blue, blue, green", Internal);
    MixColours("dark_red", "red, black, black, red", Internal);

    MixColours("black", "black, black, black, black", Internal);
    MixColours("red", "red, red, red, red", Internal);
    MixColours("blue", "blue, blue, blue, blue", Internal);
    MixColours("green", "green, green, green, green", Internal);


(*--------------------------------------------------------------------------*)

  BBCOutlineColour := Dict.NewDict("outline tokens");
    Dict.Enter(BBCMaster, "outline'", KeyAttr{}, BBCOutlineColour);
    DefOutline("bbox", "green");
    DefOutline("ndiff", "red");
    DefOutline("ndiff", "red");
    DefOutline("pdiffcd", "red");
    DefOutline("pdiffcd", "red");
    DefOutline("metal", "blue");
    DefOutline("metalcd", "blue");
    DefOutline("poly", "green");
    DefOutline("polycd", "green");
(* "bbox"      "gold"
   "drcerror"  "black"
   "boundary"  "gold"

   "nwell"     "dotted_red"
   "pwell"     "dotted_violet"
   "ndiff"     "red"
   "pdiff"     "violet"
   "poly"      "green"
   "polytwo"   "green"
   "contact"   "brown"
   "metal"     "blue"
   "metaltwo"  "turquoise"
   "via"       "gold"
   "glass"     "brown"

   "nimpcd"    "dotdash_violet"
   "pimpcd"    "dotdash_red"
   "nwellcd"   "dotted_red"
   "pwellcd"   "dotted_violet"
   "npluscd"   "red"
   "ppluscd"   "violet"
   "polycd"    "green"
   "contaccd" "brown"
   "metalcd"   "blue"
   "fieldcd"   "red"
   "glasscd"   "brown"
*)
    DefOutline("red", "red");
    DefOutline("green", "green");
    DefOutline("blue", "blue");
  DefaultOutlineColour := OutlineVal("green");
  BBCOutlineColour^.Silent := TRUE;

(*--------------------------------------------------------------------------*)

  BBCAreaFillColour := Dict.NewDict("areafill tokens");
    Dict.Enter(BBCMaster, "areafill'", KeyAttr{}, BBCAreaFillColour);
    DefArea("glass", "black");
    DefArea("nwell", "grey");
    DefArea("pwell", "grey");
    DefArea("ndiff", "dark_red");
    DefArea("ndiffcd", "dark_red");
    DefArea("pdiff", "purple");
    DefArea("pdiffcd", "purple");
    DefArea("poly", "dark_green");
    DefArea("polycd", "dark_green");
    DefArea("polytwo", "dark_green");
    DefArea("metaltwo", "gold");
    DefArea("metal", "light_blue");
    DefArea("metalcd", "light_blue");
    DefArea("contact", "black");
    DefArea("contaccd", "black");
    DefArea("bbox", "black");
    DefArea("drcerror", "red");
(* "bbox"      "gold"
   "drcerror"  "black"
   "boundary"  "gold"

   "nwell"     "dotted_red"
   "pwell"     "dotted_violet"
   "ndiff"     "red"
   "pdiff"     "violet"
   "poly"      "green"
   "polytwo"   "green"
   "contact"   "brown"
   "metal"     "blue"
   "metaltwo"  "turquoise"
   "via"       "gold"
   "glass"     "brown"

   "nimpcd"    "dotdash_violet"
   "pimpcd"    "dotdash_red"
   "nwellcd"   "dotted_red"
   "pwellcd"   "dotted_violet"
   "npluscd"   "red"
   "ppluscd"   "violet"
   "polycd"    "green"
   "contaccd" "brown"
   "metalcd"   "blue"
   "fieldcd"   "red"
   "glasscd"   "brown"
*)
    DefArea("black", "black");
    DefArea("red", "red");
    DefArea("green", "green");
    DefArea("blue", "blue");

    DefArea("red_green", "red_green");
    DefArea("grey", "grey");
    DefArea("dark_green", "dark_green");
    DefArea("purple", "purple");
    DefArea("dark_purple", "dark_purple");
    DefArea("light_blue", "light_blue");
    DefArea("gold", "gold");
    DefArea("dark_blue", "dark_blue");
    DefArea("hatched_blue", "hatched_blue");
    DefArea("dark_red", "dark_red");


  DefaultAreaColour := AreaVal("red");
  BBCAreaFillColour^.Silent := TRUE;

  NEW(DefaultColour);  (**************** Keep up to date ****************)
  DefaultColour^.LineColour := DefaultLineColour;
  DefaultColour^.How := AreaFill;
  DefaultColour^.AreaFill := DefaultAreaColour;

  NEW(DefaultCursor);
  DefaultCursor^.Temp := -1;

  NEW(DefaultText);
  DefaultText^.Temp := -1

END BBCGenesis;

(*--------------------------------------------------------------------------*)
(*              EXTERNALLY CALLABLE PROCEDURES                              *)
(*--------------------------------------------------------------------------*)
(*--------------------------------------------------------------------------*)
(* These commands take a text description and return a token for future use *)
(* and so should be considered 'expensive' procedures to be once            *)
(*--------------------------------------------------------------------------*)
PROCEDURE ColourIP(Stream: GSTREAM; ColourC: ARRAY OF CHAR): COLOUR;
(* Resolve ColourC into '<x>' and '<x> outline', then choose Style
  as appropriate.(AreaFill or Outline)                                      *)
VAR NewColour: COLOUR;
  newcolour: colourIP;
  LineColour: INTEGER;
  Colour,
  AreaC: AreaColour;
  OutlineC: OutlineColour;
  ColourS: String;
  Pre, Post: String;
  AreaType: DrawType;
  ColourHook: BBCColourHook;
BEGIN
  ColourS := Strings.CopyCS(ColourC);
  AreaType := AreaFill;
  IF ParseF2("^.* ^.", ColourS, "%^0", Pre, "%^1", Post) THEN
    IF Debugging THEN
      WriteF3(Stream^.DiagStream,
       "****** DEBUG: <%S> ->(%S).' '.(%S)\N", S(ColourS), S(Pre), S(Post));
    END;
    IF Strings.EqualCS("outline", Post) THEN
      AreaType := Outline; Strings.Dispose(ColourS);
      ColourS := Pre; Strings.Dispose(Post);
      IF Debugging THEN
        WriteF0(Stream^.DiagStream, "  Colour: outline recognised\N")
      END(* if *);
    ELSE
      Strings.Dispose(Pre); Strings.Dispose(Post);
    END
  END;
(*--------------------------------------------------------------------------*)
(*  Construct pair of                                                       *)
(*  1) Line-drawing colour                                                  *)
(*  and                                                                     *)
(*  2) EITHER                                                               *)
(*    A) Area fill representation                                           *)
(*   or                                                                     *)
(*    B) Outline colour to be used.                                         *)
(*--------------------------------------------------------------------------*)
(*--------------------------------------------------------------------------*)
  IF Dict.Found(BBCColour, ColourS, LineColour) THEN
  ELSE
    LineColour := DefaultLineColour(* Soft error ??? *);
    IF Debugging THEN
      WriteF1(Stream^.DiagStream,
      "****** Warning: BBC.Colour('%S') not recognised as line colour\N",
       S(ColourS))
    END(* if *);
  END(* if *);
(*--------------------------------------------------------------------------*)
  IF AreaType = AreaFill THEN
    IF NOT(Dict.Found(BBCAreaFillColour, ColourS, AreaC)) THEN
      AreaC := DefaultAreaColour;
      IF Debugging THEN
        WriteF1(Stream^.DiagStream,
         "****** Warning: BBC.Colour('%S') not recognised as area colour\N",
         S(ColourS))
      END(* if *);
    END
  ELSE(* IF AreaType = Outline THEN                                         *)
    IF NOT(Dict.Found(BBCOutlineColour, ColourS, OutlineC)) THEN
      OutlineC := DefaultOutlineColour;
      IF Debugging THEN
        WriteF1(Stream^.DiagStream,
        "****** Warning: BBC.Colour('%S') not recognised as outline colour\N",
         S(ColourS))
      END(* if *);
    END
  END;
(*--------------------------------------------------------------------------*)
  Strings.Dispose(ColourS);
(* Combine Area & Outline into a BBCColourHook(with Name)
    & return*)
  NEW(ColourHook);
  ColourHook^.LineColour := LineColour;
  ColourHook^.How := AreaType;
  CASE AreaType OF
  (*|*) AreaFill:
    ColourHook^.AreaFill := AreaC;
    IF Debugging THEN
      WriteF0(Stream^.DiagStream, "  Colour: area selected\N");
    END(* if *);
  | Outline:
    ColourHook^.Outline := OutlineC;
    IF Debugging THEN
      WriteF0(Stream^.DiagStream, "  Colour: outline selected\N");
    END(* if *);
  END;
  NEW(NewColour);           (* COLOUR                                       *)
  NEW(newcolour);           (* colourIP                                     *)
  newcolour^.Name := Strings.CopyCS(ColourC);
  newcolour^.DeviceHook := WORD(ColourHook);
  NewColour^.Implementation := colour(newcolour);
  RETURN(NewColour)
END ColourIP;

PROCEDURE TextStyleIP(Stream: GSTREAM; TextC: ARRAY OF CHAR): TEXT;
VAR Text: TEXT;
  TextS: String;
BEGIN
  TextS := Strings.CopyCS(TextC);
  IF Dict.Found(BBCTextStyle, TextS, Text) THEN
(* BBCTextStyle non-existant as yet                                         *)
    Strings.Dispose(TextS); RETURN(Text)
  END;
END TextStyleIP;

PROCEDURE MarkerIP(Stream: GSTREAM; MarkerC: ARRAY OF CHAR): MARKER;
VAR Marker: MARKER;
   MarkerS: String;
BEGIN
  MarkerS := Strings.CopyCS(MarkerC);
  IF Dict.Found(BBCMarker, MarkerS, Marker) THEN
    Strings.Dispose(MarkerS); RETURN(Marker)
  END;
END MarkerIP;

PROCEDURE CursorIP(Stream: GSTREAM; CursorC: ARRAY OF CHAR): CURSOR;
VAR Cursor: CURSOR;
  CursorS: String;
BEGIN
  CursorS := Strings.CopyCS(CursorC);
  IF Dict.Found(BBCCursor, CursorS, Cursor) THEN
    Strings.Dispose(CursorS); RETURN(Cursor)
  END;
END CursorIP;
(*--------------------------------------------------------------------------*)
(*    Access procedures to set attributes in stream attribute block         *)
(*--------------------------------------------------------------------------*)
PROCEDURE SetLineColourIP(Stream: GSTREAM; Co: COLOUR);
VAR NewLineColour: INTEGER;
  Colour: colourIP;
  Hook: BBCColourHook;
  Impl: gstreamIP; DevState: BBCDeviceState;
BEGIN
(* Copy the LineColour field only, from the colour token                    *)
  Colour := colourIP(Co^.Implementation);
  Hook := BBCColourHook(Colour^.DeviceHook);
  NewLineColour := Hook^.LineColour;
(* to the LineColour field embedded in the stream                           *)
  Colour := colourIP(Stream^.Colour^.Implementation);
(* This sort of type-cast is dangerous                                      *)
(* so EVERY instance should be checked                                      *)
  Hook := BBCColourHook(Colour^.DeviceHook);
  Hook^.LineColour := NewLineColour;
  Impl := gstreamIP(Stream^.Implementation);
  DevState := BBCDeviceState(Impl^.DeviceState);
  IF DevState^.mode <> 0 THEN
    rawBBC.GraphicsColour(0, NewLineColour);
  ELSE
    rawBBC.GraphicsColour(0, 1); (* MODE 0                                  *)
  END;
END SetLineColourIP;
(*--------------------------------------------------------------------------*)
  PROCEDURE SetECFGColour(Colour1, Colour2, Colour3, Colour4: BITSET);
  VAR pair0, pair1, pair2, pair3: BITSET;
  BEGIN
    rawBBC.GraphicsColour(0, 64);
    pair0 := {}; pair1 := {}; pair2 := {}; pair3 := {};
    IF (1 IN Colour1) THEN pair0 := pair0+{5, 7} END;
    IF (1 IN Colour2) THEN pair0 := pair0+{4, 6} END;
    IF (0 IN Colour1) THEN pair1 := pair1+{1, 3} END;
    IF (0 IN Colour2) THEN pair1 := pair1+{0, 2} END;
    IF (1 IN Colour3) THEN pair2 := pair2+{5, 7} END;
    IF (1 IN Colour4) THEN pair2 := pair2+{4, 6} END;
    IF (0 IN Colour3) THEN pair3 := pair3+{1, 3} END;
    IF (0 IN Colour4) THEN pair3 := pair3+{0, 2} END;
    rawBBC.VduByte(INTEGER(pair0+pair1));
    rawBBC.VduByte(INTEGER(pair2+pair3));
    rawBBC.VduByte(INTEGER(pair0+pair1));
    rawBBC.VduByte(INTEGER(pair2+pair3))
  END SetECFGColour;
(*--------------------------------------------------------------------------*)
  PROCEDURE SendBBCMix(C1, C2, C3, C4: INTEGER);
  BEGIN
    SetECFGColour(BITSET(C1), BITSET(C2), BITSET(C3), BITSET(C4))
  END SendBBCMix;
(*-----------------------------------------------------------------------*)
  PROCEDURE SendNS32KMix(C1, C2, C3, C4: INTEGER);
  BEGIN
    rawBBC.VduByte(23);
    rawBBC.VduByte(12);
    rawBBC.VduByte(C1);
    rawBBC.VduByte(C2);
    rawBBC.VduByte(C3);
    rawBBC.VduByte(C4);
    rawBBC.VduByte(C1);
    rawBBC.VduByte(C2);
    rawBBC.VduByte(C3);
    rawBBC.VduByte(C4);
    (* Select ECF pattern 1 *)
    rawBBC.GraphicsColour(16, 1)
  END SendNS32KMix;
(*--------------------------------------------------------------------------*)
PROCEDURE SetAreaColourIP(Stream: GSTREAM; Co: COLOUR);
VAR
   CurrentColour,
   NewColour: colourIP;
   CurrentHook,
   NewHook: BBCColourHook;
BEGIN

  NewColour := colourIP(Co^.Implementation);
  NewHook := BBCColourHook(NewColour^.DeviceHook);

  CurrentColour := colourIP(Stream^.Colour^.Implementation);
  CurrentHook := BBCColourHook(CurrentColour^.DeviceHook); (** = 0 ??? **)

(* Copy area fields from NewHook to CurrentHook                             *)
  CurrentHook^.How := NewHook^.How;
  CASE NewHook^.How OF
  (*|*) AreaFill: CurrentHook^.AreaFill := NewHook^.AreaFill;
  | Outline: CurrentHook^.Outline := NewHook^.Outline;
  END
END SetAreaColourIP;

PROCEDURE SetTextStyleIP(Stream: GSTREAM; Text: TEXT);
BEGIN
  Stream^.Text := Text
END SetTextStyleIP;

PROCEDURE SetCursorIP(Stream: GSTREAM; Cursor: CURSOR);
BEGIN
  Stream^.Cursor := Cursor
END SetCursorIP;
(*--------------------------------------------------------------------------*)
(* These commands have a direct action on the device.  The 'Command'        *)
(* interface is provided as a general escape mechanism for very device-     *)
(* specific commands                                                        *)
(*--------------------------------------------------------------------------*)
PROCEDURE SurfaceIP(Stream: GSTREAM; Xl, Yb, Xr, Yt: INTEGER);
VAR I, apparentWidth, apparentHeight, viewportWidth, viewportHeight,
  centreWidth, centreHeight: INTEGER;
  Impl: gstreamIP; DevState: BBCDeviceState;
BEGIN
  IF (Xl>Xr) THEN I := Xl; Xl := Xr; Xr := I END;(* box inside out          *)
  IF (Yb>Yt) THEN I := Yb; Yb := Yt; Yt := I END;
  Impl := gstreamIP(Stream^.Implementation);
  DevState := BBCDeviceState(Impl^.DeviceState);
  WITH DevState^ DO
    WXl := Xl; WYb := Yb; WXr := Xr; WYt := Yt;(* Remember for later        *)
  END;                            (* when de-scaling                        *)
  WITH Stream^ DO
(*???????????? Adjust to match aspect ratio of viewport ?????????????*)
(**:
    if surface width/surface height>viewport width/viewport height then
      ! width>height-so up the surface height
    else
      ! height>width-so widen the surface
    end
: **)
    viewportWidth := (vxr-vxl); viewportHeight := (vyt-vyb);
    IF (viewportWidth = 0) AND (viewportHeight = 0) THEN
      WriteF0(SysStreams.sysErr,
       "****** Graphics.Surface: 0 drawing area specified\N");
      viewportHeight := 1023; vyb := 0; vyt := 1023;
    END(* if *);
    IF viewportWidth = 0 THEN
      viewportWidth := viewportHeight; (* Issue warning if Debugging.       *)
      vxr := vxr+viewportWidth DIV 2; vxl := vxl-viewportWidth DIV 2;
    END(* if *);
    IF viewportHeight = 0 THEN
      viewportHeight := viewportWidth; (* Issue warning if Debugging.       *)
      vyt := vyt+viewportHeight DIV 2; vyb := vyb-viewportHeight DIV 2;
    END(* if *);
    IF (Xr-Xl) * viewportHeight>viewportWidth * (Yt-Yb) THEN
(*  window width/height>viewport width/height                               *)
      apparentWidth := Xr-Xl;
      apparentHeight := Muldiv(apparentWidth, viewportHeight, viewportWidth);
      centreHeight := (Yb+Yt) DIV 2;
      Yb := centreHeight - (apparentHeight DIV 2);
      Yt := centreHeight + (apparentHeight DIV 2)
    ELSE
      apparentHeight := Yt-Yb;
      apparentWidth := Muldiv(apparentHeight, viewportWidth, viewportHeight);
      centreWidth := (Xl+Xr) DIV 2;
      Xl := centreWidth -(apparentWidth DIV 2);
      Xr := centreWidth +(apparentWidth DIV 2);
    END(* if *);
    xl := Xl; yb := Yb; xr := Xr; yt := Yt;
    lastx := xl; lasty := yb; x := lastx; y := lasty;
    IF Debugging THEN
      WriteF2(Stream^.DiagStream,
            "****** DEBUG: Aspect ratio = %R1.4:%R1.4\N",
            R(FLOAT(CARDINAL(yt-yb))/FLOAT(CARDINAL(xr-xl))),
            R(FLOAT(CARDINAL(vyt-vyb))/FLOAT(CARDINAL(vxr-vxl))))
    END
  END;
  IF Debugging THEN WITH Stream^ DO
    WriteF2(DiagStream, "  viewport = (%I, %I)", vxl, vyb);
    WriteF2(DiagStream, " to(%I, %I)\N", vxr, vyt);
    WriteF2(DiagStream, "  window = (%I, %I)", xl, yb);
    WriteF2(DiagStream, " to(%I, %I)\N", xr, yt);
  END END(* if *);
  Impl := gstreamIP(Stream^.Implementation);
  DevState := BBCDeviceState(Impl^.DeviceState);
  WITH DevState^ DO
    WXl := ScaleX(Stream, WXl); WYb := ScaleY(Stream, WYb);
    WXr := ScaleX(Stream, WXr); WYt := ScaleY(Stream, WYt);
  END;
  rawBBC.Mode(DevState^.mode);
  IF DevState^.mode = 0 THEN
    DevState^.TYb := 31; DevState^.TXr := 79;
    rawBBC.SetColour(1, 2);
  ELSIF DevState^.mode = 1 THEN
    DevState^.TYb := 31; DevState^.TXr := 39;
    rawBBC.SetColour(1, 1); (* Red                                          *)
    rawBBC.SetColour(2, 2); (* Green                                        *)
    rawBBC.SetColour(3, 4); (* Blue                                         *)
  END;
  DevState^.TYt := ((1024-Yb) DIV(DevState^.TYb+1))+1;
  WITH DevState^ DO IF TYt>TYb-2 THEN TYt := TYb-2 END END;
  DevState^.TXl := 0;
  WITH DevState^ DO rawBBC.TextWindow(TXl, TYb, TXr, TYt);
              rawBBC.GraphicsWindow(WXl, WYb, WXr, WYt) END;
END SurfaceIP;

PROCEDURE CommandIP(Stream: GSTREAM; Comm: ARRAY OF CHAR): INTEGER;
  PROCEDURE StoI(S: String): INTEGER;
  VAR C, Idx, I: INTEGER;
  BEGIN
    IF S = NIL THEN
      RETURN(0)
    END(* if *);
    Idx := 0; I := 0;
    LOOP
      C := INTEGER(S^[Idx]);
      IF (C>57) OR (C<48) THEN EXIT END;
      I := I * 10+C-48;
      INC(Idx); IF Idx>6 THEN EXIT END
    END;
    RETURN(I)
  END StoI;
VAR modeStr, commStr, debugFileStr: String;
   ready, debugFile: ARRAY [0..255] OF CHAR;
   Impl: gstreamIP; DevState: BBCDeviceState;
BEGIN
  commStr := Strings.CopyCS(Comm);

  IF ParseF1("* mode* #", commStr, "%#0", modeStr) THEN
    Impl := gstreamIP(Stream^.Implementation);
    DevState := BBCDeviceState(Impl^.DeviceState);
    DevState^.mode := StoI(modeStr);
    Strings.Dispose(commStr); Strings.Dispose(modeStr);
    RETURN(-20);
  END(* if *);

  IF ParseF0("* debug* tables", commStr) THEN
    DebugLineColours();
    DebugOutlineColours();
    DebugStipple();
    DebugAreaColours();
    Strings.Dispose(commStr);
    RETURN(-1)
  END(* if *);

  IF ParseF0("* debug* on", commStr) THEN
    IF VirginDebug THEN
      Stream^.DiagStream := FileStream.CreateOutput("graphics.debug");
      VirginDebug := FALSE
    END(* if *);
    Strings.Dispose(commStr);
    Debugging := TRUE; RETURN(-2)
  END(* if *);

  IF ParseF1("* debug* to* ^.", commStr, "%^0", debugFileStr) THEN
    Strings.CopySC(debugFileStr, debugFile);
    IF VirginDebug THEN
      Stream^.DiagStream := FileStream.CreateOutput(debugFile);
      VirginDebug := FALSE
    ELSE
      Streams.Delete(Stream^.DiagStream);
      Stream^.DiagStream := FileStream.CreateOutput(debugFile);
    END(* if *);
    Strings.Dispose(commStr);
    Strings.Dispose(debugFileStr);
    Debugging := TRUE; RETURN(-2)
  END(* if *);

  IF ParseF0("* debug* off", commStr) THEN
    Strings.Dispose(commStr);
    Debugging := FALSE; RETURN(-3)
  END(* if *);

  IF ParseF0("* view", commStr) THEN
(* GET space bar, back to previous mode                                     *)
    rawBBC.ResetWindows(); Readln("Ready?", ready);
    rawBBC.Mode(0); (* GET FROM ENVIRONMENT VARIABLE                        *)
    Strings.Dispose(commStr);
    RETURN(-6)
  END(* if *);

  IF Debugging THEN
    WriteF1(Stream^.DiagStream,
          "****** Warning: BBC.Command('%S') not known?\N", H(Comm))
  END(* if *);
  Strings.Dispose(commStr);
  RETURN(3)

END CommandIP;
(*--------------------------------------------------------------------------*)
(* The current line colour is an attribute held in the GSTREAM.             *)
(*--------------------------------------------------------------------------*)
  PROCEDURE ScaleX(Env: GSTREAM; X: INTEGER): INTEGER;
  VAR DebugStep: INTEGER;
  BEGIN
    IF Debugging THEN
      WriteF1(Env^.DiagStream, "    ScaleX(%I) -> ", X)
    END(* if *);
    WITH Env^ DO
      DebugStep := ((X-xl) *(vxr-vxl) DIV(xr-xl))+vxl;
      IF Debugging THEN
        WriteF1(Env^.DiagStream, "%I", DebugStep);
        WriteF2(Env^.DiagStream, "(vxr=%I, vxl=%I)", vxr, vxl);
        WriteF2(Env^.DiagStream, "(xr=%I, xl=%I)\N", xr, xl);
      END(* if *);
      RETURN(DebugStep)
    END
  END ScaleX;
  PROCEDURE ScaleY(Env: GSTREAM; Y: INTEGER): INTEGER;
  VAR DebugStep: INTEGER;
  BEGIN
    IF Debugging THEN
      WriteF1(Env^.DiagStream, "    ScaleY(%I) -> ", Y)
    END(* if *);
    WITH Env^ DO
      DebugStep := ((Y-yb) * (vxr-vxl) DIV (xr-xl))+vyb;
      IF Debugging THEN
        WriteF1(Env^.DiagStream, "%I", DebugStep);
        WriteF2(Env^.DiagStream, "(vxr=%I, vxl=%I)", vxr, vxl);
        WriteF2(Env^.DiagStream, "(xr=%I, xl=%I)\N", xr, xl);
      END(* if *);
      RETURN(DebugStep)
    END
(*  BEGIN
    WITH Env^ DO RETURN((Y-yb) *(vyt-vyb) DIV(yt-yb))+vyb END*)
  END ScaleY;
  PROCEDURE DeScaleX(Env: GSTREAM; X: INTEGER): INTEGER;
  BEGIN
    WITH Env^ DO RETURN(((X-vxl) * (xr-xl) DIV(vxr-vxl))+xl) END
  END DeScaleX;
  PROCEDURE DeScaleY(Env: GSTREAM; Y: INTEGER): INTEGER;
  BEGIN
    WITH Env^ DO RETURN(((Y-vyb) * (yt-yb) DIV(vyt-vyb))+yb) END
  END DeScaleY;

PROCEDURE MoveToIP(Stream: GSTREAM; X, Y: INTEGER);
BEGIN
  WITH Stream^ DO
    lastx := x; lasty := y;
    x := ScaleX(Stream, X); y := ScaleY(Stream, Y);
    IF Debugging THEN
      WriteF2(Stream^.DiagStream, "  rawBBC.MoveAbs(%I, %I)\N", x, y)
    END(* if *);
    rawBBC.MoveAbs(x, y);
  END;
END MoveToIP;

PROCEDURE LineToIP(Stream: GSTREAM; X, Y: INTEGER);
BEGIN
  WITH Stream^ DO
    lastx := x; lasty := y;
    x := ScaleX(Stream, X); y := ScaleY(Stream, Y);
    IF Debugging THEN
      WriteF2(Stream^.DiagStream, "  rawBBC.LineAbs(%I, %I)\N", x, y)
    END(* if *);
    rawBBC.LineAbs(x, y)
  END;
END LineToIP;
(*--------------------------------------------------------------------------*)
(* Markers are drawn with their centre on the point given. The marker is    *)
(* geometrically defined elsewhere, and a handle to it is got from the      *)
(* 'Marker' procedure; e.g. Marker(Arrow, "->")                             *)
(*--------------------------------------------------------------------------*)
PROCEDURE MarkerAtIP(Stream: GSTREAM; X, Y: INTEGER; Ma: MARKER);
VAR x, y: INTEGER;
BEGIN
  x := ScaleX(Stream, X); y := ScaleY(Stream, Y);
  rawBBC.MoveAbs(x, y);
  rawBBC.GraphCursor();
  WriteCHAR(SysStreams.sysOut, "*");
  rawBBC.TextCursor();
  rawBBC.MoveAbs(x, y);
END MarkerAtIP;
(*--------------------------------------------------------------------------*)
(* This text command draws text from the point given. see also 'TextBox'    *)
(*--------------------------------------------------------------------------*)
PROCEDURE TextAtIP(Stream: GSTREAM; X, Y: INTEGER; Text: ARRAY OF CHAR);
VAR x, y: INTEGER;
BEGIN
  x := ScaleX(Stream, X); y := ScaleY(Stream, Y);
  rawBBC.MoveAbs(x, y);
  rawBBC.GraphCursor();
  WriteF0(SysStreams.sysOut, Text);
  rawBBC.TextCursor();
  rawBBC.MoveAbs(x, y);
END TextAtIP;
(*--------------------------------------------------------------------------*)
(* These are area-action commands: TextBox puts the text in the box as      *)
(* best as it can                                                           *)
(*--------------------------------------------------------------------------*)
PROCEDURE BoxIP(Stream: GSTREAM; Xl, Yb, Xr, Yt: INTEGER);
VAR xl, yb, xr, yt: INTEGER;
   Impl: gstreamIP; DevState: BBCDeviceState;
BEGIN
  WITH Stream^ DO lastx := x; lasty := y; END;
  xl := ScaleX(Stream, Xl); yb := ScaleY(Stream, Yb);
  xr := ScaleX(Stream, Xr); yt := ScaleY(Stream, Yt);
  rawBBC.GraphicsWindow(xl, yb, xr, yt);
  rawBBC.ClearGraphicsArea();
  rawBBC.ResetWindows();
  Impl := gstreamIP(Stream^.Implementation);
  DevState := BBCDeviceState(Impl^.DeviceState);
  WITH DevState^ DO
    rawBBC.TextWindow(TXl, TYb, TXr, TYt);
    rawBBC.GraphicsWindow(WXl, WYb, WXr, WYt)
  END;
  rawBBC.MoveAbs(xl, yb);
  rawBBC.LineAbs(xl, yt); rawBBC.LineAbs(xr, yt);
  rawBBC.LineAbs(xr, yb); rawBBC.LineAbs(xl, yb);
  Stream^.x := xl; Stream^.y := yb;
END BoxIP;
(*--------------------------------------------------------------------------*)
PROCEDURE RCCTextInBox(Xl, Yl, Xh, Yh: INTEGER; Text: ARRAY OF CHAR);
(*  Takes the screen box coords                                             *)
VAR  x, y, len, space, dx, dy, j:  INTEGER;
CONST pixel = 4; half = pixel DIV 2; k = 4096;
BEGIN
  IF (Xh<Xl) THEN x := Xl; Xl := Xh; Xh := x END;
  IF (Yh<Yl) THEN y := Yl; Yl := Yh; Yh := y END;
  dx := Xh-Xl; Xl := ((Xl+half) DIV pixel) * pixel; Xh := Xl+dx;
  dy := Yh-Yl; Yl := ((Yl+half) DIV pixel) * pixel; Yh := Yl+dy;
  rawBBC.MoveAbs(Xl, Yl);
  rawBBC.GraphicsColour(0, 1);
  IF (dx<2*pixel) THEN rawBBC.LineAbs(Xl, Yh); RETURN END;
  IF (dy<2*pixel) THEN rawBBC.LineAbs(Xh, Yl); RETURN END;
  len := Strings.LengthC(Text);
  space := (dx DIV 16);
  IF (len>space) & (space<dy DIV 24) THEN space := dy DIV 24 END;
  IF (len>space) THEN Text[space] := 0C; len := Strings.LengthC(Text) END;
  IF (space = dx DIV 16) & (dy >= 24) & (len>0) THEN
    x := Xl +(dx-16*len) DIV 2; y := (Yl +(dy-24) DIV 2)+32;
    rawBBC.MoveAbs(x, y);
    rawBBC.GraphCursor();
    WriteF0(SysStreams.sysOut, Text);
  ELSIF (space = dy DIV 24) & (dx >= 16) & (len>0) THEN
    x := Xl +(dx-16) DIV 2; y := Yh -(dy-24*len) DIV 2;
    rawBBC.GraphCursor();
    FOR j := 0 TO len-1 DO
      rawBBC.MoveAbs(x, y-28*j); WriteCHAR(SysStreams.sysOut, Text[j])
    END;
  END
END RCCTextInBox;
(*--------------------------------------------------------------------------*)
PROCEDURE TextBoxIP(Stream: GSTREAM; Xl, Yb, Xr, Yt: INTEGER;
  Text: ARRAY OF CHAR);
VAR I, xl, yb, xr, yt: INTEGER;
   Impl: gstreamIP; DevState: BBCDeviceState;
BEGIN
  IF Xl>Xr THEN I := Xl; Xl := Xr; Xr := I END;
  IF Yb>Yt THEN I := Yb; Yb := Yt; Yt := I END;
  WITH Stream^ DO lastx := x; lasty := y; END;
  xl := ScaleX(Stream, Xl); yb := ScaleY(Stream, Yb);
  xr := ScaleX(Stream, Xr); yt := ScaleY(Stream, Yt);
  IF (xl=xr) OR (yb=yt) THEN RETURN END;
(*!
     I've had enough of this drawing black(RCC 3/1/85)
     rawBBC.GraphicsWindow(xl, yb, xr, yt);
     rawBBC.ClearGraphicsArea();
  !*)
(*!
     Would also appreciate it if things got clipped before sending them
     to the Beeb: in particular if none of the text will fit
    rawBBC.GraphicsWindow(xl+((1280 DIV(40*8)) * 4),
     yb+((1024 DIV(32*8)) * 4),
     xr-((1280 DIV(40*8)) * 4),
     yt-((1024 DIV(32*8)) * 4));
    rawBBC.MoveAbs(xl+((1280 DIV(40*8)) * 4), yt-((1024 DIV(32*8)) * 4));
    rawBBC.GraphCursor(); WriteF0(SysStreams.sysOut, Text);
  !*)
  RCCTextInBox(xl, yb, xr, yt, Text);
(* WITH Stream^ DO GraphicsWindow(xl, yb, xr, yt) END; *)(* When windowing  *)
  rawBBC.ResetWindows(); rawBBC.TextCursor(); rawBBC.MoveAbs(xl, yb);
  Impl := gstreamIP(Stream^.Implementation);
  DevState := BBCDeviceState(Impl^.DeviceState);
  rawBBC.ResetWindows(); rawBBC.TextCursor();
  WITH DevState^ DO
    rawBBC.TextWindow(TXl, TYb, TXr, TYt);
    rawBBC.GraphicsWindow(WXl, WYb, WXr, WYt)
  END;
  rawBBC.MoveAbs(xl, yb);
  rawBBC.LineAbs(xl, yt); rawBBC.LineAbs(xr, yt);
  rawBBC.LineAbs(xr, yb); rawBBC.LineAbs(xl, yb);
  Stream^.x := xl; Stream^.y := yb;
(* Get text-centring stuff from richard                                     *)
END TextBoxIP;
(*--------------------------------------------------------------------------*)
(* The four input co-ords allow a vast variety of initial cursor display    *)
(* on raster devices.  Possibilities include dragged boxes, stretched       *)
(* boxes, 45 degree snap lines etc.  The 'text' parameter returned will be  *)
(* a device independant mapping of the returned value from a pick.          *)
(* There is a possibility of returning entire command strings in this way   *)
(* using a menu mechanism yet to be determined.                             *)
(*--------------------------------------------------------------------------*)
PROCEDURE ReadCursorIP(Stream: GSTREAM; Xl, Yb, Xr, Yt: INTEGER;
  VAR X, Y: INTEGER;
              VAR Text: ARRAY OF CHAR);
VAR Impl: gstreamIP; DevState: BBCDeviceState;
   XYstr: ARRAY [0..255] OF CHAR;
  PROCEDURE Hex(Index: INTEGER): INTEGER;
  VAR Ch1, Ch2, Ch3, Ch4: CHAR;
     sex, I1, I2 , I3, I4: INTEGER;
    PROCEDURE DeHex(C: CHAR): INTEGER;
    VAR I: CARDINAL;
    BEGIN
      I := ORD(C)-ORD("0");
      IF I>9 THEN I := I+ORD("0")-ORD("A")+10 END;
      RETURN(INTEGER(I))
    END DeHex;
  BEGIN
    Ch1 := XYstr[Index]; Ch2 := XYstr[Index+1];
    Ch3 := XYstr[Index+2]; Ch4 := XYstr[Index+3];
    I1 := DeHex(Ch1); I2 := DeHex(Ch2); I3 := DeHex(Ch3); I4 := DeHex(Ch4);
    IF I1>=8 THEN sex := -65536 ELSE sex := 0 END;
    RETURN((((I1*16)+I2)*16+I3)*16+I4+sex)
  END Hex;

BEGIN  (* The BBC tracks the cursor using either mouse or keyboard
        until a key-press or a button-press. The local code then
        returns <buttons> <Xhigh>..<Xlow> <Yhigh>..<Ylow>  {IBM sex}
        as 9 ASCII bytes in the range "0".."?"
        (i.e. 16 consecutive characters starting at "0".)
        e.g. 3010002FF<cr> meaning centre, right at(256, 767)
        The Cursor is tracked with character CHR$(128) which must
        have been previously defined.                                       *)
(********** ARGH!!! - should be guarded below... ***********)
  IssueStarCommand("mouse");
  rawBBC.DefChar(128, 24, 24, 24, 255, 255, 24, 24, 24); (* Cross-hair curso*)
  rawBBC.TextColour(0);       (* Text in black, and miniscule window        *)
  rawBBC.TextWindow(0, 1, 0, 0); (* to hide text returned from mouse.       *)
(* IF Type = stretch THEN
    rawBBC.Escape();
    rawBBC.VduByte(ORD("?"))
  ELSIF Type = char THEN*)
    MoveToIP(Stream, Xr, Yt);        (* Init cursor position                *)
    rawBBC.MoveRel(-((1280 DIV 40) DIV 2), (1024 DIV 32) DIV 2);
    rawBBC.Escape();        (* Adjust for centre of cross.                  *)
    rawBBC.VduByte(ORD("!"));
(* ELSE
    rawBBC.Escape();
    rawBBC.VduByte(ORD("!"))
  END;                                                                      *)
  REPEAT Readln("", XYstr) UNTIL((XYstr[0] >= "A")
                      AND (XYstr[0] <= "F"))
                     OR ((XYstr[0] >= "0")
                      AND (XYstr[0] <= "9"));
  X := Hex(1);
  Y := Hex(5);
(* IF Type <> stretch THEN (* Alter when adding DRAG style *)*)
    X := X +((1280 DIV(40*8)) * 4);
    Y := Y -((1024 DIV(32*8)) * 4); (* Adjust for cursor position
                                which is the centre of the
                                charcter used as the cursor.
                                The position returned by the
                                BBC is the top left of the
                                cursor square                               *)
(* END;                                                                     *)
  rawBBC.ResetWindows();  (* should EXPLICITLY reset to current viewport    *)
  Impl := gstreamIP(Stream^.Implementation);
  DevState := BBCDeviceState(Impl^.DeviceState);
  WITH DevState^ DO rawBBC.TextWindow(TXl, TYb, TXr, TYt);
              rawBBC.GraphicsWindow(WXl, WYb, WXr, WYt) END;
  rawBBC.TextColour(1);    (* Should also set text colour appropriately     *)
  rawBBC.GraphicsColour(0, 1);
(* Likewise this is wrong-but more obviously                                *)
(* Buttons := ButtonSet(ORD(XYstr[0])-ORD("0"));                            *)
  Text[0] := XYstr[0]; Text[1] := 0C;
  X := DeScaleX(Stream, X);  (* Results back to chip-space                  *)
  Y := DeScaleY(Stream, Y);
END ReadCursorIP;

  PROCEDURE PolyOutline(X, Y, Code: INTEGER; Stream: WORD);
  VAR EnvStream: GSTREAM;
  BEGIN
    EnvStream := GSTREAM(Stream);
    IF Code>0 THEN
      IF Debugging THEN
        WriteF2(EnvStream^.DiagStream, "  Move(%I, %I)\N", X, Y)
      END(* if *);
      MoveToIP(EnvStream, X, Y)
    ELSIF Code<0 THEN
      RETURN
    ELSE
      IF Debugging THEN
        WriteF2(EnvStream^.DiagStream, "  Line(%I, %I)\N", X, Y)
      END(* if *);
      LineToIP(EnvStream, X, Y)
    END;
  END PolyOutline;

  PROCEDURE PolyCell(P1, P2, P3, P4, P5, P6: INTEGER; Stream: WORD);
  VAR EnvStream: GSTREAM;
    PROCEDURE Trapeze(Xlb, Yb, dxb, Xlt, Yt, dxt: INTEGER);
    VAR Xrb, Xrt: INTEGER;
    BEGIN
      Xrb := Xlb+dxb;
      Xrt := Xlt+dxt;
      rawBBC.MoveAbs(ScaleX(EnvStream, Xlb), ScaleY(EnvStream, Yb));
      rawBBC.MoveAbs(ScaleX(EnvStream, Xlt), ScaleY(EnvStream, Yt));
      rawBBC.FillTriangleAbs(ScaleX(EnvStream, Xrb), ScaleY(EnvStream, Yb));
      rawBBC.FillTriangleAbs(ScaleX(EnvStream, Xrt), ScaleY(EnvStream, Yt))
    END Trapeze;
  BEGIN
    EnvStream := GSTREAM(Stream); Trapeze(P1, P2, P3, P4, P5, P6)
  END PolyCell;

PROCEDURE DrawPolygonIP(Stream: GSTREAM; Polygon: POLYGON);
VAR Colour: colourIP;
   BBCHook: BBCColourHook;
   Impl: gstreamIP; DevState: BBCDeviceState;
BEGIN
  Colour := colourIP(Stream^.Colour^.Implementation);
  BBCHook := BBCColourHook(Colour^.DeviceHook);
  Impl := gstreamIP(Stream^.Implementation);
  DevState := BBCDeviceState(Impl^.DeviceState);
  IF BBCHook^.How = Outline THEN
    IF Debugging THEN
      WriteF0(Stream^.DiagStream, "  Putoutline\N")
    END(* if *);
    WITH BBCHook^.Outline^ DO
      IF Debugging THEN
        WriteF1(Stream^.DiagStream, "  BBC outline colour = %I\N", Colour)
      END;
      IF DevState^.mode <> 0 THEN
        rawBBC.GraphicsColour(0, Colour)
      ELSE
        rawBBC.GraphicsColour(0, 1)(* MODE 0                                *)
      END
    END;
    Polysys.putpolygon(Polygon, PolyOutline, Stream);
    Impl := gstreamIP(Stream^.Implementation);
    DevState := BBCDeviceState(Impl^.DeviceState);
    IF DevState^.mode <> 0 THEN
      rawBBC.GraphicsColour(0, BBCHook^.LineColour)
    ELSE
      rawBBC.GraphicsColour(0, 1)(* MODE 0                                  *)
    END
(* Replace real line colour                                                 *)
  ELSE
    WITH BBCHook^.AreaFill^ DO
      IF Debugging THEN
        WriteF2(Stream^.DiagStream,
              "  BBC area mix = %I, %I, ",
              NW, NE);
        WriteF2(Stream^.DiagStream,
              "%I, %I\N",
              SW, SE);
      END;
      IF DevState^.mode >= 8 THEN
        SendNS32KMix(NW, NE, SW, SE);
      ELSE
        SendBBCMix(NW, NE, SW, SE);
      END;
    END;
    IF Debugging THEN
      WriteF0(Stream^.DiagStream, "  Putfilled\N")
    END(* if *);
    Polysys.putfilled(Polygon, PolyCell, Stream)
  END(* if *);
END DrawPolygonIP;

PROCEDURE DeleteIP(Stream: GSTREAM);
BEGIN
  Streams.Flush(SysStreams.sysOut); (* Should be stream via GSTREAM block   *)
(* EXECUTE REVERSE OF FINDOUTPUT 'NEW'S                                     *)
  DISPOSE(Stream);
END DeleteIP;

PROCEDURE UpdateIP(Stream: GSTREAM);
BEGIN
  Streams.Flush(SysStreams.sysOut)  (* Should be stream via GSTREAM block   *)
END UpdateIP;

(*--------------------------------------------------------------------------*)
(*                VISIBLE PROCEDURES                                        *)
(*--------------------------------------------------------------------------*)
PROCEDURE FindInOut(Qual: ARRAY OF CHAR;
               BBCXl, BBCYb, BBCXr, BBCYt: INTEGER): GSTREAM;
(* Open an interactive stream: Only one may exist at once                   *)
BEGIN
(* Ultra temp                                                               *)
  RETURN(FindOutput(Qual, BBCXl, BBCYb, BBCXr, BBCYt))
(* Must set InStream, OutStream & a new DIRECTION variable when
    we support In & Out properly.                                           *)
END FindInOut;

PROCEDURE FindInput(Qual: ARRAY OF CHAR): GSTREAM;
(* Return a non-echoed(single char if poss) input stream                    *)
(* which will pass back pick-device strings via ReadCursor                  *)
BEGIN
END FindInput;


PROCEDURE FindOutput(Qual: ARRAY OF CHAR;
               Xl, Yb, Xr, Yt: INTEGER): GSTREAM;
VAR NewStream: GSTREAM;
   Implementation: gstreamIP;
   ColourIP: colourIP;
   TextIP: textIP;
   CursorIP: cursorIP;
   DevState: BBCDeviceState;
   DefStr: String;
   I: INTEGER;
BEGIN
  IF Dormant THEN BBCGenesis(); Dormant := FALSE END;
  NEW(NewStream); NEW(Implementation);
  NEW(NewStream^.Colour);
  NEW(ColourIP); NewStream^.Colour^.Implementation := colour(ColourIP);
(************* FILL IN DEFAULT VALUES ****************************)
DefStr := Strings.CopyCS("default");
  ColourIP^.Name := DefStr;
  ColourIP^.DeviceHook := WORD(DefaultColour);
  NEW(NewStream^.Text);
  NEW(TextIP);  NewStream^.Text^.Implementation := text(TextIP);
  TextIP^.Name := DefStr; TextIP^.DeviceHook := WORD(DefaultText);
  NEW(NewStream^.Cursor);
  NEW(CursorIP); NewStream^.Cursor^.Implementation := cursor (CursorIP);
  CursorIP^.Name := DefStr; CursorIP^.DeviceHook := WORD(DefaultCursor);
  NewStream^.DiagStream := SysStreams.sysErr;
  WITH NewStream^ DO vxl := Xl; vyb := Yb; vxr := Xr; vyt := Yt END;
  WITH NewStream^ DO xl := vxl; yb := vyb; xr := vxr; yt := vyt END;
  WITH NewStream^ DO lastx := xl; lasty := yb; x := lastx; y := lasty END;

  NEW(DevState); DevState^.mode := 1;

  Implementation^.StreamNo := 4;
  Implementation^.Procedure := BBCDriver^.Procedure;
  Implementation^.InStream := SysStreams.sysIn;
  Implementation^.OutStream := SysStreams.sysOut;
  Implementation^.DeviceState := WORD(DevState);
  NewStream^.Implementation := gstream(Implementation);
(*--------------------- Set up diag stream ---------------------------------*)
  NewStream^.DiagStream := FileStream.CreateOutput("/dev/null");
  I := CommandIP(NewStream, Qual);
  WITH NewStream^ DO
    IF (vxl<0) OR (vxr>1279) OR (vyb<0) OR (vyt>1023) THEN
     IF Debugging THEN
      WriteF2(NewStream^.DiagStream,
       "****** Warning: BBC.Find viewport is off screen -(%I, %I",
       vxl, vyb);
      WriteF2(NewStream^.DiagStream, ", %I, %I)\N", vxr, vyt);
     END(* if *);
    END(* if *);
  END(* with *);
  RETURN(NewStream)
END FindOutput;

PROCEDURE Delete(Stream: GSTREAM);
VAR
  Implementation: gstreamIP;
BEGIN
  IF Dormant THEN
(* Non-fatal error                                                          *)
    IF Debugging THEN
      WriteF0(Stream^.DiagStream,
            "****** Error: BBC.Delete called before BBC.Find???\N")
    END(* if *);
    RETURN
  END;
(*  DeleteIP(Stream)(* Safer to call internal version-
                what happens when a stream deletes itself? *)*)
  Implementation := gstreamIP(Stream^.Implementation);
(* Uncover hidden type                                                      *)
  Implementation^.Procedure^.Delete(Stream);
(* aliter ... DeleteIP(Stream)                                              *)
END Delete;

PROCEDURE Update(Stream: GSTREAM);
VAR
  Implementation: gstreamIP;
BEGIN
  IF Dormant THEN
(* Non-fatal error                                                          *)
    IF Debugging THEN
      WriteF0(Stream^.DiagStream,
            "****** Error: BBC.Update called before BBC.Find???\N")
    END(* if *);
    RETURN
  END;
  Implementation := gstreamIP(Stream^.Implementation);
(* Uncover hidden type                                                      *)
  Implementation^.Procedure^.Update(Stream);
(* aliter ... UpdateIP(Stream)                                              *)
(*dbgstore.analysis();*)
END Update;

BEGIN
  Dormant := TRUE;
  Debugging := FALSE;
  VirginDebug := TRUE;
(*dbgstore.init();*)
(*dbgstore.logging := TRUE;*)
END BBC.