home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / hex.mod (.txt) < prev    next >
Oberon Text  |  2012-04-20  |  34KB  |  1,026 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. MODULE Hex;    (* Hansjoerg Buchser; 25. 2. 1994 / MH 9 MAR 1994 *)
  5.     IMPORT Texts, TextFrames, Viewers, Display, Files, Oberon, MenuViewers, Fonts, SYSTEM, Input;
  6.     CONST StandardMenu = "System.Close  System.Copy  System.Grow  Hex.Search  Hex.StoreText  Hex.Store ";
  7.         updateByte = 0; changeFont = 1;    (* message id *)
  8.         ord0 = 48; ordA = 65; orda = 97;    (* ASCII values *)
  9.         hexdX = 3; dY = 3;    (* cursor overlapping *)
  10.         begOfLine = 20; barW = 13;    (* x-coords in Frame *)
  11.         colspace = 3; adrlen = 6;    (* number of chars *)
  12.         number = 16;    (* number of bytes per line *)
  13.         DefaultFont = "Courier12.Scn.Fnt";
  14.         MR = 0; MM = 1; ML = 2;
  15.         fgd = Display.white; bgd = Display.black;
  16.     TYPE
  17.         CursorCoord = POINTER TO CursorCoordDesc;
  18.         CursorCoordDesc = RECORD X, W : INTEGER END;
  19.         Model = POINTER TO ModelDesc;
  20.         ModelDesc = RECORD name : ARRAY 32 OF CHAR; file : Files.File END; 
  21.         Frame = POINTER TO FrameDesc;
  22.         FrameDesc = RECORD (Display.FrameDesc)
  23.             virgin, hasCursor : BOOLEAN;
  24.             cursor1, cursor2 : CursorCoord;    (* primary, secondary cursor *)
  25.             cursorY : INTEGER;
  26.             cursorBytePos : LONGINT;
  27.             model : Model;
  28.             org, len : LONGINT
  29.         END;
  30.         UpdateMsg = RECORD (Display.FrameMsg)
  31.             id : INTEGER;
  32.             file : Files.File;
  33.             pos : LONGINT;
  34.             ch : CHAR
  35.         END;
  36.         CursorMsg = RECORD (Display.FrameMsg)
  37.             pos : LONGINT;
  38.             file : Files.File;
  39.         END;
  40.         font : Fonts.Font;
  41.         fontwidth, fontheight, hmin, hmax, amin, amax : INTEGER;    (* display variables *)
  42.         cursorH, greybar1, greybar2, greybar3 : INTEGER;
  43.         hexcurs, asccurs : CursorCoord;
  44.         nextline : ARRAY number OF CHAR;    (* output variables *)
  45.         R : Files.Rider;
  46.         W : Texts.Writer;
  47.         res : INTEGER;
  48.     (* ____________________________ HexFrames-Part of Module __________________________ *)
  49.     (* ______________________________ some auxiliary functions ____________________________ *)
  50.     PROCEDURE Cap(ch : CHAR) : CHAR;
  51.     BEGIN
  52.         CASE ch OF "a".."z" : RETURN CAP(ch) ELSE RETURN ch END;
  53.     END Cap;
  54.     PROCEDURE DecToHex(d : LONGINT) : CHAR;
  55.     BEGIN
  56.         IF d < 10 THEN d := d + ord0 ELSE d := d + ordA - 10 END;
  57.         RETURN CHR(d)
  58.     END DecToHex;
  59.     PROCEDURE HexToDec(ch : CHAR) : INTEGER;
  60.     BEGIN
  61.         CASE ch OF  "A".."F" : RETURN ORD(ch) - ordA + 10
  62.         | "a".."f" : RETURN ORD(ch) - orda + 10
  63.         | "0".."9" : RETURN ORD(ch) - ord0
  64.         ELSE RETURN -1
  65.         END
  66.     END HexToDec;
  67.     PROCEDURE ReadableChar(ch : CHAR) : CHAR;
  68.     BEGIN
  69.         CASE ORD(ch) OF
  70.             32..126, 128..149, 155 : RETURN ch
  71.             ELSE RETURN "."
  72.         END
  73.     END ReadableChar;
  74.     (* ______________________________ init procedure ____________________________ *) 
  75.     PROCEDURE InitDisplayVars;
  76.         VAR dx, x, y, w, h : INTEGER;
  77.             p : Display.Pattern;
  78.     BEGIN
  79.         Display.GetChar(font.raster, "0", dx, x, y, w, h, p);
  80.         fontwidth := dx;
  81.         fontheight := font.height + 1;
  82.         hmin := begOfLine + (adrlen + colspace)*fontwidth;
  83.         hmax := hmin + (number*3 - 1)*fontwidth;
  84.         amin := hmax + colspace*fontwidth;
  85.         amax := amin + number*fontwidth;
  86.         greybar1 := hmin + (hmax - hmin - fontwidth) DIV 4;
  87.         greybar2 := hmin + (hmax - hmin) DIV 2;
  88.         greybar3 := hmax - (hmax - hmin - fontwidth) DIV 4;
  89.         NEW(hexcurs); hexcurs.W := 2*fontwidth + hexdX;
  90.         NEW(asccurs); asccurs.W := fontwidth;
  91.         cursorH := fontheight
  92.     END InitDisplayVars;
  93.     (* ______________________________ coord conversion ____________________________ *)
  94.     PROCEDURE GetLine(F : Frame; Y : INTEGER; VAR line : INTEGER);
  95.     BEGIN
  96.         IF Y >= F.Y THEN
  97.             line := (F.Y + F.H - Y - dY) DIV fontheight;
  98.             IF (line + 1)*fontheight >= F.H - dY THEN DEC(line) END;
  99.             IF line < 0 THEN line := 0 END
  100.         ELSE
  101.             line :=  (F.H  - dY) DIV fontheight - 1
  102.         END
  103.     END GetLine;
  104.     PROCEDURE GetOffset(F : Frame; X : INTEGER; VAR off : INTEGER);
  105.     BEGIN
  106.         IF (hmin <= X - F.X) & (X - F.X <= hmax) THEN
  107.             off := (X - F.X - hmin + fontwidth DIV 2) DIV (3*fontwidth)
  108.         ELSIF (amin <= X - F.X) & (X - F.X <= amax) THEN
  109.             off := (X - F.X - amin) DIV fontwidth
  110.         ELSE 
  111.             off := -1
  112.         END
  113.     END GetOffset;
  114.     PROCEDURE GetX(F : Frame; pos : LONGINT; VAR hX, aX : INTEGER);
  115.     BEGIN
  116.         IF pos < F.len THEN
  117.             DEC(pos, F.org);
  118.             pos := pos MOD number;
  119.             hX := F.X + hmin + SHORT(pos)*3*fontwidth;
  120.             aX := F.X + amin + SHORT(pos)*fontwidth
  121.         ELSE
  122.             hX := -1; aX := -1
  123.         END
  124.     END GetX;
  125.     PROCEDURE GetY(F : Frame; pos : LONGINT; VAR Y : INTEGER);
  126.     BEGIN
  127.         IF pos < F.len THEN
  128.             DEC(pos, F.org);
  129.             pos := pos DIV number;
  130.             Y := F.Y + F.H - (SHORT(pos) + 1)*fontheight
  131.         ELSE
  132.             Y := -1
  133.         END
  134.     END GetY;
  135.     (* ______________________________ display support ____________________________ *)
  136.     PROCEDURE WriteBang(F : Frame);
  137.         VAR R : Texts.Reader; V : Viewers.Viewer; T : Texts.Text; ch : CHAR;
  138.     BEGIN
  139.         V := Viewers.This(F.X, F.Y);
  140.         IF (V IS MenuViewers.Viewer) & (V.dsc IS TextFrames.Frame) THEN
  141.             T := V.dsc(TextFrames.Frame).text;
  142.             IF T.len > 0 THEN Texts.OpenReader(R, T, T.len - 1); Texts.Read(R, ch) ELSE ch := 0X END;
  143.             IF ch # "!" THEN Texts.Write(W, "!"); Texts.Append(T, W.buf) END
  144.         END
  145.     END WriteBang;
  146.     PROCEDURE DeleteBang(F : Frame);
  147.         VAR R : Texts.Reader; V : Viewers.Viewer; T : Texts.Text; ch : CHAR;
  148.     BEGIN
  149.         V := Viewers.This(F.X, F.Y);
  150.         IF (V IS MenuViewers.Viewer) & (V.dsc IS TextFrames.Frame) THEN
  151.             T := V.dsc(TextFrames.Frame).text;
  152.             IF T.len > 0 THEN Texts.OpenReader(R, T, T.len - 1); Texts.Read(R, ch) ELSE ch := 0X END;
  153.             IF ch = "!" THEN Texts.Delete(T, T.len - 1, T.len) END
  154.         END
  155.     END DeleteBang;
  156.     PROCEDURE InvertCursor(F : Frame);
  157.     BEGIN
  158.         IF (F.X < F.cursor1.X) & (F.cursor1.X + F.cursor1.W < F.X + F.W) &
  159.             (F.Y < F.cursorY) & (F.cursorY + cursorH <= F.Y + F.H) THEN
  160.             F.hasCursor := ~F.hasCursor;
  161.             Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  162.             Display.ReplConst(fgd, F.cursor1.X, F.cursorY, F.cursor1.W, cursorH, Display.invert);
  163.             Display.ReplConstC(F, fgd, F.cursor2.X, F.cursorY, F.cursor2.W, 2, Display.invert)
  164.         END
  165.     END InvertCursor;
  166.     PROCEDURE RemoveCursor(F : Frame);
  167.     BEGIN
  168.         IF F.hasCursor THEN
  169.             InvertCursor(F);
  170.             F.cursorBytePos := -1
  171.         END
  172.     END RemoveCursor;
  173.     PROCEDURE DrawCursor(F : Frame);
  174.     BEGIN
  175.         Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  176.         Display.ReplConstC(F, fgd, F.cursor1.X, F.cursorY, F.cursor1.W, cursorH, Display.invert);
  177.         Display.ReplConstC(F, fgd, F.cursor2.X, F.cursorY, F.cursor2.W, 2,Display.invert)
  178.     END DrawCursor;
  179.     PROCEDURE SetCursor(F : Frame; X, Y : INTEGER);
  180.         VAR offset, line : INTEGER;
  181.             pos : LONGINT;
  182.     BEGIN
  183.         GetOffset(F, X, offset);
  184.         GetLine(F, Y, line);
  185.         pos := LONG(line)*number + offset + F.org;
  186.         IF pos < F.len THEN
  187.             IF F.cursor1 = hexcurs THEN
  188.                 GetX(F, pos, F.cursor1.X, F.cursor2.X);
  189.                 DEC(F.cursor1.X, hexdX DIV 2)
  190.             ELSE (* F.cursor1 = asccurs *)
  191.                 GetX(F, pos, F.cursor2.X, F.cursor1.X);
  192.                 DEC(F.cursor2.X, hexdX DIV 2)
  193.             END;
  194.             GetY(F, pos, F.cursorY);
  195.             DEC(F.cursorY, dY);
  196.             F.cursorBytePos := pos;
  197.             InvertCursor(F)
  198.         END
  199.     END SetCursor;
  200.     (* ______________________________ draw file content ____________________________ *)
  201.     PROCEDURE ShowChar (F : Frame; ch : CHAR; VAR X : INTEGER; Y : INTEGER);
  202.         VAR dx, x, y, w, h : INTEGER; p : Display.Pattern;
  203.     BEGIN
  204.         IF (F.X < X) & (X + fontwidth < F.X + F.W) & (F.Y + dY < Y) & (Y + fontheight <= F.Y + F.H) THEN
  205.             Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  206.             Display.GetChar(font.raster, ch, dx, x, y, w, h, p);
  207.             Display.CopyPattern(fgd, p, X+x, Y+y, Display.replace);
  208.             INC(X, dx)
  209.         END
  210.     END ShowChar;
  211.     PROCEDURE ShowSpaces (F : Frame; num : INTEGER; VAR X : INTEGER; Y : INTEGER);
  212.         VAR i : INTEGER;
  213.     BEGIN i := 0;
  214.         WHILE i < num  DO ShowChar(F, " ", X, Y); INC(i) END
  215.     END ShowSpaces;
  216.     PROCEDURE ShowAddress(F : Frame; pos : LONGINT; VAR X : INTEGER; Y : INTEGER);
  217.         VAR div : LONGINT;
  218.     BEGIN
  219.         div := 0100000H;
  220.         REPEAT
  221.             ShowChar(F, DecToHex(pos DIV div), X, Y);
  222.             pos := pos MOD div;
  223.             div :=ASH(div, -4);
  224.         UNTIL div = 0;
  225.     END ShowAddress;
  226.     PROCEDURE ShowHexPart(F : Frame; max : INTEGER; VAR X : INTEGER; Y : INTEGER);
  227.         VAR i : INTEGER;
  228.     BEGIN
  229.         i := 0;
  230.         WHILE i < max DO
  231.             ShowChar(F, DecToHex(ASH(ORD(nextline[i]), -4)), X, Y);
  232.             ShowChar(F, DecToHex(ORD(nextline[i]) MOD 16), X, Y);
  233.             ShowSpaces(F, 1, X, Y);
  234.             INC(i)
  235.         END;
  236.         ShowSpaces(F, (number-i)*3, X, Y)
  237.     END ShowHexPart;
  238.     PROCEDURE ShowAscPart(F : Frame; max : INTEGER; VAR X : INTEGER; Y : INTEGER);
  239.         VAR i : INTEGER;
  240.     BEGIN
  241.         i := 0;
  242.         WHILE i < max DO
  243.             ShowChar(F, ReadableChar(nextline[i]), X, Y);
  244.             INC(i)
  245.         END
  246.     END ShowAscPart;
  247.     PROCEDURE ShowLine(F : Frame; Y, nr : INTEGER; adr : LONGINT);
  248.         VAR X : INTEGER;
  249.     BEGIN
  250.         X := F.X + begOfLine;
  251.         ShowAddress(F, adr, X, Y);
  252.         ShowSpaces(F, colspace, X, Y);
  253.         ShowHexPart(F, nr, X, Y);
  254.         ShowSpaces(F, colspace-1, X, Y);
  255.         ShowAscPart(F, nr, X, Y)
  256.     END ShowLine;
  257.     PROCEDURE DrawGreyBars(F : Frame);
  258.         VAR Y, H, line : INTEGER; help : LONGINT;
  259.     BEGIN
  260.         GetLine(F, F.Y + 1, line);
  261.         help := F.len - F.org;
  262.         IF (line + 1)*number > help THEN (* eof visible *)
  263.             Y := F.Y + F.H - SHORT((help - 1) DIV number + 1)*fontheight - dY;
  264.             H := SHORT((help - 1) DIV number + 1)*fontheight    
  265.         ELSE (* eof not visible *)
  266.             Y := F.Y + F.H - (line + 1)*fontheight - dY;
  267.             H := (line + 1)*fontheight
  268.         END;
  269.         IF (F.H - 1 - dY) DIV fontheight > 0 THEN (* at least one line visible *)    
  270.             Display.ReplPattern(fgd, Display.grey1, F.X + greybar1, Y, 1, H, Display.replace);
  271.             Display.ReplPattern(fgd, Display.grey1, F.X + greybar2, Y, 1, H, Display.replace);
  272.             Display.ReplPattern(fgd, Display.grey1, F.X + greybar3, Y, 1, H, Display.replace)
  273.         END
  274.     END DrawGreyBars;
  275.     PROCEDURE DrawClip(F : Frame);
  276.         CONST clipW = 8; clipH = 2;
  277.         VAR Y : INTEGER;
  278.     BEGIN
  279.         Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  280.         Display.ReplConst(bgd, F.X + 1, F.Y, barW - 2, F.H, Display.replace);
  281.         Y := F.Y + F.H - clipH - SHORT((F.H - clipH)*F.org DIV F.len);
  282.         Display.ReplConst(fgd, F.X + 1, Y, clipW, clipH, Display.replace)
  283.     END DrawClip;
  284.     PROCEDURE Draw(F : Frame; Y, maxY : INTEGER; pos : LONGINT);
  285.         VAR X : INTEGER;
  286.             rest : INTEGER;
  287.     BEGIN
  288.         DEC(Y, fontheight);
  289.         IF F.len > 0 THEN
  290.             Files.Set(R, F.model.file, pos);
  291.             Files.ReadBytes(R, nextline, number);
  292.             WHILE ~R.eof & (Y > maxY) DO
  293.                 ShowLine(F, Y, number, Files.Pos(R) - number);
  294.                 DEC(Y, fontheight);
  295.                 Files.ReadBytes(R, nextline, number)
  296.             END;
  297.             rest := number - SHORT(R.res); 
  298.             IF (Y > maxY) & (rest > 0) THEN
  299.                 ShowLine(F, Y, rest, Files.Pos(R)-rest)
  300.             END;
  301.             DrawClip(F)
  302.         END
  303.     END Draw;
  304.     PROCEDURE DrawFrame(F : Frame);
  305.         VAR line : INTEGER;
  306.     BEGIN
  307.         RemoveCursor(F);
  308.         Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  309.         Display.ReplConst(bgd, F.X, F.Y, F.W, F.H, Display.replace);
  310.         Display.ReplConst(fgd, F.X+barW, F.Y, 1, F.H, Display.replace);
  311.         Draw(F, F.Y + F.H, F.Y + dY, F.org);
  312.         DrawGreyBars(F)
  313.     END DrawFrame;
  314.     (* ______________________________ update procedures ____________________________ *)
  315.     PROCEDURE AscUpdateByte(F : Frame; ch : CHAR);
  316.     BEGIN
  317.         Files.Set(R, F.model.file, F.cursorBytePos);
  318.         Files.Write(R, ch)
  319.     END AscUpdateByte;
  320.     PROCEDURE HexUpdateByte(F : Frame; ord : INTEGER);
  321.         VAR help : CHAR;
  322.     BEGIN
  323.         Files.Set(R, F.model.file, F.cursorBytePos);
  324.         Files.Read(R, help);
  325.         help := CHR(SYSTEM.LSH(ORD(help), 4) + ord);
  326.         Files.Set(R, F.model.file, F.cursorBytePos);
  327.         Files.Write(R, help)
  328.     END HexUpdateByte;
  329.     PROCEDURE Update(F : Frame; pos : LONGINT; ch : CHAR);
  330.         VAR hX, aX, Y : INTEGER;
  331.     BEGIN
  332.         GetX(F, pos, hX, aX);
  333.         GetY(F, pos, Y);
  334.         Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  335.         Display.ReplConstC(F, bgd, hX - hexdX DIV 2, Y - dY, hexcurs.W, cursorH, Display.replace);
  336.         ShowChar(F, DecToHex(ASH(ORD(ch), -4)), hX, Y);
  337.         ShowChar(F, DecToHex(ORD(ch) MOD 16), hX, Y);
  338.         Display.ReplConstC(F, bgd, aX, Y - dY, asccurs.W, cursorH, Display.replace);
  339.         ShowChar(F, ReadableChar(ch), aX, Y)
  340.     END Update;
  341.     PROCEDURE SendUpdateMsg(F : Frame);
  342.         VAR M : UpdateMsg; ch : CHAR;
  343.     BEGIN
  344.         Files.Set(R, F.model.file, F.cursorBytePos);
  345.         Files.Read(R, ch);
  346.         M.id := updateByte; M.file := F.model.file; M.ch := ch; M.pos := F.cursorBytePos;
  347.         Viewers.Broadcast(M)
  348.     END SendUpdateMsg;
  349.     (* ______________________________ scrolling procedures ____________________________ *)
  350.     PROCEDURE ScrollFrame (F : Frame; pos : LONGINT; line : INTEGER);
  351.         VAR H, d, maxline : INTEGER;
  352.     BEGIN
  353.         Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  354.         GetLine(F, F.Y + 1, maxline);
  355.         d := F.H - (maxline + 1)*fontheight;
  356.         IF (F.org < pos) & (pos <= F.org + maxline*number) THEN
  357.             (* scroll down *)
  358.             RemoveCursor(F);
  359.             H := F.H - line*fontheight - d;
  360.             F.org := pos;
  361.             Display.CopyBlock(F.X + barW + 1, F.Y + d - dY, F.W - barW - 1,
  362.                 H, F.X + barW + 1, F.Y + F.H - H - dY, Display.replace);
  363.             Display.ReplConst(bgd, F.X + barW + 1, F.Y, F.W - barW - 1, F.H - H - dY, Display.replace);
  364.             Draw(F, F.Y + F.H - H, F.Y + dY, F.org + (maxline - line + 1)*number);
  365.             DrawGreyBars(F)
  366.         ELSIF (pos < F.org) & (F.org <= pos + maxline*number) THEN
  367.             (* scroll up *)
  368.             RemoveCursor(F);
  369.             IF F.len DIV number <= maxline THEN (* whole file fits in frame *)
  370.                 d := F.H - SHORT(F.len DIV number + 1)*fontheight
  371.             END;
  372.             H := (line + 1)*fontheight;
  373.             F.org := pos;
  374.             Display.CopyBlock(F.X + barW + 1, F.Y + F.H - H - dY,
  375.                 F.W - barW - 1, H, F.X + barW + 1, F.Y + d - dY, Display.replace);
  376.             Display.ReplConst(bgd, F.X + barW + 1, F.Y + H + d - dY, F.W - barW - 1, F.H - H - d + dY, Display.replace);
  377.             Draw(F, F.Y + F.H, F.Y + H + d - 1, F.org);
  378.             DrawGreyBars(F)
  379.         ELSE
  380.             (* redraw whole frame *)
  381.             F.org := pos;
  382.             DrawFrame(F)
  383.         END
  384.     END ScrollFrame;
  385.     PROCEDURE Scroll (F : Frame; X, Y : INTEGER; keysum : SET);
  386.         VAR pos : LONGINT; line, line1, Ybar : INTEGER;
  387.             PROCEDURE Underscore (col, mode : INTEGER);
  388.             BEGIN
  389.                 Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  390.                 Display.ReplConstC(F, col, F.X + begOfLine, Ybar - 3, adrlen*fontwidth, 2, mode)
  391.             END Underscore;
  392.             PROCEDURE Track (VAR X, Y : INTEGER; VAR keysum : SET);
  393.                 VAR keys, prim : SET; Y1, oldline : INTEGER;
  394.             BEGIN
  395.                 keys := keysum; prim := keysum;
  396.                 oldline := -1; Ybar := -1;
  397.                 WHILE keys # {} DO
  398.                     Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
  399.                     GetLine(F, Y, line);
  400.                     IF line*number + F.org >= F.len THEN
  401.                         line := SHORT((F.len - F.org - 1) DIV number)
  402.                     END;
  403.                   IF line # oldline THEN
  404.                         IF ~(MM IN prim) THEN Underscore(bgd, Display.replace) END;
  405.                         GetY(F, line*number + F.org, Ybar);
  406.                         IF ~(MM IN prim) THEN Underscore(fgd, Display.replace) END;
  407.                         oldline := line
  408.                     END;
  409.                     Input.Mouse(keys, X, Y);
  410.                     keysum := keysum + keys
  411.                 END
  412.             END Track;
  413.     BEGIN
  414.         pos := F.org;
  415.         IF MR IN keysum THEN
  416.             Track(X, Y, keysum);
  417.             IF keysum = {ML, MM, MR} THEN
  418.                 (* cancel *)
  419.                 Underscore(bgd, Display.replace);
  420.                 RETURN
  421.             ELSE
  422.                 (* this line to bottom of frame *)
  423.                 GetLine(F, F.Y + 1, line1);
  424.                 pos := F.org - (line1 - line)*number;
  425.                 IF pos < 0  THEN
  426.                     IF F.len DIV number > line1 THEN (* whole file fist in frame *)
  427.                         line := ((line1 + 1)*number - SHORT(F.org)) DIV number - 1
  428.                     END;
  429.                     pos := 0
  430.                 END;
  431.                 Underscore(bgd, Display.replace)
  432.             END
  433.         ELSIF MM IN keysum THEN
  434.             Track(X, Y, keysum);
  435.             IF keysum = {ML, MM, MR} THEN
  436.                 (* cancel *)
  437.                 RETURN
  438.             ELSIF MR IN keysum THEN
  439.                 (* scroll to bof *)
  440.                 pos := 0;
  441.                 IF pos # F.org THEN F.org := pos; DrawFrame(F); RETURN END
  442.             ELSIF ML IN keysum THEN
  443.                 (* scroll to eof *)
  444.                 pos := (F.len DIV number - 2)*number (* 2 is heuristic *);
  445.                 IF pos < 0 THEN pos := 0 END;
  446.                 IF pos # F.org THEN F.org := pos; DrawFrame(F); RETURN END
  447.             ELSE
  448.                 (* set clip to position *)
  449.                 pos := (F.Y + F.H - Y)*F.len DIV F.H;
  450.                 pos := pos DIV number*number;
  451.                 line := SHORT(pos - F.org) DIV number;
  452.                 IF line < 0 THEN (* scroll up *)
  453.                     GetLine(F, F.Y + 1, line1);
  454.                     IF F.len DIV number > line1 THEN
  455.                         line := line1 + line
  456.                     ELSE (* whole file fits in frame *)
  457.                         line := SHORT(F.len) DIV number + line
  458.                     END
  459.                 END
  460.             END
  461.         ELSIF ML IN keysum THEN
  462.             Track(X, Y, keysum);
  463.             IF keysum = {ML, MM, MR} THEN
  464.                 (* cancel *)
  465.                 Underscore(bgd, Display.replace);
  466.                 RETURN
  467.             ELSE
  468.                 (* this line to top of frame *)
  469.                 pos := line*number + F.org;
  470.                 IF pos > F.len THEN pos := F.len DIV number*number END;
  471.                 Underscore(bgd, Display.replace)
  472.             END
  473.         END;
  474.         IF F.org # pos THEN ScrollFrame(F, pos, line) END
  475.     END Scroll;
  476.     (* ______________________________ mouse tracking ____________________________ *)
  477.     PROCEDURE TrackMouse (F : Frame; X, Y : INTEGER; VAR keys : SET);
  478.         VAR off, line : INTEGER;
  479.             track : BOOLEAN;
  480.             prim, sec : CursorCoord;
  481.     BEGIN
  482.         IF ~F.hasCursor & (keys = {ML}) THEN
  483.             Oberon.PassFocus(Viewers.This(X, Y));
  484.             track := TRUE
  485.         ELSIF keys = {ML} THEN
  486.             track := TRUE
  487.         ELSE
  488.             track := FALSE
  489.         END;
  490.         WHILE keys # {} DO
  491.             Input.Mouse(keys, X, Y);
  492.             IF (F.X + hmin < X) & (X < F.X + hmax) THEN
  493.                 prim := hexcurs; sec := asccurs;
  494.             ELSIF (F.X + amin < X) & (X < F.X + amax) THEN
  495.                 prim := asccurs; sec := hexcurs
  496.             ELSE
  497.                 RemoveCursor(F); prim := NIL; sec := NIL;
  498.             END;
  499.             GetLine(F, Y, line); GetOffset(F, X, off);
  500.             IF track THEN
  501.                 IF (prim # NIL) & ((F.cursor1 # prim) OR (F.org + line*number + off # F.cursorBytePos)) THEN
  502.                     RemoveCursor(F);
  503.                     F.cursor1 := prim; F.cursor2 := sec;
  504.                     SetCursor(F, X, Y)
  505.                 END
  506.             END;
  507.             Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y)
  508.         END
  509.     END TrackMouse;
  510.     (* ______________________________ edit procedures ____________________________ *)
  511.     PROCEDURE CopyFile (F : Frame);
  512.         CONST bufSize = 512;
  513.         VAR new : Files.File;
  514.             writer : Files.Rider;
  515.             buf : ARRAY bufSize OF CHAR;
  516.     BEGIN
  517.         Files.Set(R, F.model.file, 0);
  518.         new := Files.New(F.model.name);
  519.         Files.Set(writer, new, 0);
  520.         Files.ReadBytes(R, buf, bufSize);
  521.         WHILE ~R.eof DO
  522.             Files.WriteBytes(writer, buf, bufSize);
  523.             Files.ReadBytes(R, buf, bufSize)
  524.         END;
  525.         Files.WriteBytes(writer, buf, bufSize - R.res);
  526.         F.model.file := new
  527.     END CopyFile;
  528.     PROCEDURE Edit (F : Frame; ch : CHAR);
  529.         CONST cright = 0C3X; cleft = 0C4X;
  530.         VAR hX, aX, Y : INTEGER;
  531.     BEGIN
  532.         IF F.hasCursor THEN
  533.             IF (ch = cright) & (F.cursorBytePos # F.len-1) THEN
  534.                 InvertCursor(F);
  535.                 INC(F.cursorBytePos);
  536.                 GetX(F, F.cursorBytePos, hX, aX); GetY(F, F.cursorBytePos, Y);
  537.                 IF F.cursor1 = hexcurs THEN SetCursor(F, hX, Y) ELSE SetCursor(F, aX, Y) END
  538.             ELSIF (ch = cleft) & (F.cursorBytePos # 0) THEN
  539.                 InvertCursor(F);
  540.                 DEC(F.cursorBytePos);
  541.                 GetX(F, F.cursorBytePos, hX, aX); GetY(F, F.cursorBytePos, Y);
  542.                 IF F.cursor1 = hexcurs THEN SetCursor(F, hX, Y) ELSE SetCursor(F, aX, Y) END
  543.             ELSIF F.cursor1 = hexcurs THEN
  544.                 IF HexToDec(ch) >= 0 THEN
  545.                     IF F.virgin THEN F.virgin := FALSE; CopyFile(F) END;
  546.                     HexUpdateByte(F, HexToDec(ch));
  547.                     SendUpdateMsg(F);
  548.                     DrawCursor(F)
  549.                 END
  550.             ELSIF F.cursor1 = asccurs THEN
  551.                 IF (ch = ".") OR (ReadableChar(ch) # ".") THEN
  552.                     IF F.virgin THEN F.virgin := FALSE; CopyFile(F) END;
  553.                     AscUpdateByte(F, ch);
  554.                     SendUpdateMsg(F);
  555.                     DrawCursor(F);
  556.                     IF F.cursorBytePos # F.len-1 THEN
  557.                         InvertCursor(F);
  558.                         INC(F.cursorBytePos);
  559.                         GetX(F, F.cursorBytePos, hX, aX); GetY(F, F.cursorBytePos, Y);
  560.                         SetCursor(F, aX, Y)
  561.                     END
  562.                 END
  563.             END
  564.         END
  565.     END Edit;
  566.     (* ______________________________ message handling ____________________________ *) 
  567.     PROCEDURE Copy (src, dst : Frame);
  568.     BEGIN
  569.         dst.virgin := src.virgin; dst.hasCursor := FALSE;
  570.         dst.cursor1 := NIL; dst.cursor2 := NIL; dst.cursorBytePos := -1;
  571.         NEW(dst.model);  dst.model := src.model;
  572.         dst.org := src.org; dst.len := src.len;
  573.         dst.handle := src.handle
  574.     END Copy;
  575.     PROCEDURE Modify (F : Frame; Y, H : INTEGER);
  576.         VAR line, dH : INTEGER;
  577.     BEGIN
  578.         dH := H - F.H;
  579.         IF dH > 0 THEN (* extend *)
  580.             Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  581.             GetLine(F, F.Y, line);
  582.             IF F.Y + F.H # Y + H THEN
  583.                 Display.CopyBlock(F.X, F.Y, F.W, F.H, F.X, Y + dH, Display.replace)
  584.             END;
  585.             F.Y := Y; F.H := H;
  586.             Display.ReplConst(bgd, F.X, F.Y, F.W, dH, Display.replace);
  587.             Display.ReplConst(fgd, F.X + barW, F.Y, 1, dH, Display.replace);
  588.             Draw(F, Y + H - line*fontheight, F.Y + dY, F.org + line*number);
  589.             DrawGreyBars(F)
  590.         ELSIF dH < 0 THEN (* reduce *)
  591.             Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  592.             line := (H -1- dY) DIV fontheight;
  593.             IF (line + 1)*fontheight >= H - dY THEN DEC(line) END;
  594.             dH := (line + 1)*fontheight;
  595.             IF F.Y + F.H # Y + H THEN
  596.                 Display.CopyBlock(F.X, F.Y + F.H - dH - dY, F.W, dH + dY, F.X, Y + H - dH - dY, Display.replace)
  597.             END;
  598.             F.Y := Y; F.H := H;
  599.             IF dH < 0 THEN dH := 0 END;
  600.             Display.ReplConst(bgd, F.X + barW + 1, F.Y, F.W - barW - 1, H - dH - dY, Display.replace);
  601.             DrawClip(F);
  602.             DrawGreyBars(F)
  603.         END
  604.     END Modify;
  605.     PROCEDURE Handle(F : Display.Frame; VAR M : Display.FrameMsg);
  606.         VAR dest : Frame;
  607.     BEGIN
  608.         WITH F : Frame DO
  609.             IF M IS Oberon.InputMsg THEN
  610.                 WITH M : Oberon.InputMsg DO
  611.                     IF M.id = Oberon.track THEN
  612.                         IF M.X < F.X + barW THEN
  613.                             Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y);
  614.                             Scroll(F, M.X, M.Y, M.keys)
  615.                         ELSE
  616.                             Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y);
  617.                             TrackMouse(F, M.X, M.Y, M.keys)
  618.                         END
  619.                     ELSIF M.id = Oberon.consume THEN
  620.                         Edit(F, M.ch)
  621.                     END
  622.                 END
  623.             ELSIF M IS MenuViewers.ModifyMsg THEN
  624.                 WITH M : MenuViewers.ModifyMsg DO
  625.                     RemoveCursor(F);
  626.                     Modify(F, M.Y, M.H)
  627.                 END
  628.             ELSIF M IS Oberon.CopyMsg THEN
  629.                 WITH M : Oberon.CopyMsg DO
  630.                     IF M.F = NIL THEN NEW(dest); M.F := dest END;
  631.                     RemoveCursor(F);
  632.                     Copy(F, M.F(Frame))
  633.                 END
  634.             ELSIF M IS UpdateMsg THEN
  635.                 WITH M : UpdateMsg DO
  636.                     IF M.id = changeFont THEN DrawFrame(F)
  637.                     ELSIF M.id = updateByte THEN
  638.                         IF M.file = F.model.file THEN
  639.                             WriteBang(F); Update(F, M.pos, M.ch)
  640.                         END
  641.                     END
  642.                 END            
  643.             ELSIF M IS Oberon.ControlMsg THEN RemoveCursor(F)
  644.             ELSIF M IS CursorMsg THEN
  645.                 WITH M : CursorMsg DO
  646.                     IF F.hasCursor  THEN
  647.                         M.file := F.model.file; M.pos := F.cursorBytePos
  648.                     END
  649.                 END
  650.             END
  651.         ELSE (* skip *)
  652.         END
  653.     END Handle;
  654.     (* ______________________ auxiliary procedures StoreTextToFile _________________________ *)
  655.     PROCEDURE WriteSpaces (num: INTEGER);
  656.         VAR i : INTEGER;
  657.     BEGIN
  658.         i := 0; 
  659.         WHILE i < num  DO Texts.Write(W, " "); INC(i) END
  660.     END WriteSpaces;
  661.     PROCEDURE WriteAddress (pos: LONGINT);
  662.         VAR div : LONGINT;
  663.     BEGIN
  664.         div := 0100000H;
  665.         REPEAT
  666.             Texts.Write(W, DecToHex(pos DIV div));
  667.             pos := pos MOD div;
  668.             div := ASH(div, -4);
  669.         UNTIL div = 0
  670.     END WriteAddress;
  671.     PROCEDURE WriteHexPart (max: INTEGER);
  672.         VAR i : INTEGER;
  673.     BEGIN
  674.         i := 0;
  675.         WHILE i < max DO
  676.             Texts.Write(W, DecToHex(ASH(ORD(nextline[i]), -4)));
  677.             Texts.Write(W, DecToHex(ORD(nextline[i]) MOD 16));
  678.             WriteSpaces(1); INC(i)
  679.         END;
  680.          WriteSpaces((number-i)*3)
  681.     END WriteHexPart;
  682.     PROCEDURE WriteAscPart (max : INTEGER);
  683.         VAR i : INTEGER;
  684.     BEGIN
  685.         i := 0;
  686.         WHILE i < max DO Texts.Write(W, ReadableChar(nextline[i])); INC(i) END
  687.     END WriteAscPart;
  688.     PROCEDURE WriteLine (nr : INTEGER; adr : LONGINT);
  689.     BEGIN
  690.         WriteAddress(adr); WriteSpaces(colspace);
  691.         WriteHexPart(nr); WriteSpaces(colspace-1);
  692.         WriteAscPart(nr); Texts.WriteLn(W)
  693.     END WriteLine;
  694.     (* ______________________________ Interface to Hex-Part of Module ____________________________ *)
  695.     PROCEDURE OpenFrame (F: Frame; file: Files.File; name: ARRAY OF CHAR; handle: Display.Handler);
  696.     BEGIN
  697.         F.virgin := TRUE; F.hasCursor := FALSE;
  698.         F.cursor1 := NIL; F.cursor2 := NIL;
  699.         F.cursorBytePos := -1;
  700.         NEW(F.model); F.model.file := file;
  701.         COPY(name, F.model.name);
  702.         F.org := 0; F.len := Files.Length(file);
  703.         F.handle := handle
  704.     END OpenFrame;
  705.     PROCEDURE StoreFile (F : Frame; name : ARRAY OF CHAR);
  706.     BEGIN
  707.         F.virgin := TRUE;
  708.         DeleteBang(F);
  709.         COPY(name, F.model.name);
  710.         CopyFile(F);
  711.         Files.Register(F.model.file)
  712.     END StoreFile;
  713.     PROCEDURE StoreTextToFile (F : Frame; name : ARRAY OF CHAR);
  714.         VAR T : Texts.Text;
  715.             rest : INTEGER;
  716.             oldfont : Fonts.Font;
  717.     BEGIN
  718.         T := TextFrames.Text("");
  719.         oldfont := W.fnt;
  720.         Texts.SetFont(W, font);
  721.         Files.Set(R, F.model.file, 0);
  722.         Files.ReadBytes(R, nextline, number);
  723.         WHILE ~R.eof DO
  724.             WriteLine(number, Files.Pos(R)-number);
  725.             Files.ReadBytes(R, nextline, number)
  726.         END;
  727.         rest := number - SHORT(R.res); 
  728.         IF rest > 0 THEN WriteLine(rest, Files.Pos(R) - rest) END;
  729.         Texts.Append(T, W.buf);
  730.         Texts.Close(T, name);
  731.         Texts.SetFont(W, oldfont);
  732.     END StoreTextToFile;
  733.     PROCEDURE ChangeFont (name: ARRAY OF CHAR; VAR res: INTEGER);
  734.         VAR newfont : Fonts.Font;
  735.             M : UpdateMsg;
  736.             dx1, dx2, x, y, w, h : INTEGER;
  737.             p : Display.Pattern;
  738.     BEGIN
  739.         newfont := Fonts.This(name);
  740.         IF name # Fonts.Default.name THEN
  741.             IF (Fonts.Default = newfont) OR (newfont = NIL) THEN
  742.                 res := 1; (* font not found *)
  743.                 RETURN
  744.             END
  745.         END;
  746.         Display.GetChar(newfont.raster, "W", dx1, x, y, w, h, p);
  747.         Display.GetChar(newfont.raster, "i", dx2, x, y, w, h, p);
  748.         IF dx1 # dx2 THEN
  749.             res := 2 (* not a non-proportional font  *)
  750.         ELSE
  751.             res := 0; (* ok *)
  752.             font := newfont;
  753.             InitDisplayVars;
  754.             M.id := changeFont;
  755.             Viewers.Broadcast(M)
  756.         END
  757.     END ChangeFont;
  758.     PROCEDURE SearchPat (F: Frame; pat: ARRAY OF CHAR; len: INTEGER);
  759.         VAR org, pos, cursorpos: LONGINT; ch: CHAR; patpos: INTEGER;
  760.             hX, aX, Y: INTEGER;
  761.     BEGIN
  762.         IF F.hasCursor THEN pos := F.cursorBytePos ELSE pos := 0 END;
  763.         REPEAT
  764.             Files.Set(R, F.model.file, pos); Files.Read(R, ch);
  765.             WHILE ~R.eof & (ch # pat[0]) DO Files.Read(R, ch) END;
  766.             IF ch = pat[0] THEN pos := Files.Pos(R); Files.Read(R, ch); patpos := 1;
  767.                 WHILE (patpos < len) & (ch = pat[patpos]) DO Files.Read(R, ch); INC(patpos) END;
  768.                 IF patpos = len THEN (* pattern found *)
  769.                     IF ~F.hasCursor THEN Oberon.PassFocus(Viewers.This(F.X, F.Y)) END;
  770.                     cursorpos := pos + len - 1;
  771.                     org := ((cursorpos DIV number) - 1) * number;
  772.                     IF org < 0 THEN org := 0 END;
  773.                     F.org := org; DrawFrame(F);
  774.                     F.cursor1 := asccurs; F.cursor2 := hexcurs;
  775.                     GetX(F, cursorpos, hX, aX); GetY(F, cursorpos, Y);
  776.                     SetCursor(F, aX, Y);
  777.                     RETURN;
  778.                 END
  779.             END
  780.         UNTIL R.eof;
  781.         RemoveCursor(F);
  782.     END SearchPat;
  783.     (* _________________________________________ Command Part  _____________________________________ *)
  784.     PROCEDURE GetFrame (VAR F : Frame; VAR name : ARRAY OF CHAR);
  785.         VAR par : Oberon.ParList; V : Viewers.Viewer; S : Texts.Scanner;
  786.     BEGIN
  787.         par := Oberon.Par;
  788.         IF par.frame = par.vwr.dsc THEN V := par.vwr;
  789.         ELSE V := Oberon.MarkedViewer();
  790.         END;
  791.         Texts.OpenScanner(S, V.dsc(TextFrames.Frame).text, 0); Texts.Scan(S);
  792.         IF (S.class = Texts.Name) & (V.dsc # NIL) & (V.dsc.next IS Frame) THEN
  793.             F := V.dsc.next(Frame); COPY(S.s, name)
  794.         ELSE F := NIL
  795.         END
  796.     END GetFrame;
  797.     PROCEDURE GetName (VAR name: ARRAY OF CHAR);
  798.         VAR T: Texts.Text; S: Texts.Scanner; beg, end, time: LONGINT;
  799.     BEGIN
  800.         Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  801.         IF (S.class = Texts.Char) & (S.c = "^") THEN
  802.             Oberon.GetSelection(T, beg, end, time);
  803.             IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END;
  804.         END;
  805.         IF S.class = Texts.Name THEN COPY(S.s, name)
  806.         ELSE name[0] := 0X;
  807.         END
  808.     END GetName;
  809.     PROCEDURE FontLogText (name: ARRAY OF CHAR; res : INTEGER);
  810.     BEGIN
  811.         Texts.WriteString(W, name);
  812.         IF res = 1 THEN Texts.WriteString(W, " not found");
  813.         ELSIF res = 2 THEN Texts.WriteString(W, " is not a fixed-width font")
  814.         END;
  815.         Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  816.     END FontLogText;
  817.     PROCEDURE SetRider (VAR done : BOOLEAN);
  818.         VAR M: CursorMsg;
  819.     BEGIN
  820.         M.pos := -1;
  821.         Viewers.Broadcast(M);
  822.         IF M.pos >= 0 THEN Files.Set(R, M.file, M.pos); done := TRUE
  823.         ELSE done := FALSE
  824.         END
  825.     END SetRider;
  826.     PROCEDURE Open*;
  827.         VAR F: Frame; M: TextFrames.Frame; V: Viewers.Viewer; T: Texts.Text; buf: Texts.Buffer;
  828.             File: Files.File; X, Y: INTEGER;
  829.             name: ARRAY 32 OF CHAR; res: INTEGER;
  830.     BEGIN
  831.         GetName(name);
  832.         IF name # "" THEN
  833.             File := Files.Old(name);
  834.             IF File # NIL THEN NEW(F);
  835.                 OpenFrame(F, File, name, Handle);
  836.                 IF Files.Old("Hex.Menu.Text") = NIL THEN M := TextFrames.NewMenu(name, StandardMenu)
  837.                 ELSE M := TextFrames.NewMenu(name, "");
  838.                     NEW(T); Texts.Open(T, "Hex.Menu.Text");
  839.                     NEW(buf); Texts.OpenBuf(buf); Texts.Save(T, 0, T.len, buf); Texts.Append(M.text, buf)
  840.                 END;
  841.                 Oberon.AllocateUserViewer(Oberon.Mouse.X, X, Y);
  842.                 V := MenuViewers.New(M, F, TextFrames.menuH, X, Y);
  843.             ELSE
  844.                 Texts.WriteString(W, name); Texts.WriteString(W, " not found"); Texts.WriteLn(W);
  845.                 Texts.Append(Oberon.Log, W.buf)
  846.             END
  847.         END
  848.     END Open;
  849.     PROCEDURE Store*;
  850.         VAR F: Frame; name: ARRAY 32 OF CHAR;
  851.         PROCEDURE Backup (VAR name: ARRAY OF CHAR);
  852.             VAR res, i: INTEGER; bak: ARRAY 32 OF CHAR;
  853.         BEGIN
  854.             i := 0;
  855.             WHILE name[i] # 0X DO bak[i] := name[i]; INC(i) END;
  856.             bak[i] := "."; bak[i+1] := "B"; bak[i+2] := "a"; bak[i+3] := "k";
  857.             bak[i+4] := 0X;
  858.             Files.Rename(name, bak, res);
  859.         END Backup;
  860.     BEGIN
  861.         GetFrame(F, name);
  862.         IF F # NIL THEN
  863.             Texts.WriteString(W, "Hex.Store "); Texts.Append(Oberon.Log, W.buf);
  864.             Backup(name);
  865.             StoreFile(F, name);
  866.             Texts.WriteString(W, name);
  867.             Texts.WriteLn(W);
  868.             Texts.Append(Oberon.Log, W.buf);
  869.         END
  870.     END Store;
  871.     PROCEDURE StoreText*;
  872.         VAR F: Frame; name: ARRAY 32 OF CHAR;
  873.         PROCEDURE NewName (VAR name : ARRAY OF CHAR);
  874.             VAR i : INTEGER;
  875.         BEGIN i := 0;
  876.             WHILE name[i] # 0X DO INC(i) END;
  877.             name[i] := "."; name[i+1] := "T"; name[i+2] := "e"; name[i+3] := "x"; name[i+4] := "t";
  878.             name[i+5] := 0X;
  879.         END NewName;
  880.     BEGIN
  881.         GetFrame(F, name);
  882.         IF F # NIL THEN
  883.             Texts.WriteString(W, "Hex.StoreText "); Texts.Append(Oberon.Log, W.buf);
  884.             NewName(name);
  885.             StoreTextToFile(F, name);
  886.             Texts.WriteString(W, name); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
  887.         END
  888.     END StoreText;
  889.     PROCEDURE SetFont*;
  890.         VAR res : INTEGER;
  891.             name : ARRAY 32 OF CHAR;
  892.     BEGIN
  893.         GetName(name);
  894.         IF name # "" THEN
  895.             ChangeFont(name, res);
  896.             IF res # 0 THEN FontLogText(name, res) END
  897.         END
  898.     END SetFont;
  899.     PROCEDURE GetSInt*;
  900.         VAR x : CHAR; done : BOOLEAN;
  901.     BEGIN
  902.         SetRider(done);
  903.         IF done THEN
  904.             Files.Read(R, x);
  905.             Texts.WriteString(W, "SHORTINT"); Texts.Write(W, 09X);
  906.             Texts.WriteInt(W, ORD(x), 0); Texts.WriteLn(W);
  907.             Texts.Append(Oberon.Log, W.buf)
  908.         END;
  909.     END GetSInt;
  910.     PROCEDURE GetInt*;
  911.         VAR x : INTEGER; done : BOOLEAN;
  912.     BEGIN
  913.         SetRider(done);
  914.         IF done THEN
  915.             Files.ReadInt(R, x);
  916.             Texts.WriteString(W, "INTEGER"); Texts.Write(W, 09X);
  917.             Texts.WriteInt(W, x, 0); Texts.WriteLn(W);
  918.             Texts.Append(Oberon.Log, W.buf)
  919.         END
  920.     END GetInt;
  921.     PROCEDURE GetLInt*;
  922.         VAR x : LONGINT; done : BOOLEAN;
  923.     BEGIN
  924.         SetRider(done);
  925.         IF done THEN
  926.             Files.ReadLInt(R, x);
  927.             Texts.WriteString(W, "LONGINT"); Texts.Write(W, 09X);
  928.             Texts.WriteInt(W, x, 0); Texts.WriteLn(W);
  929.             Texts.Append(Oberon.Log, W.buf)
  930.         END
  931.     END GetLInt;
  932.     PROCEDURE GetReal*;
  933.         VAR x : REAL; done : BOOLEAN;
  934.     BEGIN
  935.         SetRider(done);
  936.         IF done THEN
  937.             Files.ReadReal(R, x);
  938.             Texts.WriteString(W, "REAL"); Texts.Write(W, 09X);
  939.             Texts.WriteReal(W, x, 20); Texts.WriteLn(W);
  940.             Texts.Append(Oberon.Log, W.buf)
  941.         END
  942.     END GetReal;
  943.     PROCEDURE GetLReal*;
  944.         VAR x : LONGREAL; done : BOOLEAN;
  945.     BEGIN
  946.         SetRider(done);
  947.         IF done THEN
  948.             Files.ReadLReal(R, x);
  949.             Texts.WriteString(W, "LONGREAL"); Texts.Write(W, 09X);
  950.             Texts.WriteLongReal(W, x, 20); Texts.WriteLn(W);
  951.             Texts.Append(Oberon.Log, W.buf)
  952.         END
  953.     END GetLReal;
  954.     PROCEDURE GetNum*;
  955.         VAR x, n : LONGINT; done : BOOLEAN;
  956.     BEGIN
  957.         SetRider(done);
  958.         IF done THEN
  959.             n := Files.Pos(R);
  960.             Files.ReadNum(R, x);
  961.             n := Files.Pos(R) - n;
  962.             Texts.WriteString(W, "Number ("); Texts.WriteInt(W, n, 0);
  963.             IF n > 1 THEN Texts.WriteString(W, " Bytes)") ELSE Texts.WriteString(W, " Byte)") END;
  964.             Texts.Write(W, 09X);
  965.             Texts.WriteInt(W, x, 0); Texts.WriteLn(W);
  966.             Texts.Append(Oberon.Log, W.buf)
  967.         END
  968.     END GetNum;
  969.     PROCEDURE GetSet*;
  970.         VAR x : SET; done : BOOLEAN; i, last : SHORTINT;
  971.     BEGIN
  972.         SetRider(done);
  973.         IF done THEN
  974.             Files.ReadSet(R, x);
  975.             Texts.WriteString(W, "SET"); Texts.Write(W, 09X); Texts.Write(W, "{");
  976.             i := 0; last := -1; 
  977.             REPEAT
  978.                 IF i IN x THEN
  979.                     IF last >= 0 THEN Texts.WriteInt(W, last, 0); Texts.Write(W, ",") END;
  980.                     last := i;
  981.                 END;
  982.                 INC(i)
  983.             UNTIL (i = 32);
  984.             IF last >= 0 THEN Texts.WriteInt(W, last, 0) END;
  985.             Texts.Write(W, "}");
  986.             Texts.WriteLn(W);
  987.             Texts.Append(Oberon.Log, W.buf)
  988.         END
  989.     END GetSet;
  990.     PROCEDURE GetBool*;
  991.         VAR x: CHAR; done: BOOLEAN;
  992.     BEGIN
  993.         SetRider(done);
  994.         IF done THEN
  995.             Files.Read(R, x);
  996.             Texts.WriteString(W, "BOOLEAN"); Texts.Write(W, 09X);
  997.             IF x = 01X THEN Texts.WriteString(W, "TRUE")
  998.             ELSE Texts.WriteString(W, "FALSE")
  999.             END;
  1000.             Texts.WriteLn(W);
  1001.             Texts.Append(Oberon.Log, W.buf)
  1002.         END
  1003.     END GetBool;
  1004.     PROCEDURE Search*;
  1005.         VAR F: Frame; name: ARRAY 32 OF CHAR; ch: CHAR;
  1006.             T: Texts.Text; beg, end, time: LONGINT; R: Texts.Reader; len: INTEGER;
  1007.     BEGIN
  1008.         GetFrame(F, name);
  1009.         IF F # NIL THEN
  1010.             Oberon.GetSelection(T, beg, end, time);
  1011.             IF time > 0 THEN
  1012.                 Texts.OpenReader(R, T, beg); Texts.Read(R, ch); len := 0;
  1013.                 WHILE (len <= LEN(name)) & (Texts.Pos(R) <= end) DO
  1014.                     name[len] := ch; INC(len); Texts.Read(R, ch);
  1015.                 END;
  1016.                 SearchPat(F, name, len);
  1017.             END;
  1018.         END
  1019.     END Search;
  1020. BEGIN
  1021.     Texts.OpenWriter(W);
  1022.     ChangeFont(DefaultFont, res);
  1023.     IF res # 0 THEN
  1024.         FontLogText(DefaultFont, res); HALT(99)
  1025. END Hex.
  1026.