The ModulaTor logo 7KB

The ModulaTor

Oberon-2 and Modula-2 Technical Publication

Erlangen's First Independent Modula_2 Journal! Nr. 8&9, Sep/Oct-1993


Oberon-2 Programming under Mithril V2.0

This is an extract from the OM2 User's Guide (Chap. XIII and IX). All definition modules referenced are listed in Annex 1 below.

I. Mithril

Copyright (1993) by Günter Dotzel, ModulaWare

Mithril is an optional integrated development environment (IDE), graphical user interface (GUI) and application programming interface (API) for OM2. If used in combination with the stand-alone version of OM2 (product code of the DOS version is OM2-sd), programs can be compiled, dynamically linked-loaded-executed and debugged from within Mithril.

Mithril's roots are the Oberon System [Wirth 89] which is written in Oberon. The main differences between the two systems are shown in I.1.


I.1. Differences between Mithril and the Oberon System
The technical design details of Mithril are described in ModulaWare's Modula-2 and Oberon-2 Technical Journal, called The ModulaTor, issue 7/92 (see literature in XI.4 of the OM2 Manual).
I.2. The Use of Mithril (getting started)

Mithril is started by typing


>Mithril 
at the DOS prompt in a DOS-session. This command (batch file) loads and starts the Mithril-GUI and by default places the system log window on the right-hand track of the screen window. The Oberon-2 compiler is invoked by marking a text window which contains the program source to be compiled by moving the mouse to the top-right corner of the window title bar and clicking the left mouse-button. Then move the cursor over to the command "xc.o2 *" and press the middle mouse-button. To use the Modula-2 compiler, execute the "xc m2 *" command.

The compiler generates load files with the extensions .ldf. As with the stand-alone version of OM2, program linking is not required. Modules are loaded when they are first referenced and remain loaded. If an already loaded module is modified and recompiled, it must first be explicitly unloaded in order to load and execute the new version. This is done by pressing the middle mouse-button and inter-clicking the left button at a command.

Mithril needs a three button mouse and when using Mithril on a '386 processor system, a floating-point coprocessor is currently required. The middle mouse button needs special treatment under OS/2.

The replacement keys for the mouse buttons are as follows:

Set text caret somewhere in the text of a command (or before an icon) and press


           ^+ENTER             - middle button
           ^+ENTER+LEFT SHIFT  - middle + left interclick
           ^+ENTER+RIGHT SHIFT - middle + right interclick
where ^+ENTER means: press the CONTROL key and in addition the ENTER key.
I.3. The Use of Mithril Environment Library

The Mithril API definition modules, which by the way are generated with the compiler's browser option are listed below. The browser is not a separate tool which reads the symbol files as it is done in the ETH Oberon System. The OM2 compiler optionally generates the definition module from the Oberon-2 or Modula-2 source code in Oberon-2 notation. It is even possible to extract specially marked comments from the source to the definition to get automatic annotations.

The following illustration shows the architecture of outer Mithril core along with short description of each module. Note: "Main" corresponds to the "Oberon" module in ETH oberon system.


                     Errors

                     Objects

        Fonts  Attrs DynStr  Closure Modules

       Display                       Stores

          Windows
                          Input

                      Main

Errors Error codes Objects Object, Message, Stream, Rider, Mapper (abstractions) Attrs Attributes DynStr Stream base on dynamic strings Closure Finalization and non-traced lists Modules Loader and meta-language facilities Fonts Fonts (abstractions) Display PixelMap, Tool, Marker (abstractions) Stores standard Mapper(Objects.Mapper) Windows Window manager Input Mouse and Keyboard Main Main.Loop
Three short Oberon-2 programming examples are included for illustration how to use the Mithril API.

IFS



(** Based on the source text from M.Reiser, N.Wirth "Programming in Oberon" *) (** Mithril v2.0 *) MODULE IFS; IMPORT RandomNumbers, In, Out, XYplane, Main, Objects; TYPE MessageRef = POINTER TO Message; Message = RECORD (Objects.Message) END; Handler = POINTER TO HandlerDesc; HandlerDesc = RECORD (Objects.ObjectDesc) msg: MessageRef; END; VAR a1,b1,c1,d1,e1,f1,p1: REAL; a2,b2,c2,d2,e2,f2,p2: REAL; a3,b3,c3,d3,e3,f3,p3: REAL; a4,b4,c4,d4,e4,f4,p4: REAL; X,Y: REAL; x0,y0: INTEGER; e: INTEGER; col: LONGINT; initialized,continue: BOOLEAN; PROCEDURE Step*; VAR x,y: REAL; xi,eta,i: INTEGER; rn: REAL; BEGIN FOR i:=0 TO 99 DO rn:=RandomNumbers.Uniform(); IF rn<p1 THEN x:=a1*X+b1*Y+e1; y:=c1*X+d1*Y+f1; ELSIF rn<(p1+p2) THEN x:=a2*X+b2*Y+e2; y:=c2*X+d2*Y+f2; ELSIF rn<(p1+p2+p3) THEN x:=a3*X+b3*Y+e3; y:=c3*X+d3*Y+f3; ELSE x:=a4*X+b4*Y+e4; y:=c4*X+d4*Y+f4; END; X:=x; xi:=x0+SHORT(ENTIER(X*e)); Y:=y; eta:=y0+SHORT(ENTIER(Y*e)); (* XYplane.Dot(xi,eta,XYplane.draw); *) XYplane.ColorDot(xi,eta,col); END; END Step; PROCEDURE (o: Handler) Handle(VAR M: Objects.Message); BEGIN WITH M: Message DO Step; IF continue THEN Main.Enqueue(Main.TaskQueue,o.msg,o,0) END; ELSE END; END Handle; PROCEDURE Draw*; VAR o: Handler; BEGIN IF ~ initialized THEN RETURN END; NEW(o); NEW(o.msg); continue:=TRUE; Main.Enqueue(Main.TaskQueue,o.msg,o,0); END Draw; PROCEDURE Stop*; BEGIN continue:=FALSE; END Stop; PROCEDURE Init*; BEGIN X:=0; Y:=0; In.Open; In.Int(x0); In.Int(y0); In.Int(e); In.Real(a1); In.Real(a2); In.Real(a3); In.Real(a4); In.Real(b1); In.Real(b2); In.Real(b3); In.Real(b4); In.Real(c1); In.Real(c2); In.Real(c3); In.Real(c4); In.Real(d1); In.Real(d2); In.Real(d3); In.Real(d4); In.Real(e1); In.Real(e2); In.Real(e3); In.Real(e4); In.Real(f1); In.Real(f2); In.Real(f3); In.Real(f4); In.Real(p1); In.Real(p2); In.Real(p3); In.Real(p4); IF In.Done THEN XYplane.Open; initialized:=TRUE; ELSE Out.String("Parameter error"); Out.Ln; END; END Init; PROCEDURE SetColor*; VAR c: LONGINT; BEGIN In.Open; In.LongInt(c); IF In.Done THEN col:=c END; END SetColor; BEGIN initialized:=FALSE; continue:=FALSE; col:=0; END IFS.
RandomNumbers


(* From M.Raiser, N.Wirth "Programming in Oberon" *) MODULE RandomNumbers; VAR z: LONGINT; PROCEDURE Uniform*(): REAL; CONST a = 16807; m = 2147483647; q = m DIV a; r = m MOD a; VAR gamma: LONGINT; BEGIN gamma:=a*(z MOD q) - r*(z DIV q); IF gamma>0 THEN z:=gamma ELSE z:=gamma+m END; RETURN z*(1.0/m) END Uniform; PROCEDURE InitSeed*(seed: LONGINT); BEGIN z:=seed; END InitSeed; BEGIN z:=314159; END RandomNumbers.
In

(** Based on the source text from M.Reiser, N.Wirth "Programming in Oberon" *)

(** Mithril v2.0 *)
MODULE In;

IMPORT
   TextRiders
  ,Windows
  ,TextWindows
  ,Utils
  ,Viewers
  ,Out
  ;

VAR
  Done*: BOOLEAN;
  R: TextRiders.Rider;

PROCEDURE Open*;
  VAR M: TextWindows.SelectionMsg; v: Windows.Window;
      S: TextRiders.Symbol;
BEGIN
  Utils.SetToPar(R);
  R.Scan(S);
  IF (S.class=TextRiders.Char) & (S.c="^") THEN
    TextWindows.GetSelection(M);
    IF M.stamp>=0 THEN
      M.text.Set(R,M.beg);
      Done:=~ R.eos;
    ELSE
      Out.String("No selection"); Out.Ln;
      Done:=FALSE;
    END;
  ELSIF (S.class=TextRiders.Char) & (S.c="*") THEN
    v:=Viewers.Marked();
    IF v=NIL THEN
      Out.String("No marked window\n"); Out.Ln; Done:=FALSE;
    ELSE
      v:=Utils.Lookup(v,Utils.WORK,TRUE);
      IF (v=NIL) OR ~ (v IS TextWindows.Window) THEN
        Out.String("Marked viewer is not a text viewer\n"); Out.Ln;
        Done:=FALSE;
      ELSE
        v(TextWindows.Window).text.Set(R,0); Done:=~ R.eos;
      END;
    END;
  ELSE
    Utils.SetToPar(R);
    Done:=TRUE;
  END;
END Open;

PROCEDURE Char*(VAR ch: CHAR);
BEGIN
  IF Done THEN
    R.Read(ch); Done:=~ R.eos;
  END;
END Char;

PROCEDURE Int*(VAR i: INTEGER);
BEGIN
  IF Done THEN
    R.ReadInt(i);
    Done:=~ R.eos & (R.conv=TextRiders.ok);
  END;
END Int;

PROCEDURE LongInt*(VAR i: LONGINT);
BEGIN
  IF Done THEN
    R.ReadLongInt(i);
    Done:=~ R.eos & (R.conv=TextRiders.ok);
  END;
END LongInt;

PROCEDURE Real*(VAR x: REAL);
BEGIN
  IF Done THEN
    R.ReadReal(x);
    Done:=~ R.eos & (R.conv=TextRiders.ok);
  END;
END Real;

PROCEDURE Name*(VAR nme: ARRAY OF CHAR);
(** Read a name such as Syntax.Scn.Fnt from input stream *)
  VAR S: TextRiders.Symbol;
BEGIN
  IF Done THEN
    R.Scan(S);
    Done:=S.class=TextRiders.Name;
    IF Done THEN COPY(S.str,nme) ELSE nme[0]:=0X END;
  END;
END Name;

PROCEDURE String*(VAR str: ARRAY OF CHAR);
(** Read blank delimited character sequence *)
BEGIN
  IF Done THEN
    R.ReadToken(str);
    Done:=str[0]#0X;
  END;
END String;

END In.

Out


(** Based on the source text from M.Reiser, N.Wirth "Programming in Oberon" *) (** Mithril v2.0 *) MODULE Out; IMPORT Texts, Utils; VAR T: Texts.Text; W: Texts.Rider; PROCEDURE Open*; CONST opts = {Utils.scrollY,Utils.system,Utils.system}; BEGIN T:=Texts.cur.New(); T.Set(W,0); Utils.TextViewer("Out.Text","Out.Text",opts,T); END Open; PROCEDURE Char*(ch: CHAR); BEGIN T.Set(W,T.len); W.Write(ch); END Char; PROCEDURE String*(str: ARRAY OF CHAR); BEGIN T.Set(W,T.len); W.WriteString(str); END String; PROCEDURE Real*(x: REAL; n: INTEGER); BEGIN T.Set(W,T.len); W.WrReal(x,n,6,"g"); END Real; PROCEDURE Int*(i,n: LONGINT); BEGIN T.Set(W,T.len); W.WrInt(i,SHORT(n),"d"); END Int; PROCEDURE Ln*; BEGIN T.Set(W,T.len); W.WriteLn; END Ln; BEGIN T:=Texts.log; END Out.
XYplane


(** Based on the source text from M.Reiser, N.Wirth "Programming in Oberon" *) MODULE XYplane; IMPORT Windows ,Viewers ,Input ,TrueColors ; CONST erase* = 0; draw* = 1; (** values for parameter mode in Dot *) bits = MAX(SET)+1; TYPE Window = POINTER TO WindowDesc; WindowDesc = RECORD (Windows.WindowDesc) END; VAR X-,Y-,W-,H-: INTEGER; (** location and extent of window *) work: Window; bitmap: POINTER TO ARRAY OF SET; PROCEDURE ColorDot*(x,y: LONGINT; col: LONGINT); VAR t: Windows.Tool; BEGIN t:=Windows.GetTool(work); t.SetColor(work.screen.MapColor(col)); t.Dot(x,y); END ColorDot; PROCEDURE Dot*(x,y,mode: INTEGER); VAR k,i,j: LONGINT; t: Windows.Tool; BEGIN IF (x>=0) & (x<work.w) & (y>=0) & (y<work.h) THEN k:=LONG(y)*work.w + x; i:=k DIV bits; j:=k MOD bits; t:=Windows.GetTool(work); IF mode=erase THEN EXCL(bitmap[i],j); t.SetColor(work.color) ELSIF mode=draw THEN INCL(bitmap[i],j); t.SetColor(work.screen.black) ELSE ASSERT(FALSE); END; t.Dot(x,y); END; END Dot; PROCEDURE IsDot*(x,y: INTEGER): BOOLEAN; VAR k,i,j: LONGINT; BEGIN IF (x>=0) & (x<work.w) & (y>=0) & (y<work.h) THEN k:=LONG(y)*work.w + x; i:=k DIV bits; j:=k MOD bits; RETURN j IN bitmap[i] ELSE RETURN FALSE END; END IsDot; PROCEDURE (v: Window) OpenImage; BEGIN X:=SHORT(v.sx); Y:=SHORT(v.sy); W:=SHORT(v.w); H:=SHORT(v.h); END OpenImage; PROCEDURE (v: Window) ResizeImage(dw,dh: LONGINT); VAR i: LONGINT; BEGIN NEW(bitmap,(v.w*v.h + MAX(SET)) DIV (MAX(SET)+1)); FOR i:=0 TO LEN(bitmap^)-1 DO bitmap[i]:={} END; END ResizeImage; PROCEDURE Clear*; VAR i: LONGINT; BEGIN Windows.Refresh(work,0,0,work.w,work.h); FOR i:=0 TO LEN(bitmap^)-1 DO bitmap[i]:={} END; END Clear; PROCEDURE Open*; BEGIN IF work#NIL THEN Windows.Remove(Viewers.GetViewer(work)) END; NEW(work); Windows.Install(Windows.Hidden,work,0,0,1,1); Windows.SetColor(work,TrueColors.normal); Windows.Open(work); Windows.Open(Viewers.cur.User("XYplane",NIL,work)); END Open; PROCEDURE Key*(): CHAR; VAR ch: CHAR; id: INTEGER; state: SET; BEGIN ch:=0X; IF Input.KeyReady() THEN Input.Read(id,state,ch) END; RETURN ch END Key; BEGIN X:=0; Y:=0; W:=0; H:=0; work:=NIL; END XYplane.
Watch


(** Mithril v2.0 *) MODULE Watch; IMPORT Objects ,Windows ,Main ,Viewers ,Fonts ,TrueColors (* ISO Modula-2 libraries: *) ,SysClock ; TYPE (** New message type *) Msg = POINTER TO Message; Message = RECORD (Objects.Message) END; TYPE (** New window type *) Window = POINTER TO WindowDesc; WindowDesc = RECORD (Windows.WindowDesc) msg: Msg; hour,minute: INTEGER; (* current time *) colon: BOOLEAN; str: ARRAY 8 OF CHAR; END; VAR font: Fonts.Font; PROCEDURE (v: Window) Foreground(x,y,w,h: LONGINT); (** Redraws the window *) VAR t: Windows.Tool; BEGIN t:=Windows.GetTool(v); t.SetMode(Windows.xor); t.SetColor(v.color); t.String(2,font.bline+2,font,v.str); END Foreground; PROCEDURE Update(VAR s: ARRAY OF CHAR; hour,minute: INTEGER; VAR co lon: BOOLEAN); BEGIN s[0]:=CHR(hour DIV 10+ORD("0")); s[1]:=CHR(hour MOD 10+ORD("0")); IF colon THEN s[2]:=":" ELSE s[2]:="." END; colon:=~ colon; s[3]:=CHR(minute DIV 10+ORD("0")); s[4]:=CHR(minute MOD 10+ORD("0")); s[5]:=0X; END Update; PROCEDURE (v: Window) Handle(VAR m: Objects.Message); VAR dt: SysClock.DateTime; BEGIN WITH m: Message DO SysClock.GetClock(dt); v.hour:=SHORT(dt.hour); v.minute:=SHORT(dt.minute); Update(v.str,v.hour,v.minute,v.colon); Windows.Refresh(v,0,0,v.w,v.h); (* force redrawing *) IF Windows.visible IN v.state THEN Main.Enqueue(Main.TaskQueue,v.msg,v,1000); END; ELSE END END Handle; PROCEDURE Open*; (** Creates the new watch *) VAR v: Window; w: LONGINT; BEGIN NEW(v); w:=Fonts.Width(font,"00:00",0,5)+4; Windows.Install(Windows.Hidden,v,0,0,w,font.h+2); Windows.SetColor(v,TrueColors.normal); Windows.SetMinSize(v,v.w,v.h); Windows.SetMaxSize(v,v.w,v.h); v.str[0]:=0X; v.hour:=-1; v.minute:=0; v.colon:=TRUE; NEW(v.msg); Main.Enqueue(Main.TaskQueue,v.msg,v,0); Windows.Open( Viewers.cur.New(Windows.cursor.desktop,100,100,1,1,"Watch",NIL,v) ); END Open; BEGIN IF ~ SysClock.CanGetClock() THEN HALT(99) END; font:=Fonts.cur.This("Times52"); END Watch.
bubbles


(* Copyright (c) 1993 xTech Ltd, Russia. All Rights Reserved. *) (* Mithril v2.0 *) MODULE bubbles; (* Ned & Fla 25-Mar-93. *) IMPORT Windows ,Graphics ,Curves ,Objects ,Viewers ,Main ,Input ,TrueColors ,RandomNumbers ,SysClock ; CONST new = 0; step = 1; TYPE Circle = POINTER TO CircleDesc; CircleDesc = RECORD (Curves.CircleDesc) dead: BOOLEAN; link: Circle; END; MessageRef = POINTER TO Message; Message = RECORD (Objects.Message) id: INTEGER; END; Window = POINTER TO WindowDesc; WindowDesc = RECORD (Windows.WindowDesc) new: MessageRef; step: MessageRef; list: Circle; play: BOOLEAN; END; PROCEDURE (v: Window) Foreground(x,y,w,h: LONGINT); VAR c: Circle; t: Windows.Tool; BEGIN t:=Windows.GetTool(v); t.SetClip(x,y,w,h); c:=v.list; WHILE c#NIL DO t.Draw(c^); c:=c.link; END; END Foreground; PROCEDURE Cross(c: Circle; x,y,r: LONGINT): BOOLEAN; BEGIN RETURN (x-c.x)*(x-c.x)+(y-c.y)*(y-c.y) <= (r+c.r)*(r+c.r) END Cross; PROCEDURE Step(v: Window): BOOLEAN; VAR c,l: Circle; t: Windows.Tool; BEGIN t:=Windows.GetTool(v); c:=v.list; WHILE c#NIL DO INC(c.r); l:=v.list; WHILE l#c DO IF ~ l.dead & Cross(l,c.x,c.y,c.r) THEN IF l.col=c.col THEN v.play:=FALSE; RETURN FALSE ELSE IF c.r>l.r THEN c.dead:=TRUE ELSE l.dead:=TRUE END; END; END; l:=l.link; END; c:=c.link; END; c:=v.list; l:=NIL; WHILE c#NIL DO IF c.dead THEN c.col:=v.screen.RestoreColor(v.color); t.Draw(c^); IF l=NIL THEN v.list:=c.link; c:=v.list; ELSE l.link:=c.link; c:=c.link; END; ELSE l:=c; c:=c.link; END; END; c:=v.list; WHILE c#NIL DO t.Draw(c^); c:=c.link END; RETURN TRUE END Step; PROCEDURE Insert(v: Window; x,y,r,col: LONGINT): BOOLEAN; VAR c: Circle; t: Windows.Tool; BEGIN c:=v.list; WHILE c#NIL DO IF Cross(c,x,y,r+3) THEN RETURN FALSE END; c:=c.link; END; NEW(c); c.Circle(x,y,r,col,TRUE); c.dead:=FALSE; c.link:=v.list; v.list:=c; t:=Windows.GetTool(v); t.Draw(c^); RETURN TRUE END Insert; PROCEDURE Append(v: Window); VAR n,x,y,col: LONGINT; BEGIN n:=ENTIER(RandomNumbers.Uniform()*1000); col:=ASH(255,(n MOD 3)*8); REPEAT n:=ENTIER(RandomNumbers.Uniform()*1000); x:=n MOD v.w; n:=ENTIER(RandomNumbers.Uniform()*1000); y:=n MOD v.h; UNTIL Insert(v,x,y,4,col); END Append; PROCEDURE Edit(v: Window; VAR i: Main.InputMsg); VAR x,y,col: LONGINT; c: Circle; m: Main.InputMsg; t: Windows.Tool; BEGIN x:=i.x-v.sx; y:=i.y-v.sy; IF i.id=Input.mDown THEN REPEAT Main.GetInput(m) UNTIL m.state*Input.buttons={}; c:=v.list; WHILE (c#NIL) & ~ Cross(c,x,y,0) DO c:=c.link END; IF c#NIL THEN col:=ASH(255,i.no*8); IF c.col#col THEN c.col:=col; t:=Windows.GetTool(v); t.Draw(c^); END; END; END; END Edit; PROCEDURE (v: Window) Handle(VAR m: Objects.Message); BEGIN WITH m: Message DO IF (m.id=step) & Step(v) THEN Main.Enqueue(Main.SysQueue,v.step,v,800) ELSIF (m.id=new) & v.play THEN Append(v); Main.Enqueue(Main.SysQueue,v.new,v,3000) END; |m: Main.InputMsg DO Edit(v,m); ELSE END; END Handle; PROCEDURE Open*; VAR v: Window; i: INTEGER; dt: SysClock.DateTime; BEGIN IF SysClock.CanGetClock() THEN SysClock.GetClock(dt); RandomNumbers.InitSeed(dt.second*SysClock.maxSecondParts+dt.fractions); END; NEW(v); Windows.Install(Windows.Hidden,v,0,0,1024,1024); Windows.SetColor(v,TrueColors.normal); v.play:=TRUE; Windows.Open(Viewers.cur.User("Bubbles",NIL,v)); FOR i:=0 TO 9 DO Append(v) END; NEW(v.new); v.new.id:=new; Main.Enqueue(Main.SysQueue,v.new,v,0); NEW(v.step); v.step.id:=step; Main.Enqueue(Main.SysQueue,v.step,v,0); END Open; END bubbles.
Annex 1.

This is a collection of OM2 and Mithril Definition Modules referenced in the programming examples above, listed in alphabetical order. Definition module SysClock is not listed here; it is specified in ISO 10154 Modula-2 (2nd CD).

Curves



(** Copyright (c) 1993 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril v2.0 *) DEFINITION Curves; (** The modules defines graphic objects: Circle Ellipse (currently not implemented) For each object module defines a method, which name coincide with object name and a procedure "New<Object>". A method can be used to initialize static (record) objects. A procedure creates new dynamic (pointer) object. Such object can be inserted into the graph (See module Graphics). See also modules Graphics and Rectangles. *) IMPORT Objects, Windows, Graphics; TYPE Circle* = POINTER TO CircleDesc; CircleDesc* = RECORD (Graphics.ObjectDesc) x*,y*,r*: LONGINT; col* : LONGINT; solid* : BOOLEAN; PROCEDURE (VAR c: CircleDesc) Circle*(x,y,r,col: LONGINT; solid: BOOLEAN); END; PROCEDURE (VAR c: CircleDesc) Circle*(x,y,r,col: LONGINT; solid: BOOLEAN); (** Defines a circle *) PROCEDURE NewCircle*(x,y,r,col: LONGINT; solid: BOOLEAN): Circle; (** Creates a new circle *) END Curves.
Fonts (** Copyright (c) 1992,93 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril v2.0 *) DEFINITION Fonts; (** Fonts manager. Module Fonts defines abstract types Font and font Manager. An extension of these types should be defined in font drivers. During initialization, module Fonts tries to create a font manager using generator defined by environment string "FONTMANAGER". If such string is not defined than the default generator "FontDrv.@ManagerDesc" is used. A default font is set to "SysFont". *) IMPORT Objects, Closure; TYPE Font* = POINTER TO FontDesc; FontDesc* = RECORD (Objects.ObjectDesc) h- : INTEGER; (** height *) w- : INTEGER; (** maximum width *) bline-: INTEGER; (** basic line *) uline-: INTEGER; (** underline dy *) name- : Objects.String; PROCEDURE (f: Font) Box*(ch: CHAR; VAR dx,x,y,w,h: INTEGER); PROCEDURE (f: Font) Width*(ch: CHAR): INTEGER; END; Manager* = POINTER TO ManagerDesc; ManagerDesc* = RECORD (Objects.ObjectDesc) res* : Objects.Error; (** result of operation *) font*: Font; (** default font *) PROCEDURE (m: Manager) This*(name: ARRAY OF CHAR): Font; PROCEDURE (m: Manager) Init*; END; VAR def- : Manager; (** default manager *) cur- : Manager; (** current manager *) fonts-: Closure.Trailer; PROCEDURE (f: Font) Box*(ch: CHAR; VAR dx,x,y,w,h: INTEGER); (** Returns bounding box of character. Should be redefined in extension. Implementation: HALT(Errors.unimpProc). *) PROCEDURE (f: Font) Width*(ch: CHAR): INTEGER; (** Returns width of character. Should be redefined in extension. Implementation: HALT(Errors.unimpProc). *) PROCEDURE Find*(name: ARRAY OF CHAR): Font; (** Tries to find font in the font list. Returns NIL if font not found. *) PROCEDURE Insert*(f: Font); (** Inserts font in the font list. *) PROCEDURE Width*(f: Font; str: ARRAY OF CHAR; pos,len: LONGINT): LONGINT; (** Returns width of substring str[pos..pos+len-1] *) PROCEDURE SetAttr*(f: Font; name: ARRAY OF CHAR; w,h,bline,uline: INTEGER); (** Sets font attributes. Should be used in font drivers only. *) PROCEDURE (m: Manager) This*(name: ARRAY OF CHAR): Font; (** Tries to find or load a font with name "name". Returns default font (m.font) if such font does not exists. Should be redefined for all font managers. Implementation: RETURN NIL. *) PROCEDURE (m: Manager) Init*; (** Manager initialization. Implementation: empty. *) PROCEDURE SetManager*(m: Manager); (** Sets current manager and calls "Init" method. If m=NIL then sets current manager as a clone of the default manager. As the application level (usually) gets a font from the current manager the call of this procedure will change a set of using fonts. A new font manager should forward unsatisfied requests to the default manager. *) END Fonts.
Graphics (** Copyright (c) 1993 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril v2.0 *) DEFINITION Graphics; (** The module defines the notion of graphic objects, Graph as a set of objects. Graphic Object: A graphic object is an extension of Windows.Painter, ie. it is persistent object which can be drawn using Window.Tool. Graph: A graph is a persistent object, contains a set of graphic objects. *) IMPORT Objects, Windows; TYPE Graph* = POINTER TO GraphDesc; (** The type defines object gravitation. See module Windows. *) Gravity* = POINTER TO GravityDesc; GravityDesc* = RECORD ruc-,ldc- : SHORTINT; (** gravity point *) minW*,maxW*: LONGINT; (** width bounds *) minH*,maxH*: LONGINT; (** height bounds *) END; Object* = POINTER TO ObjectDesc; ObjectDesc* = RECORD (Windows.Painter) selected*: BOOLEAN; (** is selected *) gravity* : Gravity; (** optional gravity *) next- : Object; (** next object in the graph *) PROCEDURE (VAR o: ObjectDesc) Resize*(dw,dh: LONGINT); PROCEDURE (VAR o: ObjectDesc) Move*(dx,dy: LONGINT); PROCEDURE (VAR o: ObjectDesc) GetBox*( VAR x,y,w,h: LONGINT); PROCEDURE (VAR o: ObjectDesc) Selectable*( x,y: LONGINT): BOOLEAN; PROCEDURE (o: Object) SetGravity*(ldc,ruc: SHORTINT); END; (** Graph *) GraphDesc* = RECORD (Objects.ObjectDesc) objects-: Object; PROCEDURE (g: Graph) Insert*(o: Object); PROCEDURE (g: Graph) Neutralize*; PROCEDURE (g: Graph) Draw*(t: Windows.Tool; all: BOOLEAN); PROCEDURE (g: Graph) Delete*(all: BOOLEAN); PROCEDURE (g: Graph) Resize*(dW,dH: LONGINT; all: BOOLEAN); PROCEDURE (g: Graph) Move*(dx,dy: LONGINT; all: BOOLEAN); PROCEDURE (g: Graph) SelectArea*(x,y,w,h: LONGINT); PROCEDURE (g: Graph) GetBox*(VAR x,y,w,h: LONGINT); END; (** Window which contains a graph *) Window* = POINTER TO WindowDesc; WindowDesc* = RECORD (Windows.WindowDesc) graph*: Graph; END; (**----------------- Graphic Objects --------------**) PROCEDURE (VAR o: ObjectDesc) Resize*(dw,dh: LONGINT); (** Resizes object. Implementation: empty *) PROCEDURE (VAR o: ObjectDesc) Move*(dx,dy: LONGINT); (** Moves object. Implementation: empty *) PROCEDURE (VAR o: ObjectDesc) GetBox*( VAR x,y,w,h: LONGINT); (** Returns the smallest rectangle that enclosed the object *) PROCEDURE (VAR o: ObjectDesc) Selectable*( x,y: LONGINT): BOOLEAN; (** Returns true if the point (x,y) is inside the object. Implementation: RETURN FALSE *) PROCEDURE (o: Object) SetGravity*(ldc,ruc: SHORTINT); (** Sets object's gravitation points. *) PROCEDURE Cross*(VAR o: ObjectDesc; VAR x,y,w,h: LONGINT); (** Calculates intesection of object box and the rectangle (x,y,w,h). w<=0 iff intersection is empty. *) (**---------------------- Graph -------------------**) PROCEDURE (g: Graph) Insert*(o: Object); (** Inserts the object in the graph. The "invObject" exception is raised if the object was already included in some graph. *) PROCEDURE (g: Graph) Neutralize*; (** Deselects all objects *) PROCEDURE (g: Graph) Draw*(t: Windows.Tool; all: BOOLEAN); (** Draws all objects, if all=TRUE or selected otherwise *) PROCEDURE (g: Graph) Delete*(all: BOOLEAN); (** Deletes all objects, if all=TRUE or selected otherwise. *) PROCEDURE (g: Graph) Resize*(dW,dH: LONGINT; all: BOOLEAN); (** Resizes all objects, if all=TRUE or selected otherwise, using gravity. *) PROCEDURE (g: Graph) Move*(dx,dy: LONGINT; all: BOOLEAN); (** Noves all objects, if all=TRUE or selected otherwise. *) PROCEDURE (g: Graph) SelectArea*(x,y,w,h: LONGINT); (** Selects all objects that are totally within the rectangle (x,y,w,h) *) PROCEDURE (g: Graph) GetBox*(VAR x,y,w,h: LONGINT); (** Returns the smallest rectangle that encloses all objects in the graph. *) END Graphics.
Input (** Copyright (c) 1992,93 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril v2.0 *) DEFINITION Input; (** Keyboard and Mouse driver. *) CONST (** keyboard keys *) back* = 008X; (** back space ^H *) tab* = 009X; (** horizontal tab ^I *) lf* = 00AX; (** line feed ^J *) vt* = 00BX; (** vertical tab ^K *) cr* = 00DX; (** ^M *) esc* = 01BX; (** ESC ^^ *) up* = 080X; down* = 081X; right* = 082X; left* = 083X; pgup* = 084X; pgdw* = 085X; home* = 086X; end* = 087X; del* = 088X; ins* = 089X; bcktab* = 08AX; newln* = 08BX; f1* = 090X; f2* = 091X; f3* = 092X; f4* = 093X; f5* = 094X; f6* = 095X; f7* = 096X; f8* = 097X; f9* = 098X; f10* = 099X; f11* = 09AX; f12* = 09BX; f13* = 09CX; f14* = 09DX; f15* = 09EX; (** mouse state *) lbutton* = 0; (** left button is pressed *) mbutton* = 2; (** middle button is pressed *) rbutton* = 1; (** right button is pressed *) dclick* = 3; (** double click tag *) (** keyboard state *) alt* = 4; (** ALT key is pressed *) control* = 5; (** control key is pressed *) lshift* = 6; (** left shift key is pressed *) rshift* = 7; (** right shift key is pressed *) (** sets of keyboard and mouse state *) keys* = {4..7}; buttons* = {0..2}; (** event mode *) undef* = 0; (** no event *) mDown* = 1; (** mouse button is pressed *) mUp* = 2; (** mouse button is released *) mMove* = 3; (** mouse move *) keyChar* = 4; (** keyboard key *) mouse* = {1..3}; keyboard* = {4}; PROCEDURE MouseReady*(): BOOLEAN; (** Returns TRUE if mouse state was changed from the last call of the "Mouse" procedure. *) PROCEDURE Mouse*(VAR id,no: INTEGER; VAR x,y: LONGINT; VAR state: SET); (** Returns current mouse coordinates ("x","y"), state ("state") and action "id". If action in {mUp,mDown) then "no" contains the button code (lbutton, mbutton, rbutton). The "dclick" bit in "state" points out that the same button was pressed in a "small" period of time. *) PROCEDURE KeyReady*(): BOOLEAN; (** Returns TRUE if next character is available from the keyboard. *) PROCEDURE Read*(VAR id: INTEGER; VAR state: SET; VAR char: CHAR); (** Reads next character from keyboard. "id" = undef, if next character is not available, otherwise "id" = keyChar. *) END Input.
Main (** Copyright (c) 1993 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril v2.0 *) DEFINITION Main; (** A main module of Mithril outer core. The Main module implements a Main.Loop which waits for some event, and then sends a corresponding message to some object. Events may be invoked by a peripheral device, such as keyboard, mouse, or net; or by some object. For the keyboard and mouse events the module generates InputMsg and sends it according to dispatch strategy (see below). An input capture can be used to evade this strategy. An object may generate, as a response to some event, a sequence of messages. The messages are put into one of the message queues (See below). One can specify a time delay before sending a message. Input capture: An object can capture all input messages which means that all such messages will be sent to this object. See the InputCapture procedure. Implicit mouse capture: When pressing a mouse button the system fixes the current window (the window containg the mouse cursor) and will send all mouse messages to this window until all mouse button will be released. This implicit capture does not influence to the keyboard messages. Dispatch stategy for keyboard messages: If input is not captured the message is sent to all focus windows (See the Windows module) from bottom to top (staring from Windows.Surface) util the message will be processed (M.stop is set to TRUE). Dispatch stategy for mouse messages: If input is not (explicitly or implicitly) captured the message is sent to the uppermost window containing the mouse cursor. Message queues: The module defines two message queues: SysQueue high priority TaskQueue low priority Executing the main loop the system will try to retrieve a message from SysQueue than from keyboard and mouse and than from TaskQueue. See procedures Enqueue and PassMessage. *) IMPORT Objects, Windows; TYPE (** Input Message. See module Input for message id and state values. *) InputRef* = POINTER TO InputMsg; InputMsg* = RECORD (Objects.Message) recipient*: Objects.Object; id* : INTEGER; (** message id (See module Input) *) state* : SET; (** mouse and keyboard state *) no* : INTEGER; (** mouse button: id IN {mUp,mDown} *) x*,y* : LONGINT; (** mouse coordinates *) char* : CHAR; (** from keyboard (id=keyChar) *) stop* : BOOLEAN; (** the keyboard message is processed *) END; Queue = POINTER TO QueueDesc; QueueDesc = RECORD END; (** Basic type for command parameters. *) Par* = POINTER TO ParDesc; ParDesc* = RECORD window*: Windows.Window; (** callers's window *) stream*: Objects.Stream; (** parameter list *) pos* : LONGINT; (** starting pos in stream *) END; VAR par* : Par; (** actual parameters for the next command *) SysQueue- : Queue; (** high priority queue *) TaskQueue-: Queue; (** low priority queue *) PROCEDURE SystemTime*(): LONGINT; (** Returns the number of milliseconds from the system startup. *) PROCEDURE Enqueue*(queue: Queue; m: Objects.MessageRef; to: Objects.Object; delay: LONGINT); (** Inserts a message into the "queue". The message will be sent to the "to" object when retrieved. "delay" stands for delay time in milliseconds. *) PROCEDURE GetInput*(VAR i: InputMsg); (** Reads an input message from keyboard or mouse *) PROCEDURE PassMessage*(VAR M: Objects.Message; to: Objects.Object); (** Passes a message to an object throughout the system queue (delay=0). *) PROCEDURE InputCapture*(v: Objects.Object): Objects.Object; (** Captures an input. All subsequent input messages will be sent to the object "v". Returns the previous recipient object or NIL. The sketch of usage: save:=Main.InputCapture(obj); (* all message are sent to "obj" here *) ignore:=Main.InputCapture(save); *) PROCEDURE Loop*; (** Main Loop. The command is called by system. Retrieves a message from system queue keybord or mouse task queue and dispatch it. *) PROCEDURE Call*(name: ARRAY OF CHAR; unload: BOOLEAN; VAR res: Objects.Error); (** Calls a command "Module.Command". If "unload=TRUE" tries to unload module before calling the command. *) END Main.
Objects (** Copyright (c) 1992,93 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril v2.0 *) DEFINITION Objects; (** Module Objects introduces the notions of the basic object type ("Object"), the basic message type ("Message"), and also abstract byte streams, riders and mappers. Almost all methods defined in the module are abstract method and implemented as HALT(Errors.unimpProc) if not explicitly specified in the method comment. *) TYPE (** Object is a primary type. For all objects the following features are supported: generic copying; generic message handling; finalization (See also module Closure); externalization and internalization. *) Object* = POINTER TO ObjectDesc; ObjectDesc* = RECORD PROCEDURE (o: Object) CopyFrom*(VAR src: ObjectDesc); PROCEDURE (o: Object) Handle*(VAR m: Message); PROCEDURE (o: Object) Finalize*; PROCEDURE (o: Object) Externalize*(VAR map: Mapper); PROCEDURE (o: Object) Internalize*(VAR map: Mapper); END; (** Basic type for all messages in the system. A Message is an Object, so it is also first-class type in the system. *) MessageRef* = POINTER TO Message; Message* = RECORD (ObjectDesc) END; (** Error handling *) (** Basic type for error context. Contains error code and provides method for error visualization. *) Error* = POINTER TO ErrorDesc; ErrorDesc* = RECORD (ObjectDesc) code*: LONGINT; (** error code *) PROCEDURE (e: Error) perror*(VAR msg: ARRAY OF CHAR); END; (** Error handler *) Handler* = POINTER TO HandlerDesc; HandlerDesc* = RECORD (ObjectDesc) PROCEDURE (x: Handler) React*(e: Error); END; CONST (** bits in streams mode (See also Stream.Mode) *) read* = 0; (** input operations are available *) write* = 1; (** output operations are available *) seek* = 2; (** stream is positionable *) (** Abstract Streams and Riders Streams and Rider can be extended independently. Type Link defines a part of the bottleneck Carrier/Rider interface and contains carrier specific information. The pair Streams/Link is extended simultaneously. When attaching a rider to a stream the stream creates a suitable link object. Connection between objects: Rider A ---> Link A - - - - \ Stream / Rider B ---> Link B - - - - As a rule, a link object contains a hidden pointer to a stream to prevent dynamic checks. *) TYPE (** Abstract Stream *) Stream* = POINTER TO StreamDesc; StreamDesc* = RECORD (ObjectDesc) res* : Error; handler*: Handler; PROCEDURE (s: Stream) Set*(VAR r: Rider; pos: LONGINT); PROCEDURE (s: Stream) Flush*; PROCEDURE (s: Stream) Mode*(): SET; PROCEDURE (s: Stream) Length*(): LONGINT; END; (** Abstract Link *) Link* = POINTER TO LinkDesc; LinkDesc* = RECORD (ObjectDesc) PROCEDURE (l: Link) Pos*(VAR r: Rider): LONGINT; PROCEDURE (l: Link) Read*(VAR r: Rider; VAR x: SYSTEM.BYTE); PROCEDURE (l: Link) ReadBlock*(VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; pos,len: LONGINT); PROCEDURE (l: Link) SkipBlock*(VAR r: Rider; len: LONGINT); PROCEDURE (l: Link) Write*(VAR r: Rider; x: SYSTEM.BYTE); PROCEDURE (l: Link) WriteBlock*(VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; pos,len: LONGINT); PROCEDURE (l: Link) print*(VAR r: Rider; fmt: ARRAY OF CHAR; SEQ args: SYSTEM.BYTE); END; (** Abstract Rider. The "iolen" value is valid only after block operations: "ReadBlock", "WriteBlock", "SkipBlock" and contains the number of transfered (or skipped) bytes during operation. *) RiderRef* = POINTER TO Rider; Rider* = RECORD (ObjectDesc) base- : Stream; (** base stream *) link- : Link; (** a link object attached *) res* : Error; (** result of the operation *) handler*: Handler; eos* : BOOLEAN; (** end of stream *) iolen* : LONGINT; (** i/o length *) PROCEDURE (VAR r: Rider) Connect*(base: Stream; link: Link); PROCEDURE (VAR r: Rider) Pos*(): LONGINT; PROCEDURE (VAR r: Rider) Read*(VAR x: CHAR); PROCEDURE (VAR r: Rider) ReadBlock*(VAR x: ARRAY OF CHAR; pos,len: LONGINT); PROCEDURE (VAR r: Rider) SkipBlock*(len: LONGINT); PROCEDURE (VAR r: Rider) ReadShortInt*(VAR x: SHORTINT); PROCEDURE (VAR r: Rider) ReadInt*(VAR x: INTEGER); PROCEDURE (VAR r: Rider) ReadLongInt*(VAR x: LONGINT); PROCEDURE (VAR r: Rider) ReadReal*(VAR x: REAL); PROCEDURE (VAR r: Rider) ReadLongReal*(VAR x: LONGREAL); PROCEDURE (VAR r: Rider) ReadSet*(VAR x: SET); PROCEDURE (VAR r: Rider) ReadBool*(VAR x: BOOLEAN); PROCEDURE (VAR r: Rider) ReadString*(VAR s: ARRAY OF CHAR); PROCEDURE (VAR r: Rider) Write*(x: CHAR); PROCEDURE (VAR r: Rider) WriteBlock*(VAR x: ARRAY OF CHAR; pos,len: LONGINT); PROCEDURE (VAR r: Rider) WriteShortInt*(i: SHORTINT); PROCEDURE (VAR r: Rider) WriteInt*(i: INTEGER); PROCEDURE (VAR r: Rider) WriteLongInt*(i: LONGINT); PROCEDURE (VAR r: Rider) WriteSet*(x: SET); PROCEDURE (VAR r: Rider) WriteBool*(b: BOOLEAN); PROCEDURE (VAR r: Rider) WriteString*(s: ARRAY OF CHAR); PROCEDURE (VAR r: Rider) WriteLn*; PROCEDURE (VAR r: Rider) WriteReal*(x: REAL); PROCEDURE (VAR r: Rider) WriteLongReal*(x: LONGREAL); PROCEDURE (VAR r: Rider) print*(format: ARRAY OF CHAR; SEQ args: SYSTEM.BYTE); END; (** Generator of "alien" objects. See Mapper.GetObject *) AlienGen* = POINTER TO AlienGenDesc; AlienGenDesc* = RECORD PROCEDURE (a: AlienGen) Substitute*(VAR M: Mapper; org,len: LONGINT; gen: ARRAY OF CHAR; VAR o: Object); END; (** Abstract mapper to/from extrenal reprsentation *) Mapper* = RECORD (Rider) alienGen*: AlienGen; (** alien generator *) PROCEDURE (VAR r: Mapper) ReadX*(VAR i: LONGINT); PROCEDURE (VAR r: Mapper) WriteX*(x: LONGINT); PROCEDURE (VAR r: Mapper) ReadStr*(VAR s: ARRAY OF CHAR); PROCEDURE (VAR r: Mapper) WriteStr*(s: ARRAY OF CHAR); PROCEDURE (VAR r: Mapper) ReadDynStr*(VAR s: String); PROCEDURE (VAR M: Mapper) OpenMap*; PROCEDURE (VAR M: Mapper) PutObject*(o: Object); PROCEDURE (VAR M: Mapper) GetObject*(VAR o: Object); PROCEDURE (VAR M: Mapper) CloseMap*; END; (** Dynamic string type *) String* = POINTER TO ARRAY OF CHAR; VAR abort-: Handler; (** abort handler *) (**-------------------- Objects --------------------**) PROCEDURE (o: Object) CopyFrom*(VAR src: ObjectDesc); (** Copies object attributes from "src" to "o". Should be redefined for all extensions. Implementation: empty. *) PROCEDURE (o: Object) Handle*(VAR m: Message); (** Message handler. Implementation: empty. *) PROCEDURE (o: Object) Finalize*; (** Object finalization. Implementation: empty. *) PROCEDURE (o: Object) Externalize*(VAR map: Mapper); (** Writes external representation of object attributes. Implementation: empty. *) PROCEDURE (o: Object) Internalize*(VAR map: Mapper); (** Reads object attributes from external representation. The internalization code should be designed completely symmetrical to the externalization code. Implementation: empty. *) (**-------------------- Errors ---------------------**) PROCEDURE (x: Handler) React*(e: Error); (** Reaction on error: HALT(e.code) *) PROCEDURE (e: Error) perror*(VAR msg: ARRAY OF CHAR); (** Print error message *) (**-------------------- Streams --------------------**) PROCEDURE (s: Stream) Set*(VAR r: Rider; pos: LONGINT); (** Attempts to set a rider to a stream in position pos. s.res should be set to a result of operation. The method should be redefined for all extensions. An implementation (for extension) should create a suitable link object and should call Rider.Connect method in order to set the fields "base" and "link" in a rider. If pos#0 and stream is not positionable an exception (Errors.unsuitable) should be raised. Implementation: HALT(Errors.unimpProc); *) PROCEDURE (s: Stream) Flush*; (** Flushes any buffered data. Implementation: empty. *) PROCEDURE (s: Stream) Mode*(): SET; (** Returns stream mode. Implementation: HALT(Errors.unimpProc); *) PROCEDURE (s: Stream) Length*(): LONGINT; (** Returns length of stream. Implementation: RETURN 0 *) (**--------------------- Links ---------------------**) PROCEDURE (l: Link) Pos*(VAR r: Rider): LONGINT; (** Returns the current position in the stream. r.res - result of operation. Implementation: HALT(Errors.unimpProc); *) PROCEDURE (l: Link) Read*(VAR r: Rider; VAR x: SYSTEM.BYTE); (** Attempts to read a byte from the stream. Assigns the result of the operation to r.res. r.iolink should be in the range [0..1]. The method should be redefined for all extensions. Implementation: HALT(Errors.unimpProc); *) PROCEDURE (l: Link) ReadBlock*(VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; pos,len: LONGINT); (** Attempts to read "len" bytes from the stream to "x" starting from position "pos" (x[pos..pos+len-1]). Assigns the result of the operation to r.res. r.iolink should be in the range [0..len]. The method should be redefined for all extensions. Implementation: HALT(Errors.unimpProc); *) PROCEDURE (l: Link) SkipBlock*(VAR r: Rider; len: LONGINT); (** Attempts to skip "len" bytes. Assigns the result of the operation to r.res. r.iolink should be in the range [0..len]. The method should be redefined for all extensions. Implementation: HALT(Errors.unimpProc); *) PROCEDURE (l: Link) Write*(VAR r: Rider; x: SYSTEM.BYTE); (** Attempts to write a byte to the stream. Assigns the result of the operation to r.res. r.iolink should be in the range [0..1]. The method should be redefined for all extensions. Implementation: HALT(Errors.unimpProc); *) PROCEDURE (l: Link) WriteBlock*(VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; pos,len: LONGINT); (** Attempts to write "len" byte to the stream (x[pos..pos+len-1]. Assigns the result of the operation to r.res. r.iolink should be in the range [0..len]. The method should be redefined for all extensions. Implementation: HALT(Errors.unimpProc); *) PROCEDURE (l: Link) print*(VAR r: Rider; fmt: ARRAY OF CHAR; SEQ args: SYSTEM.BYTE); (** Format output to a stream *) (**-------------------- Riders ---------------------**) PROCEDURE (VAR r: Rider) Connect*(base: Stream; link: Link); (** Connects a rider to the Stream object "base" and the Link object "link". Should be called from the Stream.Set method only. All extensions should contain a call to super method: r.Connect^(base,link) *) PROCEDURE (VAR r: Rider) Pos*(): LONGINT; (** Returns the current position in the stream *) PROCEDURE (VAR r: Rider) Read*(VAR x: CHAR); (** Reads a character *) PROCEDURE (VAR r: Rider) ReadBlock*(VAR x: ARRAY OF CHAR; pos,len: LONGINT); (** Reads upto "len" bytes to "x" (x[pos..pos+len-1]) *) PROCEDURE (VAR r: Rider) SkipBlock*(len: LONGINT); PROCEDURE (VAR r: Rider) ReadShortInt*(VAR x: SHORTINT); (** Reads SHORTINT *) PROCEDURE (VAR r: Rider) ReadInt*(VAR x: INTEGER); (** Reads INTEGER *) PROCEDURE (VAR r: Rider) ReadLongInt*(VAR x: LONGINT); (** Reads LONGINT *) PROCEDURE (VAR r: Rider) ReadReal*(VAR x: REAL); (** Reads REAL *) PROCEDURE (VAR r: Rider) ReadLongReal*(VAR x: LONGREAL); (** Reads LONGREAL *) PROCEDURE (VAR r: Rider) ReadSet*(VAR x: SET); (** Reads SET *) PROCEDURE (VAR r: Rider) ReadBool*(VAR x: BOOLEAN); (** Reads BOOLEAN *) PROCEDURE (VAR r: Rider) ReadString*(VAR s: ARRAY OF CHAR); (** Reads string *) PROCEDURE (VAR r: Rider) Write*(x: CHAR); (** Writes a character *) PROCEDURE (VAR r: Rider) WriteBlock*(VAR x: ARRAY OF CHAR; pos,len: LONGINT); (** Writes a block from x[pos..pos+len-1]. *) PROCEDURE (VAR r: Rider) WriteShortInt*(i: SHORTINT); (** Writes SHORTINT *) PROCEDURE (VAR r: Rider) WriteInt*(i: INTEGER); (** Writes INTEGER *) PROCEDURE (VAR r: Rider) WriteLongInt*(i: LONGINT); (** Writes LONGINT *) PROCEDURE (VAR r: Rider) WriteSet*(x: SET); (** Writes SET *) PROCEDURE (VAR r: Rider) WriteBool*(b: BOOLEAN); (** Writes BOOLEAN *) PROCEDURE (VAR r: Rider) WriteString*(s: ARRAY OF CHAR); (** Writes string *) PROCEDURE (VAR r: Rider) WriteLn*; (** Writes character ASCII.LF (0AX) *) PROCEDURE (VAR r: Rider) WriteReal*(x: REAL); (** Writes REAL *) PROCEDURE (VAR r: Rider) WriteLongReal*(x: LONGREAL); (** Writes LONGREAL *) PROCEDURE (VAR r: Rider) print*(format: ARRAY OF CHAR; SEQ args: SYSTEM.BYTE); (** Format output *) (**-------------------- Mapper ---------------------**) PROCEDURE (VAR r: Mapper) ReadX*(VAR i: LONGINT); (** Reads an integer in radix 128 representation (1-5 bytes) *) PROCEDURE (VAR r: Mapper) WriteX*(x: LONGINT); (** Writes an integer in radix 128 representation (1-5 bytes) *) PROCEDURE (VAR r: Mapper) ReadStr*(VAR s: ARRAY OF CHAR); (** Reads string in format: length {char}, where length is a compact integer (see ReadX). An error "noResource" should occured if length > LEN(s). *) PROCEDURE (VAR r: Mapper) WriteStr*(s: ARRAY OF CHAR); (** Writes string in the format: length { char }, where length is a compact integer (see WriteX). *) PROCEDURE (VAR r: Mapper) ReadDynStr*(VAR s: String); (** Allocates a dynamic string (length+1 bytes) and reads string in format: length {char}, where length is a compact integer (see ReadX). 0X always terminates the string. *) PROCEDURE (VAR M: Mapper) OpenMap*; (** Opens "dictionary" of objects. Implementation: empty. *) PROCEDURE (VAR M: Mapper) PutObject*(o: Object); (** Writes an information necessary to restore an object from external representation and then calls o.Externalize. *) PROCEDURE (VAR M: Mapper) GetObject*(VAR o: Object); (** Restores object from external representation. M.res#NIL if error was occured. If the object can not be created the method calls the method "M.alienGen.Substitute", if M.alienGen#NIL. *) PROCEDURE (VAR M: Mapper) CloseMap*; (** Closes "dictionary" of objects. Implementation: empty. *) (**-------------------- Aliens --------------------**) PROCEDURE (a: AlienGen) Substitute*(VAR M: Mapper; org,len: LONGINT; gen: ARRAY OF CHAR; VAR o: Object); (** The method is called by Mapper.GetObject, when the stored object can not be created. The method should create substitution for the object. Parameters: org - start position of object attributes in stream len - length of object information (in bytes) gen - generator, which cause an error Implementation: o:=NIL *) (**----------------- Object Clones ----------------**) PROCEDURE GenObject*(VAR o: ObjectDesc): Object; (** Takes a type of "o" and creates an new instance of that type. without copying the value of "o". *) PROCEDURE CopyObject*(VAR o: ObjectDesc): Object; (** Clones an object "o" using CopyFrom method. *) END Objects.
TextRiders (** Copyright (c) 1993 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril v2.0 *) DEFINITION TextRiders; (** ASCII Rider The Rider implements all methods, declared for the abstract rider (Objects.Rider) and adds few additional methods for format output and text scan. All "Read*" methods except "Read", "ReadBlock" and "ReadLine" skip leading spacing characters (spaces, control characters) and then scan the stream to return the value of the requested type. The result of scanning is set to field "conv". If an I/O error was occured during scaning the "conv" field is set to "ReadError". The conversion result is not altered by methods "Read", "ReadBlock" and "ReadLine". Additional output methods: Int(format: ARRAY OF CHAR; x: LONGINT); Set(format: ARRAY OF CHAR; x: SET); Real(format: ARRAY OF CHAR; real: LONGREAL); String(format,s: ARRAY OF CHAR); A "format" paremeter in these methods allows to control representation of output texts: WrInt(x: LONGINT; width: INTEGER; base: CHAR); WrReal(x: LONGREAL; width,precision: INTEGER; base: CHAR); Write a number value. WriteTime(time: LONGINT); Writes date and time in the standard format. Additional input methods: ReadToken(VAR s: ARRAY OF CHAR); Reads a "token" - a piece of text separated by blanks or control characters. ReadLine(VAR s: ARRAY OF CHAR); Reads characters before the end of line mark. Scan(VAR S: Symbol); The scan method is available to directly scan the next symbol. Scanning of some classes (Set, Bool, Eol) is disabled by default. To enable it include corresponding bit into field "symbols". When connecting to string this field is set to default value: {}. *) IMPORT Objects, Attrs; CONST (** symbol classes *) Inval* = 0; (** invalid symbol *) Name* = 1; (** name (length "len") *) String* = 2; (** literal string (length "len") *) Int* = 3; (** integer "i" *) Real* = 4; (** real number "r" *) LongReal* = 5; (** long real number "r" *) Char* = 6; (** character "c" *) Set* = 7; (** set "set" *) Bool* = 8; (** boolean "b" *) Eol* = 9; (** end of line *) Obj* = 10; (** object "obj" *) (** conversion results *) ok* = 0; WrongFormat* = 1; OutOfRange* = 2; ReadError* = 3; EndOfText* = 4; BadClass* = 5; Truncated* = 6; TYPE (** Symbol description *) Symbol* = RECORD class*: INTEGER; (** class of symbol *) b* : BOOLEAN; c* : CHAR; i* : LONGINT; r* : LONGREAL; set* : SET; obj* : Objects.Object; len* : LONGINT; str* : ARRAY 64 OF CHAR; END; (** ASCII rider *) Rider* = RECORD (Objects.Rider) conv* : INTEGER; (** conversion result *) symbols*: SET; (** set of optional symbols *) next* : CHAR; (** next character *) valid* : BOOLEAN; (** next character is valid *) PROCEDURE (VAR r: Rider) Special*(ch: CHAR): INTEGER; PROCEDURE (VAR r: Rider) WriteTime*(time: LONGINT); PROCEDURE (VAR r: Rider) Int*(format: ARRAY OF CHAR; x: LONGINT); PROCEDURE (VAR r: Rider) Set*(format: ARRAY OF CHAR; x: SET); PROCEDURE (VAR r: Rider) Real*(format: ARRAY OF CHAR; real: LONGREAL); PROCEDURE (VAR r: Rider) String*(format,s: ARRAY OF CHAR); PROCEDURE (VAR r: Rider) WrInt*(x: LONGINT; width: INTEGER; base: CHAR); PROCEDURE (VAR r: Rider) WrReal*(x: LONGREAL; width,precision: INTEGER; base: CHAR); PROCEDURE (VAR r: Rider) ReadLine*(VAR s: ARRAY OF CHAR); PROCEDURE (VAR r: Rider) ReadToken*(VAR s: ARRAY OF CHAR); PROCEDURE (VAR r: Rider) Scan*(VAR S: Symbol); END; (** Conversion error *) Error* = POINTER TO ErrorDesc; ErrorDesc* = RECORD (Objects.ErrorDesc) conv*: INTEGER; END; PROCEDURE (VAR r: Rider) Special*(ch: CHAR): INTEGER; (** Returns class of character (>=Eol) or -1, if this character does not have a special meaning. *) (**--------------------- Writer -------------------**) PROCEDURE (VAR r: Rider) Write*(x: CHAR); (** Writes a character *) PROCEDURE (VAR r: Rider) WriteShortInt*(i: SHORTINT); (** Writes a value in decimal form *) PROCEDURE (VAR r: Rider) WriteInt*(i: INTEGER); (** Writes a value in decimal form *) PROCEDURE (VAR r: Rider) WriteLongInt*(i: LONGINT); (** Writes a value in decimal form *) PROCEDURE (VAR r: Rider) WriteSet*(x: SET); (** Writes a set in Oberon-2 notation. *) PROCEDURE (VAR r: Rider) WriteBool*(b: BOOLEAN); (** Writes BOOLEAN as "$FALSE" or "$TRUE" *) PROCEDURE (VAR r: Rider) WriteString*(s: ARRAY OF CHAR); (** Writes a string *) PROCEDURE (VAR r: Rider) WriteLn*; (** Writes character ASCII.LF (0AX) *) PROCEDURE (VAR r: Rider) WriteReal*(x: REAL); (** Writes a value in fixed-point or in floating-point form depending on the value. *) PROCEDURE (VAR r: Rider) WriteLongReal*(x: LONGREAL); (** Writes a value in fixed-point or in floating-point form depending on the value. *) PROCEDURE (VAR r: Rider) WriteTime*(time: LONGINT); (** Writes date and time in the standard format. Example: Tue 11 Jan 1994 12:00:00 *) PROCEDURE (VAR r: Rider) Int*(format: ARRAY OF CHAR; x: LONGINT); (** Writes an integer value in the given format. format = {character} "%" task {character}. task = { modificator } width base. modificator = "-" | "+" | "|" | "0" | "$" | "#". width = [ unsigned number ]. base = "d" | "i" | "x" | "X" | "o" | "{}". modificators: "-" - left justify value. "+" - print sing (even for non-negative). "|" - center value. "0" - filling by "0" characters (default - filling by spaces). "$" - the same as "0". "#" - print base character ("H" or "B") according to base. bases: "d" - print value in decimal form. "i" - the same as "d". "x" - print value in hexadecimal form, use letters "A".."F". "X" - print value in hexadecimal form, use letters "a".."f". "o" - print value in octal form. "{}" - print value as bitset. Examples: r.Int("pos=%d\n",r.Pos()); r.Int("mask=%08x",mask); *) PROCEDURE (VAR r: Rider) Set*(format: ARRAY OF CHAR; x: SET); (** Writes a set value in the given format. See "Int" for format specification. Examples: x:={1,3,5}; r.Set("%{}",x); (* output: "{1,3,5}" *) r.Set("%xH",x); (* output: "2AH" *) *) PROCEDURE (VAR r: Rider) Real*(format: ARRAY OF CHAR; real: LONGREAL); (** Writes a real value in the given format. format = {character} "%" task {character}. task = { modificator } width [ "." precision] base. modificator = "-" | "+" | "|" width = [ unsigned number ]. presision = [ unsigned number ]. base = "f" | "e" | "g". modificators: "-" - left justify value. "+" - print sing (even for non-negative). "|" - center value. bases: "f" - print value in fixed-point form. "e" - print value in floating-point form. "g" - print value in fixed-point or in floating-point form depending on the value. Examples: r.Real('pi=%15.8f',3.1415962); r.Real('%g',r); *) PROCEDURE (VAR r: Rider) String*(format,s: ARRAY OF CHAR); (** Writes a string in the given format. format = {character} "%" task {character}. task = { modificator } width ["." length ["." start] ] "%s". modificator = "-" | "|". width = [ unsigned number ]. length = [ unsigned number ]. start = [ unsigned number ]. modificators: "-" - left justify string. "|" - center string. Examples: r.String("%5.3s","abcdef"); (* output: " abc" *) r.String("%-5.3s","abcdef"); (* output: "abc " *) r.String("%|5.3s","abcdef"); (* output: " abc " *) r.String("%-5s","abcdef"); (* output: "abcdef" *) r.String("%..3s","abcdef"); (* output: "def" *) *) PROCEDURE (VAR r: Rider) WrInt*(x: LONGINT; width: INTEGER; base: CHAR); (** Writes an integer value. If width<0 then output is left justify. base = "d" | "i" | "x" | "X" | "o". See r.Int for the "base" meaning. *) PROCEDURE (VAR r: Rider) WrReal*(x: LONGREAL; width,precision: INTEGER; base: CHAR); (** Writes a real value. If width<0 then output is left justify. base = "f" | "e" | "g". See r.Real for the "base" meaning. *) (**--------------------- Reader -------------------**) PROCEDURE (VAR r: Rider) ReadLine*(VAR s: ARRAY OF CHAR); (** Reads characters before the end of line mark (EOL) that can be accommodated in "s", and copies them to "s". A string terminator (0X) is appended to a string only if possible. "r.iolen" is set to the number of characters read. "r.iolen < LEN(s)" if the input was stoped by the end of line. *) PROCEDURE (VAR r: Rider) ReadSet*(VAR x: SET); (** Reads set value in Oberon-2 syntax *) PROCEDURE (VAR r: Rider) ReadBool*(VAR x: BOOLEAN); (** Reads BOOLEAN: "$FALSE" or "$TRUE" *) PROCEDURE (VAR r: Rider) ReadString*(VAR s: ARRAY OF CHAR); (** Reads blank delimited character sequence or characters enclosed in double or single quotes, copying to "s" as many characters as can be accommodated as a string value. A string terminator is always appended to a string. A converion result (r.conv) is set to "Truncated" if string capacity is exceeded. string = { non-blank char } |"'" {char} "'" | '"' {char} '"'. Examples: "hello, world" c:\mithril\samples\In.o *) PROCEDURE (VAR r: Rider) ReadToken*(VAR s: ARRAY OF CHAR); (** Reads blank delimited character sequence, copying to "s" as many characters as can be accommodated as a string value. A string terminator is always appended to a string. A converion result (r.conv) is set to "Truncated" if string capacity is exceeded. *) PROCEDURE (VAR r: Rider) Scan*(VAR S: Symbol); (** Reads next symbol *) (**------------------- Attributes -----------------**) PROCEDURE CreateAttr*(S: Symbol; VAR a: Attrs.Attr); (** Creates an attribute corresponding to symbol class *) PROCEDURE Parse*(VAR r: Rider; VAR a: Attrs.Attr); (** Parses an attribute pair in the form name=value. *) (**---------------- Conversion Errors -------------**) PROCEDURE ConvToError*(VAR r: Rider); (** Creates an error corresponding to conversion result *) END TextRiders.
Texts (** Copyright (c) 1992,93 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril v2.0 *) DEFINITION Texts; (** Text with embedded objects The module defines a notion of Text (as an extension of Objects.Stream), abstract character (Elem), text rider and text manager. Text: Text is a sequence of attributed text objects, including normal characters and objects (so-called elements). The set of attributes (font, color and vertical displacement) associated with a text object is fully independent of the neighbouring text objects. Text as Stream: Any Text is a stream (Objects.Stream) hence it is possible to attach any Rider type to the text. When using any Rider to write to the text the sequence of characters is inserted in the text. Use "Delete" operation to provide "overwrite" mode. Text editing: The text editing operations include: - changing the attributes settings (ChangeLooks); - deleting a subrange of text (Delete); - inserting a subrange of text (Insert); - moving a subrange of text (Move,Append). All these operations send a notify message (NotifyMsg) to all objects, attached to text. Notification: An object which should be notified about all text changes can be attached to the text (Attach). All attached objects are linked using "non-traced" list (See the module "Closure"). Sometimes it is desirable to turn the notification mechanism off (eg. if text modification includes many small steps). The notification flag (Text.notify) can be used to turn notification off or on. Example: text.notify:=FALSE; Modify(text); text.Notify(text.replace,0,text.len); text.notify:=TRUE; In some case it is desirable to send extended NotifyMsg. The NotifyMsg can be sent to the text to force the notification of all attached objects: text.Handle(M) Cloning text: The clone operation (Objects.CopyObj) applying to text does not copy text character sequence. It can be done by subsequent call of the "Insert" method: new:=Objects.CopyObject(old^); new(Texts.Text).Insert(0,old,0,old.len) Elem: An element is a persistent object (Objects.Object). Two new methods are defined for each element: "Resize" and "Persistent". The later one is called to determine is it necessary to store an element with the text or not. When reading text as a plain character sequence an element is represented as "normal" character with code, defined by constant "ElemChar". The module "Text" does not define displaying operation for elements (See the module "Elems"). "Alien" elements: A special extension of the "Elem" type is defined in the module. The elements of this type are created when the text element can not be internalized, because some of the modules required for internalization are not available. The "Alien" element preserves an information about original element and stores it when storing the text. This allows to recover the original text when the absent modules becomes available. Rider: Rider is defined as an extension of TextRiders.Rider type adding methods for writing and reading elements. Text manager: A text manager provides "This" and "New" operations. *) IMPORT Objects, Fonts, TextRiders; CONST (** An element is represented in the text character sequence as a character with ASCII code 1FX (unit separator). *) ElemChar* = 01FX; (** notify codes: NotifyMsg.id *) nop* = 0; (** no operation *) replace* = 1; (** a text subrange was changed *) insert* = 2; (** a text subrange was inserted *) delete* = 3; (** a text subrange was deleted *) TYPE (** Character attributes *) CharAttr* = POINTER TO CharAttrDesc; CharAttrDesc* = RECORD font-: Fonts.Font; col- : LONGINT; voff-: LONGINT; END; (** Text descriptor *) Text* = POINTER TO TextDesc; TextDesc* = RECORD (Objects.StreamDesc) len- : LONGINT; font* : Fonts.Font; (** default font *) col* : LONGINT; (** default color *) voff* : LONGINT; (** default offset *) notify*: BOOLEAN; (** notification flag *) PROCEDURE (T: Text) Notify*(op: INTEGER; beg,end: LONGINT); PROCEDURE (T: Text) Attach*(o: Objects.Object); PROCEDURE (T: Text) Detach*(o: Objects.Object); PROCEDURE (T: Text) Delete*(beg,end: LONGINT); PROCEDURE (T: Text) Append*(text: Text); PROCEDURE (T: Text) Insert*(pos: LONGINT; text: Text; beg,end: LONGINT); PROCEDURE (T: Text) Move*(pos: LONGINT; text: Text; beg,end: LONGINT); PROCEDURE (T: Text) ChangeLooks*(beg,end: LONGINT; sel: SET; font: Fonts.Font; col,voff: LONGINT); END; (** Notify message *) NotifyMsg* = RECORD (Objects.Message) id* : INTEGER; (** operation *) text* : Text; (** changed text *) beg*,end*: LONGINT; (** subrange [beg..end) *) END; (** An abstract character object *) Elem* = POINTER TO ElemDesc; ElemDesc* = RECORD (Objects.ObjectDesc) text- : Text; cattr-: CharAttr; W-,H- : LONGINT; (** dimensions in abstract units *) PROCEDURE (e: Elem) Resize*(W,H: LONGINT); PROCEDURE (e: Elem) Persistent*(): BOOLEAN; END; (** An alien element *) Alien* = POINTER TO AlienDesc; AlienDesc = RECORD (ElemDesc) gen-: Objects.String; (** Generator *) len-: LONGINT; (** length of external representation *) END; (** ASCII Rider extended with character attributes and elements. *) RiderRef* = POINTER TO Rider; Rider* = RECORD (TextRiders.Rider) font*: Fonts.Font; col* : LONGINT; voff*: LONGINT; elem*: Elem; PROCEDURE (VAR r: Rider) ReadElem*; PROCEDURE (VAR r: Rider) PrevElem*; PROCEDURE (VAR r: Rider) WriteElem*(e: Elem); END; Link* = POINTER TO LinkDesc; LinkDesc* = RECORD (Objects.LinkDesc) PROCEDURE (l: Link) ReadElem*(VAR r: Rider); PROCEDURE (l: Link) PrevElem*(VAR r: Rider); PROCEDURE (l: Link) WriteElem*(VAR r: Rider; e: Elem); END; (** Text Manager *) Manager* = POINTER TO ManagerDesc; ManagerDesc* = RECORD (Objects.ObjectDesc) res* : Objects.Error; (** result of operation *) font*: Fonts.Font; (** default font *) col* : LONGINT; (** default color *) voff*: LONGINT; (** default offset *) PROCEDURE (m: Manager) This*(name: ARRAY OF CHAR): Text; PROCEDURE (m: Manager) New*(): Text; PROCEDURE (m: Manager) Init*; END; VAR cur- : Manager; (** current manager *) def- : Manager; (** default manager *) log* : Text; (** system log text *) save*: Text; (** the last deleted text *) PROCEDURE (l: Link) ReadElem*(VAR r: Rider); (** Sets next element to r.elem (or NIL). *) PROCEDURE (l: Link) PrevElem*(VAR r: Rider); (** Sets previous element to r.elem (or NIL). *) PROCEDURE (l: Link) WriteElem*(VAR r: Rider; e: Elem); (** Inserts an element into the current position *) (**---------------------- Rider -------------------**) PROCEDURE (VAR r: Rider) ReadElem*; (** Sets the next element (or NIL) to "r.elem". *) PROCEDURE (VAR r: Rider) PrevElem*; (** Sets the previous element (or NIL) to "r.elem". *) PROCEDURE (VAR r: Rider) WriteElem*(e: Elem); (** Inserts an element into the current position *) (**-------------------- Elements ------------------**) PROCEDURE (e: Elem) Resize*(W,H: LONGINT); (** Sets the element dimensions (when internalizing) *) PROCEDURE (e: Elem) Persistent*(): BOOLEAN; (** An element will be ignored (when externalizing text) if this method returns FALSE. Implementation: RETURN TRUE *) (**---------------------- Texts -------------------**) PROCEDURE (T: Text) Attach*(o: Objects.Object); (** Appends an object to notify list *) PROCEDURE (T: Text) Detach*(o: Objects.Object); (** Deletes an object to notify list *) PROCEDURE (T: Text) Delete*(beg,end: LONGINT); (** Deletes the text subrange [beg..end). Sends "delete" message to all attached objects. Deleted text is moved to "save" text. *) PROCEDURE (T: Text) Append*(text: Text); (** Moves "text" to "T". Sends "insert" message to all objects attached to "T" and "delete" message to all objects attached to "text". *) PROCEDURE (T: Text) Insert*(pos: LONGINT; text: Text; beg,end: LONGINT); (** Inserts a copy of "text" subrange [beg..end) to "T" in position "pos" The "text" remains unchanged. Sends "insert" message to all objects attached to "T". *) PROCEDURE (T: Text) Move*(pos: LONGINT; text: Text; beg,end: LONGINT); (** Moves a subrange [beg..end) from "text" to "T" into position "pos". If texts are the same (text=T) sends "replace" message to all object attached, otherwise sends "insert" message to "T" attached objects and "delete" message to "text" attached objects. *) PROCEDURE (T: Text) ChangeLooks*(beg,end: LONGINT; sel: SET; font: Fonts.Font; col,voff: LONGINT); (** Changes character attributes in the subrange [beg..end). "sel" selects attributes to be changed. 0 IN sel - change font 1 IN sel - change color 2 IN sel - change vertical offset *) PROCEDURE (T: Text) Notify*(op: INTEGER; beg,end: LONGINT); PROCEDURE InitText*(T: Text); (** Text initialization *) (**--------------------- Manager ------------------**) PROCEDURE (m: Manager) This*(name: ARRAY OF CHAR): Text; (** Load a text from the file. Returns empty text, if the file can't be opened. If the file contains plain ASCII text set default attributes to all characters. "m.res" contains a result of operation. *) PROCEDURE (m: Manager) New*(): Text; (** Creates a new (empty) text. *) PROCEDURE (m: Manager) Init*; (** Manager initialization. Implementation: empty. *) PROCEDURE SetManager*(m: Manager); (** Sets current manager and calls "Init" method. If m=NIL then sets current manager as a clone of the default manager. As the application level (usually) gets a text from the current manager the call of this procedure will influence to all applications. A new text manager should forward unsatisfied requests to the default manager. *) END Texts.
TextWindows (** Copyright (c) 1993 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril v2.0 *) DEFINITION TextWindows; (** The module defines the notation of text windows - the visial interpretation of texts with embedded elements. To implement this notation the module defines types "Window", "Handler", "Manager" and "Elem". Window: The type "Window" corresponds to the view and partially controller components from the MVC concept. An additional object "Handler" implements the part of controller component dealing with keyboard input. The module defines a semi-abstract text windows, ie. some methods are not implemented here. During initialization the module creates (an extended) manager using generator defined by the environment string "TWMANAGER". If such string is not defined than the default generator "STextWindows.@ManagerDesc" is used. Handler: Text windows are rather heavy-weight and in the most case an application can redefine the "Handler" type only. The standard implementation of method "Edit" forwards all keyboard messages to the handler object. The manager contains the field "gen" defining the generator which is used to create new handler object. This field is initialized by the value of environment variable "TEXTHANDLER" ("STextHandler.@HandlerDesc" by default). Manager: A manager provides creation operations. Elem: A displayable element derived from "Texts.Elem". *) IMPORT Objects, Display, Windows, Texts, Main; CONST (** absract unit: Windows.mm *) mm* = Display.mm; (** Text window options: *) attrOpt* = 0; (** take attributes from the previous character. See Handler.Write. *) (** state of selection: bits in Window.sel *) selected* = {0}; (** selection if defined *) visible* = {1}; (** selection is (partially) visible *) TYPE (** The type "Location" describes the location of a character on the screen. *) Location* = RECORD (** location in model space: *) org* : LONGINT; (** line origin *) len* : LONGINT; (** line length *) pos* : LONGINT; (** current position *) (** location in viewer space: *) x*,y* : LONGINT; (** coordinates *) dx*,dy*: LONGINT; (** width and height *) dsr* : LONGINT; (** line descender *) END; Window* = POINTER TO WindowDesc; (** A keyboard handler *) Handler* = POINTER TO HandlerDesc; HandlerDesc* = RECORD (Objects.ObjectDesc) window-: Window; PROCEDURE (x: Handler) Connect*(v: Window); PROCEDURE (x: Handler) Write*(ch: CHAR); END; (** Text window *) WindowDesc* = RECORD (Windows.WindowDesc) handler- : Handler; (** keyboard handler *) text- : Texts.Text; (** associated text *) org- : LONGINT; (** text origin *) lmarg- : LONGINT; (** left margin *) umarg- : LONGINT; (** upper margin *) lsp- : LONGINT; (** line spacing *) car- : BOOLEAN; (** caret is set *) carloc- : Location; (** caret location *) sel- : SET; (** state of selection *) stamp- : LONGINT; (** stamp of selection *) beg-,end-: LONGINT; (** selection range *) selbeg- : Location; (** visible selection start *) selend- : Location; (** visible selection end *) opts* : SET; (** options *) PROCEDURE (v: Window) ShowFrom*(pos: LONGINT); PROCEDURE (v: Window) Show*(pos: LONGINT); PROCEDURE (v: Window) Update*(VAR M: Texts.NotifyMsg); PROCEDURE (v: Window) TrackCaret*(x,y: LONGINT; VAR keys: SET); PROCEDURE (v: Window) TrackSelection*(x,y: LONGINT; VAR keys: SET); PROCEDURE (v: Window) TrackWord*(x,y: LONGINT; VAR keys: SET; VAR pos: LONGINT); PROCEDURE (v: Window) LocatePos*(pos: LONGINT; VAR loc: Location); PROCEDURE (v: Window) TextPos*(x,y: LONGINT): LONGINT; PROCEDURE (v: Window) RemoveCaret*; PROCEDURE (v: Window) SetCaret*(pos: LONGINT); PROCEDURE (v: Window) RemoveSelection*; PROCEDURE (v: Window) SetSelection*(beg,end: LONGINT); PROCEDURE (v: Window) RenewSelection*; PROCEDURE (v: Window) EditElem*(e: Texts.Elem; pos: LONGINT; VAR M: Main.InputMsg); PROCEDURE (v: Window) Edit*(VAR M: Main.InputMsg); PROCEDURE (v: Window) InstallHandler*(x: Handler); END; (** An abstract displayable element *) Elem* = POINTER TO ElemDesc; ElemDesc* = RECORD (Texts.ElemDesc) w*,h*: LONGINT; (** in pixels *) PROCEDURE (e: Elem) Prepare*(v: Window); PROCEDURE (e: Elem) Draw*(tool: Windows.Tool; x,y,indent,pos: LONGINT); PROCEDURE (e: Elem) Edit*(v: Window; x,y,indent,pos: LONGINT; VAR M: Main.InputMsg); END; (** Text window manager *) Manager* = POINTER TO ManagerDesc; ManagerDesc* = RECORD (Objects.ObjectDesc) left* : LONGINT; (** left margin *) up* : LONGINT; (** upper margin *) lsp* : LONGINT; (** line spacing *) normal*: LONGINT; (** background for "normal" windows *) menu* : LONGINT; (** background for "menu" windows *) gen* : ARRAY 64 OF CHAR; (** handler Generator *) PROCEDURE (m: Manager) NewText*(T: Texts.Text; pos: LONGINT): Window; PROCEDURE (m: Manager) NewMenu*(name: ARRAY OF CHAR; menu: Texts.Text): Window; PROCEDURE (m: Manager) NewHandler*(): Handler; PROCEDURE (m: Manager) Init*; END; CONST (** SelectionMsg.id: *) getsel* = 8; setsel* = 9; extend* = 10; TYPE (** Ask reciever to get, set or extend selection. get is valid if stamp>=0. *) SelectionMsg* = RECORD (Texts.NotifyMsg) (** id, text, beg, end *) stamp*: LONGINT; (** of selection *) END; (** Asks reciever to copy over text[beg..end) to its caret position. *) CopyOverMsg* = RECORD (Objects.Message) text*: Texts.Text; beg* : LONGINT; end* : LONGINT; END; VAR cur- : Manager; (** current manager *) def- : Manager; (** default manager *) stamp-: LONGINT; (** selection stamp *) (**-------------------- Elements ------------------**) PROCEDURE (e: Elem) Prepare*(v: Window); (** Calculates "w" and "h" (in pixels). Implementation: Caclulates "w" and "h" using "e.W" and "e.H". *) PROCEDURE (e: Elem) Draw*(tool: Windows.Tool; x,y,indent,pos: LONGINT); (** Draws an element in the window. "tool.clip" defines clipping rectangle. (x,y) - left bottom corner of element area; indent - a line descender; pos - text position. Implementation: empty. *) PROCEDURE (e: Elem) Edit*(v: Window; x,y,indent,pos: LONGINT; VAR M: Main.InputMsg); (** An element reaction on the input message. Implementation: Skips input messages until all buttons will be released. *) (**--------------------- Windows ------------------**) PROCEDURE (v: Window) ShowFrom*(pos: LONGINT); (** Redraws the text starting from text position "pos". Should be redefined for all extensions. Implementation: v.org:=pos; *) PROCEDURE (v: Window) Show*(pos: LONGINT); (** Makes the text position "pos" visible. Tries to minimize the action. Does nothing if the position was visible before call. Should be redefined for all extensions. Implementation: empty. *) PROCEDURE (v: Window) Update*(VAR M: Texts.NotifyMsg); (** Updates the window after text changes. The method is called from Window.Handle method. Should be redefined for all extensions. Implementation: empty. *) (**------------------- Tracking -------------------**) PROCEDURE (v: Window) TrackCaret*(x,y: LONGINT; VAR keys: SET); (** Tracks mouse to place caret, starting from (x,y) in window relative coordinates. Accumulates all mouse buttons pressed in "keys". The method is called from Window.Edit method. Should be redefined for all extensions. Implementation: empty. *) PROCEDURE (v: Window) TrackSelection*(x,y: LONGINT; VAR keys: SET); (** Tracks mouse to place selection, starting from (x,y) in window relative coordinates. Accumulates all mouse buttons pressed in "keys". The method is called from Window.Edit method. Should be redefined for all extensions. Implementation: empty. *) PROCEDURE (v: Window) TrackWord*(x,y: LONGINT; VAR keys: SET; VAR pos: LONGINT); (** Tracks mouse to find word, starting from (x,y) in window relative coordinates. Accumulates all mouse buttons pressed in "keys". Returns a starting position of word in "pos", or -1 if the word was not found. The method is called from Window.Edit method. Should be redefined for all extensions. Implementation: empty. *) (**------------------- Locators -------------------**) PROCEDURE (v: Window) LocatePos*(pos: LONGINT; VAR loc: Location); (** Returns the location of text position "pos". If the position is invisible returns the location of the first or last visible character. Should be redefined for all extensions. Implementation: empty. *) PROCEDURE (v: Window) TextPos*(x,y: LONGINT): LONGINT; (** Returns the text position of the character placed in the point (x,y) in the window relative coordinates. Should be redefined for all extensions. Implementation: empty. *) (**---------------------- Caret -------------------**) PROCEDURE (v: Window) RemoveCaret*; (** Removes caret. An extension should provide visual feedback. *) PROCEDURE (v: Window) SetCaret*(pos: LONGINT); (** Sets caret if the text position "pos" is visible. An extension should provide visual feedback. *) (**-------------------- Selection -----------------**) PROCEDURE (v: Window) RemoveSelection*; (** Removes selection. An extension should provide visual feedback. *) PROCEDURE (v: Window) SetSelection*(beg,end: LONGINT); (** Sets selection if the subrange is not empty. "v.selbeg" and "v.selend" are set according to visible selection range. An extension should provide visual feedback. *) PROCEDURE (v: Window) RenewSelection*; (** Sets new stamp for the current selection, thus makes this selection the most recent one. *) (**--------------------- Editing ------------------**) PROCEDURE (v: Window) EditElem*(e: Texts.Elem; pos: LONGINT; VAR M: Main.InputMsg); (** Forwards the input message to the element "e" in text position "pos". *) PROCEDURE (v: Window) Edit*(VAR M: Main.InputMsg); (** Supports editing operations. Calls methods: v.handler.Handle, v.Track*, v.EditElem. *) PROCEDURE (v: Window) Handle*(VAR M: Objects.Message); (** Dispaths the message, recognizes: Texts.NotifyMsg, Main.InputMsg, SelectionMsg, CopyOverMsg. *) (**-------------------- Handlers ------------------**) PROCEDURE (x: Handler) Connect*(v: Window); (** The method is called when installing handler *) PROCEDURE (x: Handler) Write*(ch: CHAR); (** Inserts the character into the caret position. If the "attrOpt" is set, gets character attributes from the previous chacacter, otherwise uses the default attributes from the displayed text. *) PROCEDURE (v: Window) InstallHandler*(x: Handler); (** Installs the handler. Calls x.Connect *) (**--------------------- Manager ------------------**) PROCEDURE (m: Manager) NewText*(T: Texts.Text; pos: LONGINT): Window; (** Creates the new window. *) PROCEDURE (m: Manager) NewMenu*(name: ARRAY OF CHAR; menu: Texts.Te xt): Window; (** Creates the new menu window. *) PROCEDURE (m: Manager) NewHandler*(): Handler; (** Creates the new handler *) PROCEDURE (m: Manager) Init*; (** Manager initialization. Implementation: empty. *) PROCEDURE SetManager*(m: Manager); (** Sets current manager and calls "Init" method. If m=NIL then sets current manager as a clone of the default manager. As the application level (usually) gets a text window from the current manager the call of this procedure will influence to all applications. *) (**--------------- Auxilary procedures ------------**) PROCEDURE Call*(v: Window; pos: LONGINT; new: BOOLEAN); (** Calls the command, staring from the position "pos". Forces module reloading if "new" is set. *) PROCEDURE GetSelection*(VAR M: SelectionMsg); (** Returns the most recent selection (valid if M.stamp>=0). Implementation: brodcast the message to all windows. *) PROCEDURE InitWindow*(v: Window; T: Texts.Text; pos: LONGINT; m: Manager); (** Window initialization. Should be used in extensions only. *) END TextWindows.
TrueColors (** Copyright (c) 1992,93 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril 2.0 *) DEFINITION TrueColors; (** Module defines a set of colors in device-independent TrueColor format. TrueColor value is 32-bit integer. Three bytes in it represent RGB values: MSB LSB | byte 3 | byte 2 | byte 1 | byte 0 | | | | |______ red | | |_______________ green | |________________________ blue | reserved (should be equal to zero) Not all colors may be available on given platform. The system will try to choose the most close available color. *) CONST (** R, G, B *) black* = 0; (** 0, 0, 0 *) grey* = 4210752; (** 64, 64, 64 *) normal* = 8421504; (** 128,128,128 *) white* = 12632256; (** 192,192,192 *) highlight* = 16777215; (** 255,255,255 *) red* = 192; (** 192, 0, 0 *) green* = 49152; (** 0,192, 0 *) blue* = 12582912; (** 0, 0,192 *) yellow* = 49344; (** 192,192, 0 *) magenta* = 12583104; (** 192, 0,192 *) cyan* = 12632064; (** 0,192,192 *) END TrueColors.
Utils (** Copyright (c) 1993 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril v2.0 *) DEFINITION Utils; (** The module implements a set of operation useful for various commands, including: - command parameter support - Log output support - text search - creating standard (scrollable) viewers - windows naming and seacrhing Standard Viewer The module defines a set of constants to control the view of created viewer. The module uses the following managers: to create viewer - Viewers.cur to create scrollable window - Scrollers.cur to create text window - TextWindows.cur Standard Menu During initialization the module tries to read a text "SysMenu.stx". If this file is available the text will be used as the text of standard menu window, otherwise the default menu text will be used. *) IMPORT Objects, Windows, TextRiders, Texts; CONST (** Standard names of "menu" and "work" window *) MENUBAR* = "$MENUBAR"; WORK* = "$WORK"; (** bits in "open viewer" tags. See procedures OpenViewer and TextViewer. *) menu* = 0; (** create standard menu window *) system* = 1; (** create a viewer on "system" track *) scrollX* = 2; (** create a horizontal scroller *) scrollY* = 3; (** create a vertical scroller *) VAR Menu* : Texts.Text; (** standard menu text *) (** Seacrh attributes *) pattern-: ARRAY 128 OF CHAR; (** the current pattern *) plen- : INTEGER; (** the patter length *) stamp- : LONGINT; (** stamp of the last selection *) (**------------------- Parameters -----------------**) PROCEDURE SetToPar*(VAR R: TextRiders.Rider); (** Sets the rider to the parameter stream (Main.par.stream,Main.par.pos) or, if there is the "^" symbol in the stream, to the beginning of the most recent selection. *) PROCEDURE ReadColor*(VAR R: TextRiders.Rider; VAR c: LONGINT); (** Reads a TrueColor value in one of the formats: number which stands for TrueColor value, or "#" R G B where R,G,B are numbers in the range [0..255]. *) (**----------------- Standard Output --------------**) PROCEDURE SetToLog*(VAR R: TextRiders.Rider); (** Sets the rider to the end of Log text (standard output). *) PROCEDURE perror*(e: Objects.Error); (** Appends an error message to the end of Log text *) (**------------ Window Naming and Search ----------**) PROCEDURE SetName*(v: Windows.Window; name: ARRAY OF CHAR); (** Appends to the window attibute list the string attribute ("NAME",name). *) PROCEDURE FindWindow*(v: Windows.Window; path: ARRAY OF CHAR): Windows.Window; (** Tries to find a window, using the name "path". Path looks like a standard Unix file path. Examples: FindWindow(v,"../XYZ") find a "brother" of window "v" named "XYZ". FindWindow(v,"panel/scrollX") find a window named "scrollX" placed on window named "panel" placed on window "v". *) PROCEDURE Lookup*(v: Windows.Window; name: ARRAY OF CHAR; tree: BOOLEAN): Windows.Window; (** Tries to find a window named "name" among sons of window "v" or, if "tree=TRUE" among all descendants. Returns the first found window. Example: Lookup(Marked(),WORK,TRUE) find "work" subwindow in the marked viewer. *) PROCEDURE GetViewer*(v: Windows.Window): Windows.Window; (** Returns the viewer which contains the window "v" *) PROCEDURE Marked*(): Windows.Window; (** Returns the marked window or NIL *) (**---------------- Standard Viewers --------------**) PROCEDURE OpenViewer*(title,file: ARRAY OF CHAR; tags: SET; work: Windows.Window); (** Creates a standard viewer with standard menu window (if menu IN tags) and work window "work". Sets the names to menu and work window, see consts MENU and WORK respectively. Opens the viewer. *) PROCEDURE TextViewer*(title,file: ARRAY OF CHAR; tags: SET; text: Texts.Text); (** The same as "OpenViewer" but creates text window as work window. *) (**------------------- Text Search ----------------**) PROCEDURE SetPattern*(p: ARRAY OF CHAR); (** Sets the search pattern *) PROCEDURE SetText*(text: Texts.Text; pos,size: LONGINT); (** Sets the search pattern from the text *) PROCEDURE Match*(text: Texts.Text; pos: LONGINT): LONGINT; (** Compares the text starting from position "pos" with current pattern. Returns the position, if the pattern was found or -1 otherwise. *) (**------------------- Plain Store ----------------**) PROCEDURE PlainStore*(T: Texts.Text; VAR ou: Objects.Rider; sep: CHAR); (** Write a text as a plain ASCII text to the rider "ou". "sep" defines a line separator. If "sep=0FFX" then CR LF sequence will be written as line separator. *) (**-------------------- Cursor --------------------**) PROCEDURE Wait*(start: BOOLEAN); (** If "start=TRUE" changes the cursor shape to the "clock" shape, otherwise restore the cursor shape. The procedure can be used to show user that the long task is executed. *) END Utils.
Viewers (** Copyright (c) 1993 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril v2.0 *) DEFINITION Viewers; (** The module defines standard viewers, which contain two sub-windows: "menu" and "work". A standard viewer also contains a title and a border. A border areas can be used to move and/or resize a viewer. A title of a viewer is stored as a window attribute (Attrs.Flex) and can be retrieved using "Attrs.Find" function. A viewer manager defines user and system areas on the screen and provides operations of creation windows in the user and system area. The system does not support the notion of "Track" (as in Oberon system). All viewers can be freely moved and resized. Nevertheless, a viewer manager defines user and system areas on the screen and provides operations of window creation in the user and system area. It helps to provide default window displacement. *) IMPORT Objects, Windows, Graphics; CONST TITLE* = "TITLE"; (** name of "title" attribute *) mark* = 1; (** mark viewer *) unmark* = 2; (** delete mark *) lookup* = 3; (** search for marked viewer *) TYPE (** Control message *) ControlRef* = POINTER TO ControlMsg; ControlMsg* = RECORD (Objects.Message) id* : INTEGER; viewer*: Windows.Window; END; (** Standard viewer *) Window* = POINTER TO WindowDesc; WindowDesc* = RECORD (Graphics.WindowDesc) END; (** Viewer manager *) Manager* = POINTER TO ManagerDesc; ManagerDesc* = RECORD (Objects.ObjectDesc) userX* : LONGINT; userW* : LONGINT; systemX*: LONGINT; systemW*: LONGINT; PROCEDURE (m: Manager) New*(parent: Windows.Window; x,y,w,h: LONGINT; title: ARRAY OF CHAR; menu,work: Windows.Window ): Windows.Window; PROCEDURE (m: Manager) User*(title: ARRAY OF CHAR; menu,work: Windows.Window ): Windows.Window; PROCEDURE (m: Manager) System*(title: ARRAY OF CHAR; menu,work: Windows.Window ): Windows.Window; PROCEDURE (m: Manager) Init*; END; VAR cur-: Manager; (** current manager *) def-: Manager; (** default manager *) (**--------------------- Manager ------------------**) PROCEDURE (m: Manager) New*(parent: Windows.Window; x,y,w,h: LONGINT; title: ARRAY OF CHAR; menu,work: Windows.Window ): Windows.Window; (** Returns a new viewer, placed on window "parent", with two sub-windows "menu" (optional, can be NIL) and "work". *) PROCEDURE (m: Manager) User*(title: ARRAY OF CHAR; menu,work: Windows.Window ): Windows.Window; (** Return a new viewer, placed on the user area *) PROCEDURE (m: Manager) System*(title: ARRAY OF CHAR; menu,work: Windows.Window ): Windows.Window; (** Return a new viewer, placed on the system area *) PROCEDURE (m: Manager) Init*; (** Manager initialization. The method is called by SetManager (See below). *) PROCEDURE SetManager*(m: Manager); (** Sets current manager and calls "Init" method. If m=NIL then sets current manager as a clone of the default manager. *) (**--------------- Service Operations -------------**) PROCEDURE Marked*(): Windows.Window; (** Returns the marked viewer or NIL *) PROCEDURE GetViewer*(v: Windows.Window): Windows.Window; (** Returns a viewer, containing the window "v" *) PROCEDURE Close*(v: Windows.Window); (** Closes viewer, containing the window "v" and removes previously closed viewer. The most recently closed viewer can be restored, see Recall. *) PROCEDURE Recall*; (** Restores the most recently closed viewer, if any. *) PROCEDURE Remove*; (** Removes the most recently closed viewer *) END Viewers.
Windows (** Copyright (c) 1993 xTech Ltd, Russia. All Rights Reserved. *) (** Mithril v2.0 *) DEFINITION Windows; (** Module defines the basic window type (Window), the instrument for drawing graphic primitives on window (Tool) and introduces a notion of Cursor and Painter objects. Window: A window is a persistent object represented as a rectangular area on the screen. Each window is either open or closed. An open window may be seen on the screen, in whole or partially. A closed window is not seen. Note that an open window may be completely hidden by other windows. Any window may have several subwindows belonging to it. These subwindows are always contained in the window; they move on the screen together with it. Each subwindow may, in turn, contain subwindows. Thus, all windows form a tree-like hierarchy. Speaking about this hierarchy, we will use the standard "family" terminology. Children, or sons of a window are its immediate subwindows. The parent window is the window for which this one is a son. Every window has a parent; with the exception of one, the so-called meta-window (or "Surface"). Children of the meta-window are desktops corresponding to physical screens (displays). Usually there is only one physical screen; and hence ony one visible desktop. The system also defines special "hidden" desktop which does not correspond to physical screen and is used as temporary parent for newly created windows. (See the Copy procedure) An window dispacement is determined by its its horizontal and verical sizes (w,h) and the coordinates of its left lower corner relatively to the parent window (x,y) and relatevely to "Surface" (sx,sy). Window management: Window management procedures allow one to move and/or resize windows on the screen, to change the state of a window or its position in the window hierarchy. Window image: As a rule a window extension appends to a window a displayable data structure - the so-called image. The set of method is introduced which defines an interface between a window and an underlying image and are usually redefined in extensions. Gravity: The notion of gravity serves to specify the behaviour of subwindows when the dimensions of a window containing them are changed. One may set a gravity property for the left lower and/or the right upper corner of a window by specifying one of the nine reference points on the parent window the distance from which to that corner will be automatically preserved. Drawing in a window: The module Windows provides a set of operations for drawing primitives in a window; e.g. drawing a point, a line, a rectangle, a string, etc. Each drawing operation is a method of the Tool object, which determines "drawing context". The basic type Tool is defined in the module Display (Display.Tool). The drawing context includes: - writing mode - color - clipping rectangle - origin of coordinates Before drawing one have to retrieve (or create) a Tool object for given window (See GetTool and NewTool). Drawing complex objects: When the visible part of the window consists of several regions, the drawing operation is applied to them consecutively. If the graphic object to be depicted consists of many primitives then, to reduce overhead expenses, one should use the extension of the so-called Painter object. An extended painter object should implement the Painter.Draw method. When drawing such a painter object (using Tool.Draw operation) the Painter.Draw method will be applied consecutively to all intersections of the window's visible part with the tool's clipping region. Thus, these intersections will be calculated only once; no matter what the number of primitives. The system includes the set of predefined painter objects (See modules Figures and Decor). Focus window: A notion of "focus" window is introduced to define a path of input messages through the window hierarchy. Each window contains a field "focus" which is either NIL or points to a subwindow. An input message is passed through this list starting from "Surface" (See the "Main" module for more details). Window attributes: A window contains a list of attributes (See the "Attrs" module) thus allowing one to append an arbitrary attribute to the window. The module Windows does not define a meaning of any attribute. Window cursor style: Two different methods can be used to determine a style of mouse cursor when it is placed on the given window: 1) set the field "marker" to desired style (marker>0). In this case the style of cursor will be automatically set to v.marker when entering the window. 2) redefine the "Enter" method which is called when the cursor enters the window (only if v.marker<0). By default v.marker is set to Display.arrow. *) IMPORT Objects, Fonts, Display, Attrs; CONST (** window state *) closed* = 0; (** window is closed *) visible* = 1; (** window is openned along with all its ancestors. *) (** gravity reference points *) Z* = 0; (** center *) N* = 1; (** North: middle of upper bound *) NE* = 2; (** North-East: upper right corner *) E* = 3; (** East: middle of right bound *) SE* = 4; (** South-East: lower right corner *) S* = 5; (** South: middle of lower bound *) SW* = 6; (** South-West: lower left corner *) W* = 7; (** West: middle of left bound *) NW* = 8; (** North-East: upper left corner *) (** absract unit: Display.mm *) mm* = Display.mm; (** graphic operation mode *) rep* = Display.rep; xor* = Display.xor; TYPE Window* = POINTER TO WindowDesc; Block* = Display.Block; PixelMap* = Display.PixelMap; (** A drawing context *) Tool* = POINTER TO ToolDesc; ToolDesc* = RECORD (Display.ToolDesc) window-: Window; (** basic window *) PROCEDURE (t: Tool) String*(x,y: LONGINT; f: Fonts.Font; s: ARRAY OF CHAR); PROCEDURE (t: Tool) Draw*(VAR p: Painter); END; (** Basic window type *) WindowDesc* = RECORD (Objects.ObjectDesc) screen-: Display.PixelMap; (** base screen *) x-,y- : LONGINT; (** parent relative coordinates *) w-,h- : LONGINT; (** window dimensions *) sx-,sy-: LONGINT; (** "Surface" relative coordinates *) state- : SET; (** window state *) col- : LONGINT; (** background color (TrueColor) *) color- : SET; (** background color (device) *) parent-: Window; (** window parent *) sons- : Window; (** list of sons *) up- : Window; (** uppermost subwindow *) down- : Window; (** lowermost subwindow *) focus- : Window; (** focus subwindow *) minW- : LONGINT; (** minimum width *) maxW- : LONGINT; (** maximum width *) minH- : LONGINT; (** minimum height *) maxH- : LONGINT; (** maximum height *) ldc- : SHORTINT; (** gravity: left-down corner *) ruc- : SHORTINT; (** gravity: right-up corner *) attr* : Attrs.Attr; (** attribute list *) marker*: INTEGER; (** cursor style *) PROCEDURE (v: Window) Connect*; PROCEDURE (v: Window) AdaptToScreen*; PROCEDURE (v: Window) OpenImage*; PROCEDURE (v: Window) CloseImage*; PROCEDURE (v: Window) ResizeImage*(dw,dh: LONGINT); PROCEDURE (v: Window) Background*(x,y,w,h: LONGINT); PROCEDURE (v: Window) Foreground*(x,y,w,h: LONGINT); PROCEDURE (v: Window) Focus*(on: BOOLEAN); PROCEDURE (v: Window) Enter*(x,y: LONGINT); END; (** Abstract desktop *) Desktop* = POINTER TO DesktopDesc; DesktopDesc* = RECORD (WindowDesc) END; (** Cursor *) Cursor* = POINTER TO CursorDesc; CursorDesc* = RECORD (Objects.ObjectDesc) desktop-: Window; (** current desktop *) x-,y- : LONGINT; (** pin-point coordinares *) on- : BOOLEAN; (** visible if on *) marker- : Display.Marker; (** current style *) PROCEDURE (c: Cursor) Open*; PROCEDURE (c: Cursor) Turn*(on: BOOLEAN); PROCEDURE (c: Cursor) MoveTo*(x,y: LONGINT); PROCEDURE (c: Cursor) SetMarker*(no: INTEGER); END; (** Painter object (See Tool.Draw) *) Painter* = RECORD (Objects.ObjectDesc) PROCEDURE (VAR p: Painter) Draw*(t: Tool; x,y,w,h: LONGINT); END; VAR cursor- : Cursor; (** mouse cursor *) Surface-: Desktop; (** meta-window *) Hidden- : Desktop; (** hidden desktop *) (**----------------- Painter.Draw -----------------**) PROCEDURE (VAR p: Painter) Draw*(t: Tool; x,y,w,h: LONGINT); (** Draws a pointer object in the rectangle (x,y,w,h). Should be redefined for all painter objects. Implementation: empty *) (**----------- A Window/Image interface ------------**) PROCEDURE (v: Window) Connect*; (** The Connect method is called when installing window. For a given window the method is called only once. Can be used to initialize an image state. See also AdaptToScreen. Implementation: empty. *) PROCEDURE (v: Window) AdaptToScreen*; (** The method is called when the window is passed from one screen (PixelMap) to another. The method can be used to recalculate dimensions and/or colors in device-dependent units. Note that the method should be redefined even for a single screen systems since a window is often created on "Hidden" desktop. See also procedures Copy and Pass. Implementation: empty. *) PROCEDURE (v: Window) OpenImage*; (** The method is called when the window state is changed to visible. Can be used to prepare an image for subsequent drawings. Implementation: empty. *) PROCEDURE (v: Window) CloseImage*; (** The method is called when the window becomes invisible. Implementation: empty. *) PROCEDURE (v: Window) ResizeImage*(dw,dh: LONGINT); (** The method is called when changing the window dimensions. A purpose of the method is to adapt an image to the new window dimensions. The method is called after resizing but before refreshing the window. (dw,dh) denotes the difference between new and old width and height respectively (ie. dw>0 if the new width is greater than old one). Implementation: empty. *) PROCEDURE (v: Window) Background*(x,y,w,h: LONGINT); (** The method is called for refreshing the window background in the given rectangle. As a rule this method is not redefined. Implementation: draw a solid rectangle (color=v.col). *) PROCEDURE (v: Window) Foreground*(x,y,w,h: LONGINT); (** The method is called for refreshing the window foreground in the given rectangle. Should be redefined for all extensions. Implementation: empty. *) PROCEDURE (v: Window) Focus*(on: BOOLEAN); (** Inform the window that it became focus window or vice verse. When becaming focus the method can in turn call the SetFocus procedure to define a focus among its subwindows. Implementation: empty. *) PROCEDURE (v: Window) Enter*(x,y: LONGINT); (** The method is called when the mouse cursor enters the window (only if v.marker<0). The method can be used to change the cursor style. See also "Window cursor style". Implementation: empty. *) (**---------------- Window management -------------**) PROCEDURE Install*(parent,v: Window; x,y,w,h: LONGINT); (** Installs a window "v" on the "parent" window. (x,y) pair determines coordinates of left lower corner relatively to the parent window. (w,h) determines window dimensions. The "v" state is {closed}. Calls "v.Connect". *) PROCEDURE Open*(v: Window); (** Changes window state. Draws a window if its parent is visible. No operation if the window is not closed. *) PROCEDURE Close*(v: Window); (** Changes the window state to "closed". Forces a refresh if necesary. The window hierarchy is not changed. No operation if the window was closed. *) PROCEDURE Remove*(v: Window); (** Removes the window and all its descendants from the hierarchy, and closes all windows being thus removed. *) PROCEDURE Resize*(v: Window; x,y,w,h: LONGINT); (** Changes the dimensions and/or the placement of the window and its subwindows according gravity setings. Calls "v.ResizeImage" after resizing but before refreshing and thus gives a possibility to the window to recalculate its image. *) PROCEDURE OnTop*(v: Window); (** Makes a window "v" the uppermost window in the vertical hierarchy of its parent's subwindows. *) PROCEDURE OnBottom*(v: Window); (** Makes a window "v" the lowermost window in the vertical hierarchy of its parent's subwindows. *) PROCEDURE Pass*(v,parent: Window); (** Moves the window with all its descendants from one parent window to another (both in the hierarchy and on the screen). The moved window becomes the topmost one among the subwindows of the new parent. *) PROCEDURE Copy*(v: Window): Window; (** Creates a clone of window "v" (using CopyFrom method) and installs it on the "Hidden" desktop. Further the newly created window can be passed to desirable destination. *) (**------------ Setting window attributes ----------**) PROCEDURE SetGravity*(v: Window; ldc,ruc: SHORTINT); (** Sets the window gravity points which will determine the dimensions and the placement of the window when resizing the parent window. *) PROCEDURE SetColor*(v: Window; col: LONGINT); (** Sets a background color and forces a refresh if necessary. *) PROCEDURE SetMinSize*(v: Window; w,h: LONGINT); (** Sets minimum width and height of the window. These values will be used in subsequent calls of the Resize procedure. *) PROCEDURE SetMaxSize*(v: Window; w,h: LONGINT); (** Sets maximum width and height of the window. These values will be used in subsequent calls of the Resize procedure. *) (**--------------------- Refresh -------------------**) PROCEDURE Refresh*(v: Window; x,y,w,h: LONGINT); (** Forces window refresh (background and foreground) in the given rectangle. *) PROCEDURE Foreground*(v: Window; x,y,w,h: LONGINT); (** Forces window foreground refresh in the given rectangle. *) PROCEDURE Scroll*(v: Window; x,y,w,h,dx,dy: LONGINT); (** Moves a rectangular area (x,y,w,h) to (x+dx,y+dy) destination. Forces refresh if necessary. *) (**------------- Locators and Broadcast ------------**) PROCEDURE This*(v: Window; x,y: LONGINT): Window; (** Returns an direct uppermost subwindow placed in the point (x,y) or NIL if there is no subwindows in this point. *) PROCEDURE Locate*(v: Window; x,y: LONGINT): Window; (** Returns an uppermost descendant window place in the point (x,y) or NIL if there is no subwindows in this point. *) PROCEDURE Broadcast*(v: Window; VAR m: Objects.Message); (** Sends a message to the window and all its descendants. In the case "v=NIL" the message will be send to all windows in the system, ie.: Broadcast(NIL,m) is equal to Brodcast(Surface,m) *) (**---------------- Focus management ---------------**) PROCEDURE SetFocus*(v: Window); (** Sets an uppermost focus window. Calls the Focus(TRUE) method for all windows that became focus windows and Focus(FALSE) method for all windows which became not focus. See also the Window.Focus method. *) PROCEDURE GetFocus*(): Window; (** Returns an uppermost focus window. *) (**------------------ Getting Tools ----------------**) PROCEDURE NewTool*(v: Window): Tool; (** Creates a new tool and sets default attributes: mode=rep, color=MapColor(v.col), clip=window clip, origin=(0,0). *) PROCEDURE GetTool*(v: Window): Tool; (** Returns a tool, assosiated with the window. Tool' attributes are set to default values (See NewTool). *) (**--------------- Drawing operations -------------**) PROCEDURE (t: Tool) Dot*(x,y: LONGINT); (** Draws a dot. *) PROCEDURE (t: Tool) Pattern*(block: Display.Block; pw,ph: LONGINT; pattern: ARRAY OF SET); (** Draws a pattern. *) PROCEDURE (t: Tool) Chars*(x,y: LONGINT; f: Fonts.Font; s: ARRAY OF CHAR; pos,len: LONGINT); (** Draws a string *) PROCEDURE (t: Tool) String*(x,y: LONGINT; f: Fonts.Font; s: ARRAY OF CHAR); PROCEDURE (t: Tool) Draw*(VAR p: Painter); (** Draws a painter object. *) PROCEDURE (t: Tool) Char*(x,y: LONGINT; f: Fonts.Font; ch: CHAR); (** Draws a character. *) PROCEDURE (t: Tool) Line*(x0,y0,x1,y1: LONGINT); (** Draws a line. *) PROCEDURE (t: Tool) Block*(x,y,w,h: LONGINT); (** Draws a solid rectangle. *) PROCEDURE (t: Tool) Rectangle*(x0,y0,x1,y1: LONGINT); (** Draws a rectangle (frame). *) (**---------------- Cursor management --------------**) PROCEDURE (c: Cursor) Open*; (** Initializes the cursor attributes *) PROCEDURE (c: Cursor) MoveTo*(x,y: LONGINT); (** Moves the cursor pin-point to (x,y) *) PROCEDURE (c: Cursor) SetMarker*(no: INTEGER); (** Changes cursor style to "no" *) PROCEDURE (c: Cursor) Turn*(on: BOOLEAN); (** Draws or fades cursor depending on the parameter *) (**--------------- Auxilary operations -------------**) PROCEDURE Gravitate*(ldc,ruc: SHORTINT; dW,dH: LONGINT; VAR dx,dy,dw,dh: LONGINT); (** Calculates the changes in coordinates (dx,dy) and dimensions (dw,dh) of any rectangle (subwindow) according to gravity if the dimensions of parent rectangle (window) are changed as (dW,dH). *) PROCEDURE InstallDesktop*(v: Desktop; p: Display.PixelMap); (** Installs a new desktop on Surface on the right of installed ones. *) END Windows.

IMPRESSUM: The ModulaTor is an unrefereed journal. Technical papers are to be taken as working papers and personal rather than organizational statements. Items are printed at the discretion of the Editor based upon his judgement on the interest and relevancy to the readership. Letters, announcements, and other items of professional interest are selected on the same basis. Office of publication. The Editor of The ModulaTor is Günter Dotzel; he can be reached at mailto:[email deleted due to spam]


Home | Site_index | Legal | OpenVMS_compiler | Alpha_Oberon_System | ModulaTor | Bibliography | Oberon[-2]_links | Modula-2_links |

Amazon.com [3KB] [Any browser]

Books Music Video Enter keywords...


Amazon.com logo

Webdesign by www.otolo.com/webworx, 16-Dec-1998