(*******************************************************************) (** Release history: **) (** 17th January 1985 version 1.0.0 First port to new world **) (*******************************************************************) IMPLEMENTATION MODULE HP; (* Title: HP Device driver LastEdit: Wed Jan 9 14: 12: 11 1985 Author: Graham Toal Acorn Computers VLSI Design Aids Group *) IMPORT FileStream; IMPORT Dict; IMPORT Polysys; IMPORT Streams; IMPORT Strings; IMPORT rawHP; IMPORT rawPLOT; (********** Generic plot driver interface ****************) (** May be included in final version - but is here **) (** at the moment just to force re-compilation **) (*********************************************************) FROM Streams IMPORT ErrorCode, Stream; FROM SysStreams IMPORT sysOut, sysErr; FROM WriteF IMPORT WriteF0, WriteF1, WriteF2, WriteF3, S, H, R; 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; (* Later, add others *) FROM Polysys IMPORT POLYGON; FROM Storage IMPORT ALLOCATE, DEALLOCATE; FROM Strings IMPORT String; FROM ScanS IMPORT ParseF0, ParseF1, ParseF2, ParseF3, ParseF4; FROM Defaults IMPORT Contents; FROM SYSTEM IMPORT WORD; CONST MyStreamNo = 4; (* Magic number used to verify that a stream for this device driver was actually issued by this device driver *) TYPE DrawType = (Outline); HPTextHook = POINTER TO RECORD Temp: INTEGER; END; HPMarkerHook = POINTER TO RECORD Temp: INTEGER; END; HPCursorHook = POINTER TO RECORD Temp: INTEGER; END; OutlineColour = POINTER TO RECORD Name: String; Colour: [0..8]; Mark, Space: INTEGER; 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. *) (*-----------------------------------------------------*) HPColourHook = POINTER TO RECORD LineColour: [0..8]; CASE How: DrawType OF (*|*) Outline: Outline: OutlineColour END END; VAR Debugging,(* FALSE unless changed by 'Command' interface *) VirginDebug, Dormant: BOOLEAN; (* TRUE until first call to open an HP stream, at which point all the HP control structures are built. *) DefaultColour: HPColourHook; DefaultText: HPTextHook; DefaultCursor: HPCursorHook; DefaultOutlineColour: OutlineColour; DefaultLineColour: INTEGER; HPTextStyle,(* DICT [StyleName] OF TEXT *) HPCursor,(* DICT [CursorName] OF CURSOR *) HPMarker,(* DICT [MarkerName] OF MARKER *) HPColour,(* DICT [ColourName] OF [0..8] *) HPOutlineColour,(* DICT [LayerName] OF OutlineColour *) HPMaster(* DICT [DictName] OF DICT *) : DICT; (*------------------------------------------------------------------------*) (* TYPE CASTS: The only type casts allowed in this code are *) (* xxxIP( Implementation: xxx ) *) (* & HPxxxHook(DeviceHook: WORD) *) (*------------------------------------------------------------------------*) (*------------------------------------------------------------------------*) (* DEBUGGING PROCEDURES *) (*------------------------------------------------------------------------*) VAR NastyFudgeGlobal: Stream; PROCEDURE PrintHPColour(VAR Key: ARRAY OF CHAR; Val: WORD; VAR Count: WORD): BOOLEAN; CONST AndContinue = FALSE; BEGIN WriteF2(NastyFudgeGlobal, "device colour %S = %I\N", H(Key), Val); Count := WORD(INTEGER(Count) + 1); RETURN(AndContinue) END PrintHPColour; PROCEDURE PrintOutlineColour(VAR Key: ARRAY OF CHAR; Val: WORD; VAR Count: WORD): BOOLEAN; VAR Outline: OutlineColour; CONST AndContinue = FALSE; BEGIN Outline := OutlineColour(Val); WriteF2(NastyFudgeGlobal, "outline colour %S = %I\N", H(Key), Outline^.Colour); Count := WORD(INTEGER(Count) + 1); RETURN(AndContinue) END PrintOutlineColour; PROCEDURE DebugLineColours(S: GSTREAM); VAR Total: INTEGER; BEGIN NastyFudgeGlobal := S^.DiagStream; Total := 0; IF Dict.ForAllIn(HPColour, PrintHPColour, Total) THEN END; WriteF1(S^.DiagStream, "Total = %I\N", Total) END DebugLineColours; PROCEDURE DebugOutlineColours(S: GSTREAM); VAR Total: INTEGER; BEGIN NastyFudgeGlobal := S^.DiagStream; Total := 0; IF Dict.ForAllIn(HPOutlineColour, PrintOutlineColour, Total) THEN END; WriteF1(S^.DiagStream, "Total = %I\N", Total); END DebugOutlineColours; (*------------------------------------------------------------------------*) (* PLOTTER PROCEDURES *) (*------------------------------------------------------------------------*) TYPE KnownPlotters = (hp7220c, hp7585b); PlotterSet = SET OF KnownPlotters; din = (A0, A1, A2, A3, A4); Orientation = (default, vertical); PlotterState = POINTER TO RECORD ActualPenUp: BOOLEAN; Actualx, Actualy: INTEGER; Pendingx, Pendingy: INTEGER; ActualColour: INTEGER; PendingColour: INTEGER; DeviceType: KnownPlotters; PaperSize: din; How: Orientation END; (* These are effectively CONST arrays held in records: *) (* Initialised in HPGenesis *) ViewPort = RECORD Xl, Yb, Xr, Yt: INTEGER END; VAR A: ARRAY KnownPlotters OF ARRAY din OF ARRAY Orientation OF ViewPort; PROCEDURE DebugParams(S: GSTREAM); VAR Impl: gstreamIP; Dev: PlotterState; I, J: INTEGER; BEGIN Impl := gstreamIP(S^.Implementation); Dev := PlotterState(Impl^.DeviceState); (* Used for random tracing when debugging this code *) END DebugParams; (*------------------------------------------------------------------------*) PROCEDURE PlotterInit(Plotter: GSTREAM); VAR Impl: gstreamIP; Dev: PlotterState; BEGIN Impl := gstreamIP(Plotter^.Implementation); Dev := PlotterState(Impl^.DeviceState); Dev^.Actualx := -42; Dev^.Actualy := 17; Dev^.Pendingx := 0; Dev^.Pendingy := 0; Dev^.ActualColour := 0; Dev^.PendingColour := 1; rawHP.command(Impl^.OutStream, "PU;SP0;"); (* Should be in 'Surface()'? *) Dev^.ActualPenUp := TRUE; END PlotterInit; PROCEDURE PenSelect(Plotter: GSTREAM; Colour: INTEGER); VAR Impl: gstreamIP; Dev: PlotterState; BEGIN Impl := gstreamIP(Plotter^.Implementation); Dev := PlotterState(Impl^.DeviceState); Dev^.PendingColour := Colour; END PenSelect; PROCEDURE PenTo(Plotter: GSTREAM; X, Y: INTEGER); VAR Impl: gstreamIP; Dev: PlotterState; BEGIN Impl := gstreamIP(Plotter^.Implementation); Dev := PlotterState(Impl^.DeviceState); Dev^.Pendingx := X; Dev^.Pendingy := Y; END PenTo; PROCEDURE PenLine(Plotter: GSTREAM; X, Y: INTEGER); VAR Impl: gstreamIP; Dev: PlotterState; BEGIN Impl := gstreamIP(Plotter^.Implementation); Dev := PlotterState(Impl^.DeviceState); IF(Dev^.Actualx <> Dev^.Pendingx) OR(Dev^.Actualy <> Dev^.Pendingy) THEN IF NOT Dev^.ActualPenUp THEN rawHP.command(Impl^.OutStream, "PU;"); Dev^.ActualPenUp := TRUE; END; rawHP.command(Impl^.OutStream, "PA"); rawHP.sendxy(Impl^.OutStream, Dev^.Pendingx, Dev^.Pendingy); rawHP.char(Impl^.OutStream, ";"); END(* if *); IF Dev^.ActualColour <> Dev^.PendingColour THEN rawHP.command(Impl^.OutStream, "SP"); rawHP.integer(Impl^.OutStream, Dev^.PendingColour); rawHP.char(Impl^.OutStream, ";"); Dev^.ActualColour := Dev^.PendingColour END(* if *); IF Dev^.ActualPenUp THEN rawHP.command(Impl^.OutStream, "PD;"); Dev^.ActualPenUp := FALSE END; rawHP.command(Impl^.OutStream, "PA"); rawHP.sendxy(Impl^.OutStream, X, Y); rawHP.char(Impl^.OutStream, ";"); Dev^.Actualx := X; Dev^.Actualy := Y; Dev^.Pendingx := X; Dev^.Pendingy := Y END PenLine; PROCEDURE PenFlush(Plotter: GSTREAM); VAR Impl: gstreamIP; Dev: PlotterState; BEGIN Impl := gstreamIP(Plotter^.Implementation); Dev := PlotterState(Impl^.DeviceState); IF(Dev^.Actualx <> Dev^.Pendingx) OR(Dev^.Actualy <> Dev^.Pendingy) THEN rawHP.command(Impl^.OutStream, "PU;"); Dev^.ActualPenUp := TRUE; rawHP.command(Impl^.OutStream, "PA"); rawHP.sendxy(Impl^.OutStream, Dev^.Pendingx, Dev^.Pendingy); rawHP.char(Impl^.OutStream, ";"); END(* if *); IF Dev^.ActualColour <> Dev^.PendingColour THEN rawHP.command(Impl^.OutStream, "SP"); rawHP.integer(Impl^.OutStream, Dev^.PendingColour); rawHP.char(Impl^.OutStream, ";"); Dev^.ActualColour := Dev^.PendingColour END(* if *); IF Dev^.ActualPenUp THEN rawHP.command(Impl^.OutStream, "PD;"); Dev^.ActualPenUp := FALSE; END; WITH Dev^ DO Actualx := Pendingx; Actualy := Pendingy END; END PenFlush; PROCEDURE Label(Plotter: GSTREAM; Text: ARRAY OF CHAR); VAR Impl: gstreamIP; BEGIN Impl := gstreamIP(Plotter^.Implementation); rawHP.command(Impl^.OutStream, "LB"); WriteF0(Impl^.OutStream, Text); (* From FormatIO *) rawHP.char(Impl^.OutStream, CHAR(3)); END Label; PROCEDURE PlotterView(Plotter: GSTREAM); VAR Impl: gstreamIP; Dev: PlotterState; BEGIN Impl := gstreamIP(Plotter^.Implementation); Dev := PlotterState(Impl^.DeviceState); Dev^.ActualColour := 0; rawHP.command(Impl^.OutStream, "PU;SP0;"); Dev^.ActualPenUp := TRUE; IF Dev^.DeviceType IN PlotterSet{hp7585b} THEN rawHP.command(Impl^.OutStream, "NR;") ELSE rawHP.command(Impl^.OutStream, "PA"); rawHP.sendxy(Impl^.OutStream, 16000, 11400); rawHP.char(Impl^.OutStream, ";"); END(* if *); (* Flush output ??? *) Streams.Flush(Impl^.OutStream); IF Debugging THEN Streams.Flush(Plotter^.DiagStream) END; END PlotterView; (*------------------------------------------------------------------------*) (* INTERNAL PROCEDURES *) (*------------------------------------------------------------------------*) VAR HPDriver: gstreamIP; (*------------------------------------------------------------------------*) PROCEDURE ColourVal(Colour: String): INTEGER; (*******CRASH if not found *) VAR HPColourNo: INTEGER; BEGIN IF Dict.Found(HPColour, Colour, HPColourNo) THEN RETURN(HPColourNo) 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(HPOutlineColour, ColourS, Outline) THEN Strings.Dispose(ColourS); RETURN(Outline) END; END OutlineVal; (*------------------------------------------------------------------------*) PROCEDURE ReConfigure(); BEGIN (*********THIS SHOULD USE MOST OF THE INIT CODE(or vice-versa) *********) END ReConfigure; PROCEDURE HPGenesis(); (* Bring the HP world into being. *) PROCEDURE DefLColour(ColourName: ARRAY OF CHAR; ColourNo: INTEGER); BEGIN Dict.Enter(HPColour, ColourName, KeyAttr{}, ColourNo) END DefLColour; PROCEDURE DefOutline(LayerName, ColourName: ARRAY OF CHAR); VAR Outline: OutlineColour; lineStyleStr, tempStr, ColourNameSTR: String; BEGIN ColourNameSTR := Strings.CopyCS(ColourName); IF ParseF2("^[A-Za-z]_^[A-Za-z]", ColourNameSTR, "%^0", lineStyleStr, "%^1", tempStr) THEN Strings.Dispose(ColourNameSTR); (* IS THIS EVER CALLED? - not yet. *) ColourNameSTR := tempStr; ELSE lineStyleStr := Strings.CopyCS("solid") END(* if *); NEW(Outline); IF Dict.FoundWith(KeyAttr{ExactLength}, HPColour, ColourNameSTR, Outline^.Colour) THEN Outline^.Name := ColourNameSTR; IF Strings.EqualCS("dotted", lineStyleStr) THEN Outline^.Mark := 1; Outline^.Space := 1 ELSIF Strings.EqualCS("dotdash", lineStyleStr) THEN Outline^.Mark := 3; Outline^.Space := 1 ELSIF Strings.EqualCS("solid", lineStyleStr) THEN Outline^.Mark := 1; Outline^.Space := 0 ELSE (* Internal error - invalid style shouldn't get this far. *) END(* if *); (* DO NOT dispose ColourNameSTR when leaving in dictionary *) ELSE (* Soft error??? *) IF Debugging THEN (* Write an errormessage to the debug stream - except it hasn't yet been defined as we are still in HPGenesis. Maybe we should open the file and plug in the DiagStream early just to make this possible? *) END(* if *); Strings.Dispose(ColourNameSTR); Outline := DefaultOutlineColour (*********** NOTE: While building tables, you DO want to crash out with an error if the ColourName is not found. Only return a soft error when the operation is by user-supplied data. This is not currently the case, so the tables should be checked for uninitialised values creeping in in this way. *) END; Dict.Enter(HPOutlineColour, LayerName, KeyAttr{}, Outline) END DefOutline; VAR DevName: String; pdev: KnownPlotters; imp: din; orient: Orientation; strDict: DICT; BEGIN (* First initialise const record arrays *) FOR pdev := hp7220c TO hp7585b DO FOR imp := A0 TO A4 DO FOR orient := default TO vertical DO WITH A [pdev] [imp] [orient] DO Xl := 0; Yb := 0; Xr := 16000; Yt := 11400 END END(* for *); END(* for *); END(* for *); (* KnownPlotters din Orientation ViewPort *) A [hp7220c] [A3] [default].Xl := 0; A [hp7220c] [A3] [default].Yb := 0; A [hp7220c] [A3] [default].Xr := 16000; A [hp7220c] [A3] [default].Yt := 11400; A [hp7220c] [A4] [default].Xl := 0; A [hp7220c] [A4] [default].Yb := 0; A [hp7220c] [A4] [default].Xr := 16000; A [hp7220c] [A4] [default].Yt := 11400; A [hp7585b] [A4] [default].Xl := -2700; A [hp7585b] [A4] [default].Yb := -4830; A [hp7585b] [A4] [default].Xr := 2700; A [hp7585b] [A4] [default].Yt := 4830; A [hp7585b] [A3] [default].Xl := -6780; A [hp7585b] [A3] [default].Yb := -4830; A [hp7585b] [A3] [default].Xr := 6780; A [hp7585b] [A3] [default].Yt := 4830; A [hp7585b] [A2] [default].Xl := -6875; A [hp7585b] [A2] [default].Yb := -10785; A [hp7585b] [A2] [default].Xr := 6875; A [hp7585b] [A2] [default].Yt := 10785; A [hp7585b] [A1] [default].Xl := -15120; A [hp7585b] [A1] [default].Yb := -10760; A [hp7585b] [A1] [default].Xr := 15120; A [hp7585b] [A1] [default].Yt := 10760; A [hp7585b] [A0] [default].Xl := -22190; A [hp7585b] [A0] [default].Yb := -15740; A [hp7585b] [A0] [default].Xr := 22190; A [hp7585b] [A0] [default].Yt := 15740; NEW(HPDriver); NEW(HPDriver^.Procedure); HPDriver^.StreamNo := MyStreamNo; (* Fill in all the fields with the implementation procedures *) HPDriver^.Procedure^.Colour := ColourIP; HPDriver^.Procedure^.TextStyle := TextStyleIP; HPDriver^.Procedure^.Marker := MarkerIP; HPDriver^.Procedure^.Cursor := CursorIP; HPDriver^.Procedure^.SetLineColour := SetLineColourIP; HPDriver^.Procedure^.SetAreaColour := SetAreaColourIP; HPDriver^.Procedure^.SetTextStyle := SetTextStyleIP; HPDriver^.Procedure^.SetCursor := SetCursorIP; HPDriver^.Procedure^.Surface := SurfaceIP; HPDriver^.Procedure^.Command := CommandIP; HPDriver^.Procedure^.MoveTo := MoveToIP; HPDriver^.Procedure^.LineTo := LineToIP; HPDriver^.Procedure^.MarkerAt := MarkerAtIP; HPDriver^.Procedure^.Box := BoxIP; HPDriver^.Procedure^.TextAt := TextAtIP; HPDriver^.Procedure^.TextBox := TextBoxIP; HPDriver^.Procedure^.DrawPolygon := DrawPolygonIP; HPDriver^.Procedure^.ReadCursor := ReadCursorIP; HPDriver^.Procedure^.Delete := DeleteIP; HPDriver^.Procedure^.Update := UpdateIP; (*---------------------------------------------------------------------*) HPMaster := Dict.NewDict("hp"); Dict.Enter(Contents, "hp", KeyAttr{}, HPMaster); strDict := Dict.NewDict("strings"); Dict.Enter(HPMaster, "strings", KeyAttr{}, strDict); DevName := Strings.CopyCS("/dev/hp"); Dict.Enter(strDict, "output_file", KeyAttr{}, DevName); (*---------------------------------------------------------------------*) HPTextStyle := Dict.NewDict("text"); Dict.Enter(HPMaster, "text", KeyAttr{}, HPTextStyle); (* Styles are demand-driven. No point in inventing unused features. *) (*---------------------------------------------------------------------*) NastyFudgeGlobal := sysErr; HPColour := Dict.NewDict("colour"); Dict.Enter(HPMaster, "colour", KeyAttr{}, HPColour); DefLColour("black", 1); DefLColour("red", 2); DefLColour("green", 3); DefLColour("blue", 4); DefLColour("brown", 5); DefLColour("turquoise", 6); DefLColour("gold", 7); DefLColour("violet", 8); DefaultLineColour := 1; (* Red *) HPColour^.Silent := TRUE; (*------------------------------------------------------------------------*) HPOutlineColour := Dict.NewDict("outline"); Dict.Enter(HPMaster, "outline", KeyAttr{}, HPOutlineColour); DefOutline("bbox", "black"); DefOutline("contact", "black"); DefOutline("drcerror", "red"); DefOutline("glass", "brown"); DefOutline("metal", "blue"); DefOutline("metaltwo", "turquoise"); DefOutline("ndiff", "red"); DefOutline("nimpcd", "gold"); DefOutline("nwell", "brown"); DefOutline("pdiff", "violet"); DefOutline("pimpcd", "brown"); DefOutline("poly", "green"); DefOutline("polytwo", "green"); DefOutline("pwell", "gold"); DefOutline("via", "black"); DefOutline("contaccd", "black"); DefOutline("fieldcd", "red"); DefOutline("glasscd", "black"); DefOutline("metalcd", "blue"); DefOutline("npluscd", "red"); DefOutline("nwellcd", "brown"); DefOutline("ppluscd", "violet"); DefOutline("polycd", "green"); DefOutline("pwellcd", "gold"); DefOutline("black", "black"); DefOutline("red", "red"); DefOutline("green", "green"); DefOutline("blue", "blue"); DefOutline("brown", "brown"); DefOutline("turquoise", "turquoise"); DefOutline("gold", "gold"); DefOutline("violet", "violet"); DefOutline("dotted_green", "green"); (****** TESTING A NEW MECHANISM *) DefaultOutlineColour := OutlineVal("green"); HPOutlineColour^.Silent := TRUE; (*------------------------------------------------------------------------*) NEW(DefaultColour); (**************** Keep up to date ****************) DefaultColour^.LineColour := DefaultLineColour; DefaultColour^.How := Outline; DefaultColour^.Outline := DefaultOutlineColour; NEW(DefaultCursor); DefaultCursor^.Temp := -1; NEW(DefaultText); DefaultText^.Temp := -1 END HPGenesis; (*------------------------------------------------------------------------*) (* 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 '' and ' outline', then choose Style as appropriate.(AreaFill or Outline) *) VAR NewColour: COLOUR; newcolour: colourIP; LineColour: INTEGER; OutlineC: OutlineColour; tempStr, StyleS, ColourS: String; Pre, Post: String; AreaType: DrawType; ColourHook: HPColourHook; BEGIN tempStr := Strings.CopyCS(ColourC); IF NOT ParseF2("^@* ^@", tempStr, "%^0", ColourS, "%^1", StyleS) THEN ColourS := Strings.CopyCS(ColourC); StyleS := Strings.CopyCS("outline"); END(* if *); Strings.Dispose(tempStr); AreaType := Outline; (*-----------------------------------------------*) (* Construct pair of *) (* 1) Line-drawing colour *) (* and *) (* 2) Outline colour to be used. *) (*-----------------------------------------------*) (*---------------------------------------------------------------------*) IF Dict.Found(HPColour, ColourS, LineColour) THEN ELSE LineColour := DefaultLineColour(* Soft error ??? *); IF Debugging THEN WriteF1(Stream^.DiagStream, "*** Warning: HP.Colour('%S') not recognised as line colour\N", S(ColourS)) END(* if *); END(* if *); (*---------------------------------------------------------------------*) IF NOT(Dict.Found(HPOutlineColour, ColourS, OutlineC)) THEN OutlineC := DefaultOutlineColour; IF Debugging THEN WriteF1(Stream^.DiagStream, "*** Warning: HP.Colour('%S') not recognised as outline colour\N", S(ColourS)) END(* if *); END; (*---------------------------------------------------------------------*) Strings.Dispose(ColourS); (* Combine LineColour & Outline into a HPColourHook(with Name) & return*) NEW(ColourHook); ColourHook^.LineColour := LineColour; ColourHook^.How := AreaType; CASE AreaType OF (*|*) 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(HPTextStyle, TextS, Text) THEN (* HPTextStyle 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(HPMarker, 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(HPCursor, 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: HPColourHook; BEGIN (* Copy the LineColour field only, from the colour token *) Colour := colourIP(Co^.Implementation); Hook := HPColourHook(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 := HPColourHook(Colour^.DeviceHook); Hook^.LineColour := NewLineColour; PenSelect(Stream, NewLineColour); END SetLineColourIP; PROCEDURE SetAreaColourIP(Stream: GSTREAM; Co: COLOUR); VAR CurrentColour, NewColour: colourIP; CurrentHook, NewHook: HPColourHook; BEGIN NewColour := colourIP(Co^.Implementation); NewHook := HPColourHook(NewColour^.DeviceHook); CurrentColour := colourIP(Stream^.Colour^.Implementation); CurrentHook := HPColourHook(CurrentColour^.DeviceHook); (** = 0 ??? **) (* Copy area fields from NewHook to CurrentHook *) CurrentHook^.How := NewHook^.How; CASE NewHook^.How OF (*|*) Outline: CurrentHook^.Outline := NewHook^.Outline; (***** Don't this colour - drawpolygon will select it and replace it after use with the current line colour *) 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: INTEGER; Impl: gstreamIP; Plotter: PlotterState; BEGIN IF Xl > Xr THEN I := Xl; Xl := Xr; Xr := I END(* if *); IF Yb > Yt THEN I := Yb; Yb := Yt; Yt := I END(* if *); WITH Stream^ DO Impl := gstreamIP(Stream^.Implementation); Plotter := PlotterState(Impl^.DeviceState); WITH Plotter^ DO vxl := A [DeviceType] [PaperSize] [How].Xl; vyb := A [DeviceType] [PaperSize] [How].Yb; vxr := A [DeviceType] [PaperSize] [How].Xr; vyt := A [DeviceType] [PaperSize] [How].Yt END; (* Note: 1 000 000u = 1m, 1000u = 1 mm *) (* At scale 1000,(i.e. 1u -> 1mm) px = cx * 100 / 40 *) (* because 1 u = 100 c.u., and 1 mm = 40 p.u. at that scale *) (* And at scale 100, px = cx *(100 / 40) / 10 *) (* because 10u = 1mm at that scale *) (* Xr, Yt co-ords are redundant - we calculate the window size from the scale factor. We can. however, calculate the centre of the area and adjust accordingly *) (* xl := Xl; yb := Yb; xr := xl+vxr-vxl; yt := yb+vyt-vyb; *) xl := Xl; yb := Yb; xr := Xr; yt := Yt; (* clip parameters to allowable window, set up scale factor *) lastx := xl; lasty := yb; x := lastx; y := lasty; IF(Xr-Xl > 07FFFH) OR(Yt-Yb > 07FFFH) THEN (* Enlarge surface around centre point to force scaling to viewport... ONLY IF small plotter requested... *) END(* if *); rawHP.command(Impl^.OutStream, "IP"); rawHP.sendxy(Impl^.OutStream, vxl, vyb); rawHP.char(Impl^.OutStream, ","); rawHP.sendxy(Impl^.OutStream, vxr, vyt); rawHP.char(Impl^.OutStream, ";"); rawHP.command(Impl^.OutStream, "SC;"); END; END SurfaceIP; PROCEDURE CommandIP(Stream: GSTREAM; Comm: ARRAY OF CHAR): INTEGER; VAR subTypeStr, devNoStr, CommandLine, Command, Param: String; Impl: gstreamIP; Dev: PlotterState; devNo: 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 plotFileStr: String; plotFile: ARRAY [0..255] OF CHAR; BEGIN Impl := gstreamIP(Stream^.Implementation); Dev := PlotterState(Impl^.DeviceState); CommandLine := Strings.CopyCS(Comm); IF Debugging THEN WriteF1(Stream^.DiagStream, "Command('%S')\N", S(CommandLine)) END(* if *); IF ParseF0("* view", CommandLine) THEN PlotterView(Stream); RETURN(-11) END(* if *); IF ParseF0("* debug* on", CommandLine) THEN IF VirginDebug THEN Stream^.DiagStream := FileStream.CreateOutput("graphics.debug"); IF Stream^.DiagStream^.status <> Success THEN Stream^.DiagStream := sysErr; END; VirginDebug := FALSE END(* if *); Debugging := TRUE; RETURN(-2) ELSIF ParseF0("* debug* off", CommandLine) THEN IF Debugging THEN Streams.Flush(Stream^.DiagStream) END; Debugging := FALSE; RETURN(-3) ELSIF ParseF0("* debug* tables", CommandLine) THEN DebugLineColours(Stream); DebugOutlineColours(Stream); RETURN(-1) ELSIF ParseF0("* debug* params", CommandLine) THEN DebugParams(Stream); RETURN(-1) ELSIF ParseF1("to^ ^.", CommandLine, "%^1", plotFileStr) THEN Impl := gstreamIP(Stream^.Implementation); Streams.Delete(Impl^.OutStream); Strings.CopySC(plotFileStr, plotFile); Impl^.OutStream := FileStream.CreateOutput(plotFile); IF Stream^.DiagStream^.status <> Success THEN Stream^.DiagStream := sysErr; END; PlotterInit(Stream); END(* if *); (***** The sequence below should be replaced by one which plucks out the number, and then does a VAL(..., ...) to it. *****) IF ParseF0("* paper* A0", CommandLine) OR ParseF0("* A0", CommandLine) THEN Dev^.PaperSize := A0; RETURN(-5) ELSIF ParseF0("* paper* A1", CommandLine) OR ParseF0("* A1", CommandLine) THEN Dev^.PaperSize := A1; RETURN(-5) ELSIF ParseF0("* paper* A2", CommandLine) OR ParseF0("* A2", CommandLine) THEN Dev^.PaperSize := A2; RETURN(-5) ELSIF ParseF0("* paper* A3", CommandLine) OR ParseF0("* A3", CommandLine) THEN Dev^.PaperSize := A3; RETURN(-5) ELSIF ParseF0("* paper* A4", CommandLine) OR ParseF0("* A4", CommandLine) THEN Dev^.PaperSize := A4; RETURN(-5) END(* if *); IF ParseF1("* scale* ^#", CommandLine, "%^0", Param) THEN Stream^.ScaleFactor := StoI(Param); RETURN(-6) END(* if *); IF ParseF2("* device* hp^#[A-Za-z]", CommandLine, "%^0", devNoStr, "%[0", subTypeStr) OR ParseF2("* hp^#[A-Za-z]", CommandLine, "%^0", devNoStr, "%[0", subTypeStr) THEN devNo := StoI(devNoStr); IF(devNo = 7220) AND(subTypeStr^[0] = "c") THEN Dev^.DeviceType := hp7220c; RETURN(-7) END(* if *); IF(devNo = 7585) AND(subTypeStr^[0] = "b") THEN Dev^.DeviceType := hp7585b; RETURN(-7) END(* if *); IF devNo DIV 100 = 75 THEN Dev^.DeviceType := hp7585b; RETURN(-7) END(* if *); IF devNo DIV 100 = 72 THEN Dev^.DeviceType := hp7220c; RETURN(-7) END(* if *); END(* if *); IF ParseF0("* device* hp", CommandLine) OR ParseF0("* hp", CommandLine) THEN Dev^.DeviceType := hp7220c; RETURN(-7) END; IF ParseF0("* device* bighp", CommandLine) OR ParseF0("* bighp", CommandLine) THEN Dev^.DeviceType := hp7585b; RETURN(-7) END; IF ParseF0("* xon* xoff", CommandLine) THEN rawHP.control(Impl^.OutStream, "Y"); rawHP.control(Impl^.OutStream, "N"); rawHP.command(Impl^.OutStream, "; 19: "); rawHP.control(Impl^.OutStream, "I"); rawHP.command(Impl^.OutStream, "81; ; 17: "); RETURN(-9) END(* if *); IF Debugging THEN WriteF1(Stream^.DiagStream, "*** Warning: HP.Command('%S') not known?\N", H(Comm)) END(* if *); 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; (* Plotter units = Chip units * Scale factor / 2500 *) BEGIN IF Debugging THEN WriteF1(Env^.DiagStream, " Scale(%I) -> ", X) END(* if *); WITH Env^ DO DebugStep := ((X - xl) * ScaleFactor DIV 2500) + vxl; IF Debugging THEN WriteF1(Env^.DiagStream, "%I", DebugStep); WriteF2(Env^.DiagStream, "(xl = %I, vxl = %I)\N", vxl, vxl); END(* if *); RETURN(DebugStep) END END ScaleX; PROCEDURE ScaleY(Env: GSTREAM; Y: INTEGER): INTEGER; VAR DebugStep: INTEGER; BEGIN IF Debugging THEN WriteF1(Env^.DiagStream, " Scale(%I) -> ", Y) END(* if *); WITH Env^ DO DebugStep := ((Y - yb) * ScaleFactor DIV 2500) + vyb; IF Debugging THEN WriteF1(Env^.DiagStream, "%I", DebugStep); WriteF2(Env^.DiagStream, "(yb = %I, vyb = %I)", yb, vyb); END(* if *); RETURN(DebugStep) END END ScaleY; 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, " MoveTo(%I, %I)\N", x, y) END(* if *); PenTo(Stream, 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, " PenLine(%I, %I)\N", x, y) END(* if *); PenLine(Stream, 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); BEGIN (********************************) (* MoveTo(X, Y); WriteCh("*") *) 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); PenTo(Stream, x, y); Label(Stream, Text); PenTo(Stream, x, y); WITH Stream^ DO lastx := x; lasty := y END; Stream^.x := x; Stream^.y := 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; BEGIN xl := ScaleX(Stream, Xl); yb := ScaleY(Stream, Yb); xr := ScaleX(Stream, Xr); yt := ScaleY(Stream, Yt); PenTo(Stream, xl, yb); PenLine(Stream, xl, yt); PenLine(Stream, xr, yt); PenLine(Stream, xr, yb); PenLine(Stream, xl, yb); WITH Stream^ DO lastx := x; lasty := y; END; Stream^.x := xl; Stream^.y := yb; END BoxIP; PROCEDURE TextBoxIP(Stream: GSTREAM; Xl, Yb, Xr, Yt: INTEGER; Text: ARRAY OF CHAR); VAR textWidth, xl, yb, xr, yt: INTEGER; Impl: gstreamIP; Dev: PlotterState; BEGIN Impl := gstreamIP(Stream^.Implementation); Dev := PlotterState(Impl^.DeviceState); xl := ScaleX(Stream, Xl); yb := ScaleY(Stream, Yb); xr := ScaleX(Stream, Xr); yt := ScaleY(Stream, Yt); PenTo(Stream, xl, yb); PenLine(Stream, xl, yt); PenLine(Stream, xr, yt); PenLine(Stream, xr, yb); PenLine(Stream, xl, yb); textWidth := 0; (*** TEMP ***) IF Dev^.DeviceType IN PlotterSet{hp7585b} THEN PenTo(Stream,(xl+xr) DIV 2,(yb+yt) DIV 2); PenFlush(Stream); rawHP.command(Impl^.OutStream, "LO15;"); Label(Stream, Text); rawHP.command(Impl^.OutStream, "LO;"); ELSE PenTo(Stream, xl, yb); (**** Need to know character size, then create clip-window. ****) Label(Stream, Text); END; PenTo(Stream, xl, yb); WITH Stream^ DO lastx := x; lasty := y; END; Stream^.x := xl; Stream^.y := yb 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); BEGIN 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 DrawPolygonIP(Stream: GSTREAM; Polygon: POLYGON); VAR Colour: colourIP; HPHook: HPColourHook; BEGIN Colour := colourIP(Stream^.Colour^.Implementation); HPHook := HPColourHook(Colour^.DeviceHook); IF HPHook^.How = Outline THEN IF Debugging THEN WriteF0(Stream^.DiagStream, " Putoutline\N") END(* if *); WITH HPHook^.Outline^ DO IF Debugging THEN WriteF1(Stream^.DiagStream, " HP outline colour = %I\N", Colour) END; PenSelect(Stream, Colour) END; Polysys.putpolygon(Polygon, PolyOutline, Stream); PenSelect(Stream, HPHook^.LineColour) (* Replace real line colour *) END(* if *); END DrawPolygonIP; PROCEDURE DeleteIP(Stream: GSTREAM); VAR Impl: gstreamIP; BEGIN Impl := gstreamIP(Stream^.Implementation); PlotterView(Stream); Streams.Delete(Impl^.OutStream); IF Debugging THEN Streams.Delete(Stream^.DiagStream) END; (* EXECUTE REVERSE OF FINDOUTPUT 'NEW'S *) DISPOSE(Stream); END DeleteIP; PROCEDURE UpdateIP(Stream: GSTREAM); VAR Impl: gstreamIP; BEGIN Impl := gstreamIP(Stream^.Implementation); Streams.Flush(Impl^.OutStream); IF Debugging THEN Streams.Flush(Stream^.DiagStream) END; END UpdateIP; (*------------------------------------------------------------------------*) (* VISIBLE PROCEDURES *) (*------------------------------------------------------------------------*) PROCEDURE FindOutput(Qual: ARRAY OF CHAR; File: ARRAY OF CHAR): GSTREAM; VAR NewStream: GSTREAM; Implementation: gstreamIP; DevState: PlotterState; ColourIP: colourIP; TextIP: textIP; CursorIP: cursorIP; DefStr: String; I: INTEGER; BEGIN NEW(NewStream); NewStream^.DiagStream := FileStream.CreateOutput("/dev/null"); IF Dormant THEN HPGenesis(); Dormant := FALSE END; NEW(NewStream^.Colour); NEW(Implementation); 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); (*------------------------------------------------------------------------*) (* look-up plotter co-ordinates according to 'Qual' *) (* valid 'Qual's are hp7220c and hp7585b, *) (* with optional paper sizes 'A0 to A4', and optional *) (* keyword 'rotated' *) (* These qualifiers may alternatively by given by a *) (* call to 'Command' BEFORE Surface is called. *) (* Defaults will probably be hp7720c, not rotated A3. *) WITH NewStream^ DO vxl := 0; vyb := 0; vxr := 10000; vyt := 10000 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; WITH NewStream^ DO ScaleFactor := 1000 END; (********* NOTE: These are filled in as an emergency backstop for the case when someone forgets to call 'Surface'. It is intended that 'Surface' should re-calculate the scaling parameters. This gives it time to have accepted the 'Command("rotated A4")' calls... *) (*------------------------------------------------------------------------*) Implementation^.StreamNo := MyStreamNo; Implementation^.Procedure := HPDriver^.Procedure; NewStream^.Implementation := gstream(Implementation); (*--------------------- Set up diag stream -------------------------*) NEW(DevState); WITH DevState^ DO DeviceType := hp7220c; PaperSize := A3; How := default; END; Implementation^.DeviceState := WORD(DevState); Implementation^.OutStream := FileStream.CreateOutput(File); IF Implementation^.OutStream^.status <> Success THEN WriteF0(sysOut, "HP: cannot open output file\N"); Streams.Flush(sysOut) END(* if *); I := CommandIP(NewStream, Qual); (* Pass the buck *) PlotterInit(NewStream); (* DOES THIS SEND ANYTHING - SHOULDN'T *) RETURN(NewStream)(* ALL IO Should be in first call to Surface() *) END FindOutput; PROCEDURE Delete(Stream: GSTREAM); VAR Implementation: gstreamIP; BEGIN IF Dormant THEN (* Non-fatal error *) IF Debugging THEN WriteF0(Stream^.DiagStream, "*** Error: HP.Delete called before HP.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: HP.Update called before HP.Find??\N") END(* if *); RETURN END; Implementation := gstreamIP(Stream^.Implementation); (* Uncover hidden type *) Implementation^.Procedure^.Update(Stream) (* aliter ... UpdateIP(Stream) *) END Update; BEGIN Dormant := TRUE; Debugging := FALSE; VirginDebug := TRUE; END HP.