home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frozen Fish 2: PC
/
frozenfish_august_1995.bin
/
bbs
/
d03xx
/
d0378.lha
/
MuchMore
/
txt
/
MuchMore.mod
< prev
next >
Wrap
Text File
|
1990-10-10
|
56KB
|
1,715 lines
(*---------------------------------------------------------------------------
:Program. MuchMore.mod
:Author. Fridtjof Siebert
:Address. Nobileweg 67, D-7000 Stuttgart 40
:Shortcut. [fbs]
:Copyright. PD
:Language. OBERON
:Translator. Amiga Oberon Compiler
:History. V1.0 summer-88: First very slow internal version [fbs]
:History. V1.1 24-Sep-88: First published version [fbs]
:History. V1.2 26-Nov-88: Now displays Filelength & Percentage [fbs]
:History. 27-Nov-88: Mouse can be used instead of Space / BackSpace[fbs]
:History. V1.3 29-Apr-89: Strong increase in speed, removed WarpText [fbs]
:History. 29-Apr-89: Now supports Numeric Keys (Home,PgUp etc.) [fbs]
:History. 29-Apr-89: Now opens Screen as big as gfx.normalDisplay [fbs]
:History. V1.4 29/30-Apr-89: Asynchronus loading / displaying. Very nice[fbs]
:History. 30-Apr-89, 00:33: Removed bugs in Filelength & L-Command [fbs]
:History. 30-Apr-89, 02:21: Added Find-Command [fbs]
:History. 30-Apr-89, 10:30: Scrolling stops when window is inactive[fbs]
:History. 01-May-89: Allocates no more unneeded memory for text [fbs]
:History. 07-May-89: Allocates even less memory now [fbs]
:History. 14-May-89: Removed deadlock-bug with Find-Window [fbs]
:History. V1.5 25-May-89: Added print feature [fbs]
:History. 25-May-89: Removed all imports (apart from Arts) [fbs]
:History. 26-May-89: inspired by J. Kupfer, I added nk 5 to quit [fbs]
:History. 26-May-89: Now handle BS correctly [fbs]
:History. V1.6 02-Jul-89: Now supports several fontstyles and colors [fbs]
:History. V1.7 03-Jul-89: Is again as fast as it was with 2 colors [fbs]
:History. 03-Jul-89: Now no more crashes when quitting while print [fbs]
:History. 07-Jul-89: removed bug with texts of length 0 [fbs]
:History. V1.8 10-Jul-89: small bug in find-command removed [fbs]
:History. 10-Jul-89: now found strings are highlighted [fbs]
:History. 14-Jul-89: nk0 to display fileinfo [fbs]
:History. V2.0 06-Aug-89: Ported this to OBERON [fbs]
:History. 06-Aug-89: Added ARP-FileRequester [fbs]
:History. 07-Aug-89: Added L - (load new file) Command [fbs]
:History. V2.1 03-Sep-89: no more gurus if an r/w error occures [fbs]
:History. 03-Sep-89: MM used to execute CSI-Codes backwards. fixed [fbs]
:History. 03-Sep-89: ping / pong with Shift+Fn / Fn [fbs]
:History. 03-Sep-89: new command: goto [fbs]
:History. V2.2 05-Sep-89: will run with any keymapping now [fbs]
:History. V2.3 17-Sep-89: New command: sleep & Pop-Up feature [fbs]
:History. 17-Sep-89: "MuchMore -s" will go to sleep immediately [fbs]
:History. 17-Sep-89: Interprets <CSI>m as <CSI>0m now [fbs]
:History. V2.4 17-Sep-89: New command: write block "w" [fbs]
:History. 17-Sep-89: rewritten argument parser to allow quotes [fbs]
:History. V2.5 18-Sep-89: now uses the 8x8 font set with SetFont [fbs]
:History. 19-Sep-89: no more scatters memory. Allocates 4K Chunks [fbs]
:History. V2.6 26-Jun-90: Made MuchMore reentrant [fbs]
:History. 26-Jun-90: Opens 1-Plane Screen if memory is rare [fbs]
:History. 26-Jun-90: Asynchronus fast scrolling with Ctrl-Up/Down [fbs]
:History. 26-Jun-90: Now supports interlaced screens [fbs]
:History. 08-Aug-90: CLI-Option '-l' to toggle interlaced mode [fbs]
:History. V2.7 09-Aug-90: no more RethinkDisplay()s,looks good with 2.0 [fbs]
:History. 10-Aug-90: Supports Kick2.0 ASL-FileRequester [fbs]
:Contents. A Soft-Scrolling ASCII-File Printer.
:Usage. MuchMore {-s|-l} [Text]
:Remark. Compile: 'Oberon -dm MuchMore'
:Remark. Link: 'OLink -dm MuchMore OBJ MMQText.obj OBJ MMInput.obj'
---------------------------------------------------------------------------*)
MODULE MuchMore;
(* $StackChk- $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
IMPORT ol: OberonLib,
d: Dos,
e: Exec,
Input,
ie: InputEvent,
I: Intuition,
g: Graphics,
wb: Workbench,
km: KeyMap,
sys:SYSTEM;
(*-------------------------------------------------------------------------*)
CONST
empty = "";
oom = "Out of memory!";
cof = "Can't open file!";
usage = "Usage: MuchMore {-s|-l} [Text]";
rwerr = "Read/Write Error";
noarp = "Need arp for FileReq";
conerr = "Console problem";
MuchText = "MuchMore V2.7 ⌐ 1990 AMOK";
MMissleeping = "MM is sleeping";
MMisawake = "MM is awake";
nil = "NIL:";
w = TRUE;
f = FALSE;
MaxLen = 256;
(* Control codes for QText: *)
plain = CHR(17);
italic = CHR(18);
bold = CHR(19);
boldit = CHR(20);
ulineon = CHR(21);
ulineoff = CHR(22);
Italic = 0;
Bold = 1;
Ulin = 2;
Inv = 3;
TYPE
TextLinePtr = POINTER TO TextLine;
TextLine = STRUCT
next: TextLinePtr;
prev: TextLinePtr;
len: INTEGER;
size: INTEGER;
text: ARRAY MaxLen+1 OF CHAR;
END;
String = ARRAY 256 OF CHAR;
StringPtr = POINTER TO String;
FontData = ARRAY 8, 192, 8 OF CHAR;
FontDataPtr = POINTER TO FontData;
CONST
(* FileReqFlags *)
listFunc = 0;
gEventFunc = 1;
addGadFunc = 2;
newWindFunc = 3;
newIDCMP = 4;
doColor = 5;
doMsgFunc = 6;
doWildFunc = 7;
TYPE
STRPTR = POINTER TO CHAR;
FileRequesterPtr = POINTER TO FileRequester;
FileRequester = STRUCT
hail: STRPTR; (* Hailing text *)
ddef: StringPtr; (* Filename array (FCHARS+1) *)
ddir: StringPtr; (* Directory array (DSIZE+1) *)
wind: I.WindowPtr; (* Window requesting or NULL *)
funcFlags: SHORTSET; (* Control. See above. *)
reserved1: SHORTINT; (* Set this to 0 *)
function: PROCEDURE; (* Your function, see btdef's *)
reserved2: LONGINT; (* reserved *)
END;
VAR
Screen: I.ScreenPtr; (* Screen that contains the Text *)
BM: g.BitMapPtr; (* Screen's BitMap (external) *)
Window: I.WindowPtr; (* My window *)
MyFont: g.TextAttr; (* Topaz 8 *)
MyFile: d.FileHandlePtr; (* For loading Textfile *)
FirstLine: TextLinePtr; (* Saved Text *)
TopLine: TextLinePtr; (* Points to topmost Line *)
BottomLine: TextLinePtr; (* Last Line displayed on Screen *)
LoadLine: TextLinePtr; (* currently loaded Line *)
LastLine: TextLinePtr; (* Last element of LineList *)
Name: String; (* Text's Name *)
lace: BOOLEAN; (* use interlaced screen? *)
IStr,PStr: String; (* differently used *)
Buffer: ARRAY 512 OF CHAR; (* Buffer for Reading *)
RQPos: LONGINT; (* Position within ReadBuffer *)
RQLen: LONGINT; (* Number of CHARs in Buffer *)
NumLines: INTEGER; (* Number of Lines on Screen *)
NumColumns: INTEGER; (* Number of Columns on Screen *)
PageSize: LONGINT; (* 8*NumLines*NumColumns *)
AnzLines: LONGINT; (* Length of Text in Lines *)
fontdata: FontData; (* Fonts used by QText() *)
MyLock,OldDir: d.FileLockPtr; (* To Examine and Load File *)
FileInfo: d.FileInfoBlockPtr; (* to get File's length *)
FileLength,TextLength: LONGINT;(* Length of File and of Displayed Text *)
ScreenPos: INTEGER; (* actual position within bitmap *)
ShowTask: e.Task; (* the task that displays the text *)
ShowStack: ARRAY 1000 OF LONGINT; (* it's stack *)
ShowTaskRunning: BOOLEAN; (* is Showtask activated? *)
mySigBit: INTEGER; (* My SignalBit *)
mySig: LONGSET; (* My SignalSet = LONGSET{mySigBit} *)
SignalNewData: BOOLEAN; (* Signal when new data is loaded *)
SignalAllRead: BOOLEAN; (* send signal at end of text *)
Done: BOOLEAN; (* Quit *)
print: BOOLEAN; (* print text *)
NewText: BOOLEAN; (* load new text *)
Me: d.ProcessPtr; (* my main task *)
Info: BOOLEAN; (* is info currently displayed ? *)
MyMsgPtr: I.IntuiMessagePtr; (* for receiving Messages *)
i,j: INTEGER; (* count *)
Scroll: BOOLEAN; (* scrolling or waiting? *)
Fast: BOOLEAN; (* scrollquick? *)
Sync: BOOLEAN; (* scroll very quick? *)
in,out: d.FileHandlePtr; (* i/o for TYPE xxx TO PRT: *)
fg,bg: INTEGER; (* Text colors *)
style: SHORTSET; (* Text style *)
CommLine: POINTER TO CHAR; (* The CLI-commands *)
ArgPtr: POINTER TO String; (* to get WBArg *)
wbm: wb.WBStartupPtr; (* WBenchMessage *)
ri: g.RasInfoPtr; (* Screen's ViewPort's RasInfo *)
NuScreen: I.NewScreen; (* to open screens *)
NuWindow: I.NewWindow; (* to open window *)
Prefs: I.Preferences; (* Preferences (need wbLace) *)
StrGadget: I.Gadget; (* Gadget for Find-Command *)
StrInfo: I.StringInfo; (* its special info *)
arp: LONGINT; (* ArpBase *)
asl: LONGINT; (* ASL-librarybase *)
body,text,ok: I.IntuiText; (* IntuiTexts for AutoRequest *)
FR: FileRequester; (* The Requester *)
Filename: String; (* The Filename (without path) *)
Dirname: String; (* its path *)
NewDisp: BOOLEAN; (* need to rebuild Display ? *)
TextMarkers: ARRAY 10 OF TextLinePtr; (* Marked Positions in text *)
FindLine: TextLinePtr; (* Last found line *)
KeyMap: ARRAY 40H OF CHAR; (* console's KeyMap *)
wreq: e.IOStdReq; (* Request to communicate with the console *)
console: e.DevicePtr; (* the console.device *)
ievent: ie.InputEvent; (* InputEvent to convert keycodes *)
InputData: STRUCT
wakeUpSignal: SHORTINT; (* Signal that's wakes us up*)
sigTask: e.TaskPtr; (* MM's main task *)
sleeping: BOOLEAN; (* TRUE while we sleep *)
END;
InputDevPort: e.MsgPort; (* Input.Device's Port *)
InputRequestBlock: e.IOStdReq; (* its Requestblock *)
HandlerStuff: e.Interrupt; (* contains data about Input Handler *)
InputOpen: BOOLEAN; (* TRUE while input.device is open *)
HandlerActive: BOOLEAN; (* TRUE while InputHandler is active *)
WriteName: String; (* File to write Block *)
savefrom,savesize: LONGINT; (* How much to save? *)
save: BOOLEAN; (* save block *)
buffer: POINTER TO LONGINT; (* buffer to save file *)
c: CHAR; (* \ used by GetTextLine(); *)
le: INTEGER; (* / global for speed *)
(*------ Memory: ------*)
CONST ChunkSize = 4096; (* size of allocated chunks *)
TYPE
MemChunkPtr = POINTER TO MemChunk; (* chunklist *)
MemChunk = STRUCT
prev: MemChunkPtr; (* link *)
data: ARRAY ChunkSize OF BYTE; (* ChinkSize Bytes of memory *)
END;
VAR
MemIndex: INTEGER; (* index in current Chunk *)
CurChunk: MemChunkPtr; (* current chunk *)
(*----------------- External Assembler Procedures: ----------------------*)
(*------ The fastest textoutput-Procedure in the world (maybe): ------*)
PROCEDURE QText{"QText"}(y{1}: INTEGER;
str{8}: LONGINT;
bm{9}: g.BitMapPtr;
fd{10}: FontDataPtr);
(*------ Get Font: ------*)
PROCEDURE GetFontData{"GetFontData"}(from{8},to{9}: LONGINT; linelen{7}: INTEGER);
(*------ Copy Line: ------*)
PROCEDURE CopyLine1{"CopyLine1"}(bm{8}: g.BitMapPtr; w{0},h{1},pos{2}: INTEGER);
PROCEDURE CopyLine2{"CopyLine2"}(bm{8}: g.BitMapPtr; w{0},h{1},pos{2}: INTEGER);
(*------ Input Handler: ------*)
PROCEDURE * InputHandler{"MMInputHandler"};
(*-------------------------------------------------------------------------*)
(*------ Console Procedure: ------*)
PROCEDURE RawKeyConvert{console,-48}(events{8}:ie.InputEventPtr;
buffer{9}:LONGINT;
length{1}:LONGINT;
keyMap{10}:LONGINT);
(*-------------------------------------------------------------------------*)
PROCEDURE Length(VAR s: String): INTEGER;
VAR l: INTEGER;
BEGIN l := -1; REPEAT INC(l) UNTIL (l>sys.SIZE(s)) OR (s[l]=0X); RETURN l;
END Length;
PROCEDURE Append(VAR s1: String; s2: StringPtr);
(* appends s2 to s1 *)
VAR p,q: INTEGER;
BEGIN
p := Length(s1); q := 0;
WHILE (p<=sys.SIZE(s1)) AND (s2^[q]#0X) AND (p<NumColumns) DO
s1[p] := s2^[q]; INC(p); INC(q)
END;
IF p<=sys.SIZE(s1) THEN s1[p] := 0X END;
END Append;
(*----------------------------- Requester: ------------------------------*)
PROCEDURE Request(Text: StringPtr);
VAR
out: d.FileHandlePtr;
c: CHAR;
BEGIN
IF ol.wbStarted THEN
body.frontPen := 0; body.backPen := 1; body.drawMode := g.jam2;
body.leftEdge := 12; body.topEdge := 8;
text := body; ok := body;
body.iText := sys.ADR(MuchText);
body.nextText := sys.ADR(text);
text.iText := Text; text.topEdge := 22;
ok.leftEdge := 6; ok.topEdge := 3; ok.iText := sys.ADR(" OK ");
sys.SETREG(0,I.AutoRequest(NIL,sys.ADR(body),NIL,sys.ADR(ok),
LONGSET{I.rawKey},LONGSET{},320,65));
ELSE
out := d.Output();
sys.SETREG(0,d.Write(out,Text^,Length(Text^)));
c := 0AX;
sys.SETREG(0,d.Write(out,c,1));
END;
HALT(0);
END Request;
(*-------------------------------------------------------------------------*)
PROCEDURE AllocLine(sz: INTEGER): TextLinePtr;
VAR
a: TextLinePtr;
newchunk: MemChunkPtr;
BEGIN
INC(sz,sys.SIZE(TextLine)-MaxLen); IF ODD(sz) THEN INC(sz) END;
IF MemIndex+sz<=ChunkSize THEN (* does mem fit into current chunk ? *)
INC(MemIndex,sz); (* increment index in current chunk *)
ELSE
NEW(newchunk); (* allocate new chunk *)
IF newchunk=NIL THEN Request(sys.ADR(oom)) END;
newchunk.prev := CurChunk; (* link chunk into list *)
CurChunk := newchunk;
MemIndex := sz;
END;
RETURN sys.ADR(CurChunk.data[MemIndex-sz]);
END AllocLine;
PROCEDURE DisposeLines();
VAR chunk: MemChunkPtr;
BEGIN
WHILE CurChunk#NIL DO
chunk := CurChunk.prev;
DISPOSE(CurChunk);
CurChunk := chunk;
END;
MemIndex := ChunkSize;
END DisposeLines;
(*-------------------------------------------------------------------------*)
PROCEDURE MakeThink(sync: BOOLEAN);
BEGIN
I.MakeScreen(Screen);
g.MrgCop(I.ViewAddress());
IF sync THEN g.WaitBOVP(sys.ADR(Screen.viewPort)) END;
END MakeThink;
(*------ Clear Display: ------*)
PROCEDURE ClearBitMaps();
BEGIN
g.BltClear(BM.planes[0],2*PageSize,LONGSET{});
g.BltClear(BM.planes[1],2*PageSize,LONGSET{});
ScreenPos := 0;
ri.ryOffset := 0;
END ClearBitMaps;
(*------------------------ Open Display: --------------------------------*)
PROCEDURE InitScreen();
VAR c: CHAR;
BEGIN
(*------ Open Screen: ------*)
NumColumns := g.gfx.normalDisplayColumns DIV 32 * 4;
IF NumColumns>MaxLen THEN NumColumns := MaxLen END;
NuScreen.viewModes := {g.hires};
NumLines := g.gfx.normalDisplayRows DIV 8;
IF lace THEN
INC(NumLines,NumLines);
INCL(NuScreen.viewModes,g.lace);
END;
NuScreen.width := 8*NumColumns;
PageSize := 8*LONG(NumLines*NumColumns);
NuScreen.height := 16*NumLines;
NuScreen.depth := 2;
MyFont.name := sys.ADR("topaz.font");
MyFont.ySize := 8;
NuScreen.font := sys.ADR(MyFont);
NuScreen.type := I.customScreen+{I.screenQuiet};
LOOP
Screen := I.OpenScreen(NuScreen);
IF Screen#NIL THEN EXIT END;
DEC(NuScreen.depth);
IF NuScreen.depth=0 THEN Request(sys.ADR(oom)) END;
END;
BM := Screen.rastPort.bitMap;
IF NuScreen.depth=1 THEN BM.planes[1] := BM.planes[0] END;
ri := Screen.viewPort.rasInfo;
ClearBitMaps;
ri.ryOffset := 32;
Screen.height := Screen.height DIV 2;
MakeThink(TRUE);
I.RethinkDisplay;
(*------ Get Font: ------*)
IStr[64] := 0X;
j := 0; c := 20X;
g.SetDrMd(sys.ADR(Screen.rastPort),g.jam1);
g.SetAPen(sys.ADR(Screen.rastPort),1);
WHILE j<32 DO
i := 0; WHILE i<48 DO IStr[i] := c; INC(i); INC(c) END;
IF c=80X THEN c := 0A0X END;
g.Move(sys.ADR(Screen.rastPort),0,Screen.rastPort.font.baseline+j);
g.Text(sys.ADR(Screen.rastPort),IStr,48);
INC(j,8);
END;
GetFontData(Screen.bitMap.planes[0],sys.ADR(fontdata),NumColumns);
(*------ Open Window: ------*)
NuWindow.flags := LONGSET{I.rmbTrap,I.activate,I.borderless,I.reportMouse};
NuWindow.screen := Screen;
NuWindow.type := I.customScreen;
NuWindow.topEdge:= 10;
NuWindow.width := NuScreen.width;
NuWindow.height := Screen.height-10;
NuWindow.idcmpFlags := LONGSET{I.inactiveWindow,I.activeWindow,I.rawKey,
I.mouseButtons};
Window := I.OpenWindow(NuWindow);
IF Window=NIL THEN Request(sys.ADR(oom)) END;
END InitScreen;
(*-------------------------------------------------------------------------*)
PROCEDURE CloseDisplay();
BEGIN
IF Window#NIL THEN I.CloseWindow(Window); Window := NIL END;
IF Screen#NIL THEN I.CloseScreen(Screen); Screen := NIL END;
END CloseDisplay;
(*------ Read one TextLine into a Variable: ------*)
PROCEDURE GetTextLine(): TextLinePtr;
(* returns NIL at EOF *)
VAR
l: TextLinePtr;
sz,wd,i,j: INTEGER;
txt: ARRAY MaxLen+1 OF CHAR;
num: ARRAY 10 OF INTEGER;
newcol: BOOLEAN;
oldstyle: SHORTSET;
PROCEDURE GetCh();
BEGIN
IF RQPos=RQLen THEN
RQLen := d.Read(MyFile,Buffer,sys.SIZE(Buffer));
IF RQLen<0 THEN Request(sys.ADR(rwerr)) END;
RQPos := 0;
END;
IF RQLen=0 THEN c := 0X ELSE
c := Buffer[RQPos]; IF c=0X THEN c:=1X END;
INC(RQPos); INC(le);
END;
END GetCh;
BEGIN
IF RQLen=0 THEN RETURN NIL END;
sz := 0; wd := 0; le := 0;
IF Italic IN style THEN IF Bold IN style THEN txt[sz] := boldit ELSE txt[sz] := italic END; INC(sz);
ELSE IF Bold IN style THEN txt[sz] := bold; INC(sz) END;
END;
IF Ulin IN style THEN txt[sz] := ulineon; INC(sz) END;
IF Inv IN style THEN txt[sz] := CHR(fg+4*bg+1); INC(sz)
ELSIF (fg#1) OR (bg#0) THEN txt[sz] := CHR(bg+4*fg+1); INC(sz) END;
LOOP
LOOP
GetCh;
IF sys.VAL(CHAR,sys.VAL(SHORTSET,c)*SHORTSET{0..6})#1BX THEN EXIT END;
i := -1;
REPEAT
GetCh;
IF (c>=30X) AND (c<=39X) THEN
INC(i); num[i] := 0;
REPEAT
num[i] := 10*num[i]+ORD(c)-ORD(30X); GetCh;
UNTIL (c<30X) OR (c>39X);
END;
c := CAP(c);
UNTIL (c>=3FX(*"?"*)) AND (c<=5AX) OR (c=0X) OR (i=9);
IF c=4DX THEN
newcol := f; oldstyle := style; j := 0;
IF i=-1 THEN i:=0; num[0] := 0 END;
WHILE (i>=j) AND (sz<MaxLen-1) DO
CASE num[j] OF
0: style := SHORTSET{}; fg := 1; bg := 0; newcol := w |
1: INCL(style,Bold) |
2: fg := 2; newcol := w (* I hope this is correct *) |
3: INCL(style,Italic) |
4: INCL(style,Ulin) |
7: INCL(style,Inv); newcol := w |
30..37: fg := sys.VAL(INTEGER,sys.VAL(SET,num[j]-30) * {0,1}); newcol := w |
40..47: bg := sys.VAL(INTEGER,sys.VAL(SET,num[j]-40) * {0,1}); newcol := w |
ELSE END;
INC(j);
END;
IF (oldstyle#style) AND (sz<MaxLen) THEN
IF Italic IN style THEN IF Bold IN style THEN txt[sz] := boldit ELSE txt[sz] := italic END;
ELSE IF Bold IN style THEN txt[sz] := bold ELSE txt[sz] := plain END;
END;
INC(sz);
IF (Ulin IN style) THEN
IF NOT((Ulin IN oldstyle)) AND (sz<MaxLen) THEN
txt[sz] := ulineon;
INC(sz);
END;
ELSE
IF (Ulin IN oldstyle) AND (sz<MaxLen) THEN
txt[sz] := ulineoff;
INC(sz);
END;
END;
END;
IF newcol AND (sz<MaxLen) THEN
IF Inv IN style THEN txt[sz] := CHR(fg+4*bg+1)
ELSE txt[sz] := CHR(bg+4*fg+1) END;
INC(sz);
END;
END; (* IF c="m" THEN *)
END; (* LOOP *)
CASE c OF
20X..7FX: txt[sz] := c; INC(sz); INC(wd) |
0A1X..0FFX: DEC(c,32); txt[sz] := c; INC(sz); INC(wd) |
8X: (* BS *) IF wd>0 THEN DEC(sz); DEC(wd); END |
9X: (* TAB *)
REPEAT
txt[sz] := 20X; INC(sz); INC(wd)
UNTIL (sz=MaxLen) OR (wd=NumColumns) OR (sys.VAL(SET,sz)*{0..2}={}) |
0A0X: txt[sz] := 20X; INC(sz); INC(wd) |
0AX,0X,0CX: EXIT |
ELSE END;
IF (wd>=NumColumns) OR (sz>=MaxLen) THEN EXIT END;
END;
l := AllocLine(sz);
l.len := le; l.size:= sz;
WHILE sz>0 DO DEC(sz); l.text[sz]:=txt[sz] END;
RETURN l;
END GetTextLine;
(*------ Write Line at Bottom of Text: ------*)
PROCEDURE AddBottomLine(Line: TextLinePtr; Fast: BOOLEAN);
VAR
i,j: INTEGER;
trash: LONGINT;
s1,d1,s2,d2: POINTER TO LONGINT;
a: LONGINT;
BEGIN
QText(8*(ScreenPos+NumLines),sys.ADR(Line.text),BM,sys.ADR(fontdata));
IF Fast THEN
INC(ri.ryOffset,8);
MakeThink(Sync);
CopyLine1(BM,NumColumns,NumLines,ScreenPos);
ELSE
a := 8*LONG(ScreenPos*NumColumns);
d1 := BM.planes[0] + a; s1 := sys.VAL(LONGINT,d1) + PageSize;
d2 := BM.planes[1] + a; s2 := sys.VAL(LONGINT,d2) + PageSize;
i := 8;
REPEAT
INC(ri.ryOffset);
IF NOT lace OR ODD(i) THEN MakeThink(TRUE) END;
j := NumColumns DIV 4;
REPEAT
d1^ := s1^; INC(d1,4); INC(s1,4);
d2^ := s2^; INC(d2,4); INC(s2,4);
DEC(j);
UNTIL j=0;
DEC(i);
UNTIL i=0;
END;
INC(ScreenPos);
IF ScreenPos=NumLines THEN
ScreenPos := 0;
ri.ryOffset := 0;
END;
END AddBottomLine;
(*------ Write String to Screen: ------*)
PROCEDURE Write(String: StringPtr; Fast: BOOLEAN);
VAR text: TextLine;
BEGIN
text := FirstLine^;
i := Length(String^);
IF i>=NumColumns THEN i := NumColumns-1 END;
text.text[i+1] := 0X;
REPEAT
text.text[i] := String^[i];
IF text.text[i]>80X THEN DEC(text.text[i],32) END;
DEC(i)
UNTIL i<0;
AddBottomLine(sys.ADR(text),Fast);
END Write;
(*------ Check whether BottomLine.next is NIL or not: ------*)
PROCEDURE TryBottomnext(): BOOLEAN;
(* returns TRUE if BottomLine.next#NIL END; *)
BEGIN
IF (BottomLine.next=NIL) AND (MyFile#NIL) THEN
SignalNewData := w;
sys.SETREG(0,e.Wait(mySig));
SignalNewData := f;
END;
RETURN BottomLine.next#NIL;
END TryBottomnext;
(*------ Scroll down one Line: ------*)
PROCEDURE ScrollDown(Fast: BOOLEAN);
BEGIN
IF TryBottomnext() THEN
BottomLine := BottomLine.next;
INC(AnzLines);
INC(TextLength,BottomLine.len);
ELSE RETURN END;
IF AnzLines>=NumLines THEN TopLine := TopLine.next END;
AddBottomLine(BottomLine,Fast);
END ScrollDown;
(*------ Scroll Up one Line: ------*)
PROCEDURE ScrollUp(Fast: BOOLEAN);
VAR
i,j: INTEGER;
s1,d1,s2,d2: POINTER TO LONGINT;
a: LONGINT;
BEGIN
IF (TopLine.prev#NIL) AND (TopLine.prev.prev#NIL) THEN
TopLine := TopLine.prev;
DEC(TextLength,BottomLine.len);
DEC(AnzLines);
BottomLine := BottomLine.prev;
IF ScreenPos=0 THEN
ri.ryOffset := NumLines*8;
ScreenPos := NumLines-1;
ELSE
DEC(ScreenPos);
END;
QText(8*ScreenPos,sys.ADR(TopLine.prev.text),BM,sys.ADR(fontdata));
IF Fast THEN
DEC(ri.ryOffset,8);
MakeThink(Sync);
CopyLine2(BM,NumColumns,NumLines,ScreenPos);
ELSE
a := 8*LONG((ScreenPos+1)*NumColumns);
s1 := BM.planes[0] + a; d1 := sys.VAL(LONGINT,s1) + PageSize;
s2 := BM.planes[1] + a; d2 := sys.VAL(LONGINT,s2) + PageSize;
i := 8;
REPEAT
DEC(ri.ryOffset);
IF NOT lace OR ODD(i) THEN MakeThink(TRUE) END;
j := NumColumns DIV 4;
REPEAT
DEC(d1,4); DEC(s1,4); d1^ := s1^;
DEC(d2,4); DEC(s2,4); d2^ := s2^;
DEC(j);
UNTIL j=0;
DEC(i);
UNTIL i=0;
END;
END; (* IF TopLine#NIL ... *)
END ScrollUp;
(*------ Undo last Write(): ------*)
PROCEDURE DelLine();
VAR
i,j: INTEGER;
s1,d1,s2,d2: POINTER TO LONGINT;
a: LONGINT;
text: TextLine;
BEGIN
IF ScreenPos=0 THEN
ri.ryOffset := NumLines*8;
ScreenPos := NumLines;
END;
DEC(ScreenPos);
IF TopLine.prev#NIL THEN
QText(8*ScreenPos,sys.ADR(TopLine.prev.text),BM,sys.ADR(fontdata));
ELSE
QText(8*ScreenPos,sys.ADR(FirstLine.text),BM,sys.ADR(fontdata));
END;
a := (LONG(ScreenPos)+1)*8*LONG(NumColumns);
s1 := BM.planes[0] + a; d1 := sys.VAL(LONGINT,s1) + PageSize;
s2 := BM.planes[1] + a; d2 := sys.VAL(LONGINT,s2) + PageSize;
i := 8;
REPEAT
DEC(ri.ryOffset);
IF NOT lace OR ODD(i) THEN MakeThink(TRUE) END;
j := NumColumns DIV 4;
REPEAT
DEC(d1,4); DEC(s1,4); d1^ := s1^;
DEC(d2,4); DEC(s2,4); d2^ := s2^;
DEC(j);
UNTIL j=0;
DEC(i);
UNTIL i=0;
END DelLine;
(*------ Convert Integer to String: ------*)
PROCEDURE IntToStr(VAR String: String;
At,Chars: INTEGER;
int: LONGINT);
VAR
Cnt: INTEGER;
Ziff: LONGINT;
BEGIN
INC(Chars,At);
IF (Length(String)<Chars) AND (sys.SIZE(String)>=Chars) THEN
String[Chars] := 0X
END;
REPEAT
DEC(Chars);
String[Chars] := CHR(int MOD 10 + ORD(30X)); int := int DIV 10;
UNTIL (Chars=At) OR (int=0);
WHILE Chars>At DO DEC(Chars); String[Chars] := 20X END;
END IntToStr;
(*-------------------------------------------------------------------------*)
PROCEDURE GetLength(t: TextLinePtr);
BEGIN
TextLength := 0; AnzLines := 0;
WHILE t#NIL DO INC(AnzLines); INC(TextLength,t.len); t := t.prev END;
END GetLength;
(*-------------------------------------------------------------------------*)
PROCEDURE NewDisplay();
(* Zeichnet ab BottomLine neu *)
VAR
i: INTEGER;
l: TextLinePtr;
BEGIN
ClearBitMaps;
i := 1;
l := BottomLine;
WHILE (i<NumLines) AND (BottomLine.next#NIL) DO
BottomLine := BottomLine.next;
INC(i);
END;
WHILE (i<NumLines) AND (l.prev#NIL) DO l := l.prev; INC(i) END;
BottomLine := l;
GetLength(l);
Write(sys.ADR(empty),w);
AddBottomLine(BottomLine,w);
i := 1;
WHILE i<NumLines DO
TopLine := l;
ScrollDown(w);
INC(i);
END;
Scroll := f;
END NewDisplay;
(*-------------------------------------------------------------------------*)
PROCEDURE * ShowProc;
VAR
l: TextLinePtr;
Down: BOOLEAN; (* Scroll-Direction *)
End: BOOLEAN; (* Quit next time Space is pressed ? *)
i,j,k,m: INTEGER;
MyMsg: I.IntuiMessage; (* contains Message *)
Shift: BOOLEAN; (* Shifted Keystroke ? *)
Alt: BOOLEAN; (* Altered Keystroke ? *)
win: I.WindowPtr; (* window for Find & Goto *)
Find,FindStr: ARRAY 80 OF CHAR; (* findstring / capitalized findstring *)
Goto: ARRAY 10 OF CHAR; (* string containing goto line # *)
li: LONGINT; (* longint value of line to go to *)
flen: INTEGER; (* length of findstring *)
HiText: TextLine; (* Highlited textline *)
OldHiText: TextLinePtr; (* original, un-hilited text *)
found: BOOLEAN; (* TRUE, if find was successful *)
chr: CHAR; (* converted keycode *)
PROCEDURE WaitAllRead();
BEGIN
IF MyFile#NIL THEN
SignalAllRead := w;
sys.SETREG(0,e.Wait(mySig));
SignalAllRead := f;
END;
END WaitAllRead;
PROCEDURE HiLite(at,len: INTEGER);
(* Hilites len chars of BottomLine.text starting at position at *)
VAR
c: INTEGER;
col: CHAR;
BEGIN
OldHiText := BottomLine; HiText := OldHiText^; BottomLine := sys.ADR(HiText);
IF at+len+2<MaxLen THEN
c := 0; col := 5X;
WHILE c<at DO
IF HiText.text[c]<CHR(17) THEN col := HiText.text[c] END;
INC(c);
END;
HiText.text[at] := CHR(17-ORD(col));
c := at; INC(len,at);
WHILE c<len DO
HiText.text[c+1] := OldHiText.text[c];
INC(c);
END;
HiText.text[c+1] := col;
REPEAT
HiText.text[c+2] := OldHiText.text[c];
INC(c);
UNTIL HiText.text[c-1]=0X;
END;
IF HiText.next#NIL THEN HiText.next.prev := sys.ADR(HiText) END;
IF HiText.prev#NIL THEN HiText.prev.next := sys.ADR(HiText) END;
END HiLite;
PROCEDURE UnHiLite();
BEGIN
IF HiText.next#NIL THEN HiText.next.prev := OldHiText END;
IF HiText.prev#NIL THEN HiText.prev.next := OldHiText END;
END UnHiLite;
PROCEDURE ChkBotNewDisp;
VAR
c: INTEGER;
t: TextLinePtr;
BEGIN
IF NOT found THEN
I.DisplayBeep(NIL);
IF TopLine.prev=NIL THEN BottomLine := TopLine
ELSE BottomLine := TopLine.prev END;
END;
NewDisplay;
IF found THEN UnHiLite END;
END ChkBotNewDisp;
PROCEDURE Search(): BOOLEAN;
(* searches string and hilites it if found. result is TRUE if string found *)
BEGIN
i := 0;
IF BottomLine.len<NumColumns THEN m := BottomLine.len ELSE m := NumColumns END;
WHILE i<BottomLine.size DO
j := 0; k := i;
WHILE CAP(BottomLine.text[k])=FindStr[j] DO
INC(j); INC(k);
IF FindStr[j]=0X THEN
sys.SETREG(0,TryBottomnext());
FindLine := BottomLine;
HiLite(k-flen,flen);
found := w; RETURN w;
END;
END;
INC(i);
END;
RETURN f;
END Search;
PROCEDURE DisplayInfo();
BEGIN
(* File: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xx % (xxxxxx of xxxxxx Bytes) xxxxxx Lines *)
IStr := "XFile: "; IStr[0] := 7X;
Append(IStr,sys.ADR(Name));
Append(IStr,sys.ADR(" "));
IStr[36] := 0X;
Append(IStr,sys.ADR("xxx % (xxxxxx of xxxxxx Bytes) xxxxxx Lines"));
IntToStr(IStr,36,3,TextLength * 100 DIV FileLength);
IntToStr(IStr,43,6,TextLength);
IntToStr(IStr,53,6,FileLength);
IntToStr(IStr,67,6,AnzLines-1);
i := 79;
REPEAT IStr[i] := 20X; INC(i) UNTIL (i>=255) OR (i>=NumColumns+2);
IStr[i] := 0X; Write(sys.ADR(IStr),f);
Info := w;
END DisplayInfo;
PROCEDURE GetString(VAR str: ARRAY OF CHAR; int: BOOLEAN);
BEGIN
INC(Screen.height,Screen.height);
I.MakeScreen(Screen);
NuWindow.leftEdge := 100;
NuWindow.topEdge := NumLines*4-6+ri.ryOffset;
NuWindow.width := NuScreen.width-200;
NuWindow.height := 12;
NuWindow.blockPen := 1;
NuWindow.idcmpFlags := LONGSET{I.inactiveWindow,I.gadgetUp};
NuWindow.flags := LONGSET{I.rmbTrap,I.activate};
NuWindow.firstGadget := sys.ADR(StrGadget);
NuWindow.screen := Screen;
NuWindow.type := I.customScreen;
StrGadget.leftEdge := 2;
StrGadget.topEdge := 2;
StrGadget.width := NuWindow.width-4;
StrGadget.height := 8;
StrGadget.activation := {I.stringCenter,I.relVerify};
IF int THEN INCL(StrGadget.activation,I.longint) END;
StrGadget.gadgetType := I.strGadget;
StrGadget.specialInfo:= sys.ADR(StrInfo);
StrInfo.buffer := sys.ADR(str);
StrInfo.maxChars := LEN(str)-1;
win := I.OpenWindow(NuWindow);
IF win=NIL THEN RETURN END;
REPEAT
sys.SETREG(0,I.ActivateGadget(sys.ADR(StrGadget),win,NIL));
UNTIL win.userPort.sigBit IN
e.Wait(LONGSET{win.userPort.sigBit,
Window.userPort.sigBit});
I.CloseWindow(win);
Screen.height := Screen.height DIV 2;
END GetString;
PROCEDURE Help; (* executed when HELP or H is pressed *)
BEGIN
ClearBitMaps();
Write(sys.ADR(empty),w);
Write(sys.ADR("\x13 \x15 MuchMore V2.7 Commands: "),w);
Write(sys.ADR(empty),w);
Write(sys.ADR(" \x0dSpace\x05,\x0d LMB\x05: Start / Stop scrolling. Quit at end of file."),w);
Write(sys.ADR(" \x0dBackSpace\x05,\x0d RMB\x05: Start / Stop scrolling backwards."),w);
Write(sys.ADR(" \x0dUp\x05/\x0dDown\x05: Move one line \x0dup\x05 or \x0ddown\x05."),w);
Write(sys.ADR(" \x0dShift \x05+\x0d Up\x05/\x0dDn\x05: Start / Stop quick scrolling \x0dup\x05 or \x0ddown\x05."),w);
Write(sys.ADR(" \x0dAlt\x05+\x0dUp\x05/\x0dDn\x05,\x0d PgUp\x05/\x0dDn\x05: Move one page \x0dup\x05 or \x0ddown\x05."),w);
Write(sys.ADR(" \x0dT\x05,\x0d Home \x05/\x0d B\x05,\x0d End\x05: Goto \x0dt\x05op / \x0db\x05ottom of text."),w);
Write(sys.ADR(" \x0dF\x05,\x0dN\x05,\x0dP\x05: \x0dF\x05ind string, \x0dN\x05ext, \x0dP\x05revious occurance"),w);
Write(sys.ADR(" \x0dShift \x05+\x0d Fn\x05: Set textmarker #n to current position"),w);
Write(sys.ADR(" \x0dFn\x05: Goto marker #n or set marker #n if it wasn't set yet"),w);
Write(sys.ADR(" \x0dG\x05: \x0dG\x05oto line #n"),w);
Write(sys.ADR(" \x0dNK 0\x05: Display Filelength etc."),w);
Write(sys.ADR(" \x0dShift \x05+\x0d Alt \x05+\x0d O\x05: Create print\x0do\x05ut of the text"),w);
Write(sys.ADR(" \x0dW\x05: \x0dW\x05rite block between Marker #1 and #2 to file or prt"),w);
Write(sys.ADR(" \x0dL\x05: \x0dL\x05oad new text (arp necessary)"),w);
Write(sys.ADR(" \x0dHELP\x05,\x0d H\x05: Show Commands."),w);
Write(sys.ADR(" \x0dESC\x05,\x0d Q\x05,\x0d X\x05,\x0d NK 5\x05:\x0d Q\x05uit."),w);
Write(sys.ADR(" \x0dS\x05: Go to \x0dS\x05leep, pop up with left Alt-ESC."),w);
Write(sys.ADR(empty),w);
Write(sys.ADR("⌐ \x131990 Fridtjof Siebert, Nobileweg 67, D-7000 Stuttgart 40"),w);
Write(sys.ADR(" \x13Please refer to MuchMore.ReadMe for a detailed copyright notice"),w);
Write(sys.ADR(empty),w);
Write(sys.ADR(" This is another product of the Amiga MODULA & OBERON Klub Stuttgart - \x0d\x13AMOK"),w);
i := (NumLines-24) DIV 2;
WHILE i>0 DO Write(sys.ADR(empty),w); DEC(i) END;
LOOP
e.WaitPort(Window.userPort);
MyMsgPtr := sys.VAL(LONGINT,e.GetMsg(Window.userPort));
IF (I.rawKey IN MyMsgPtr.class) AND (MyMsgPtr.code<128) THEN EXIT END;
e.ReplyMsg(MyMsgPtr);
END;
e.ReplyMsg(MyMsgPtr);
BottomLine := TopLine;
NewDisplay
END Help;
PROCEDURE Bottom; (* executed when END or B is pressed *)
BEGIN
WaitAllRead;
BottomLine := LastLine;
i := NumLines;
WHILE (i>1) AND (BottomLine.prev#NIL) DO
BottomLine := BottomLine.prev;
DEC(i);
END;
NewDisplay
END Bottom;
PROCEDURE Space(): BOOLEAN; (* executed if space or LMB is pressed *)
(* IF result=w THEN EXIT END *)
BEGIN
Fast := Shift;
IF (MyFile=NIL) AND (BottomLine.next=NIL) THEN
IF End THEN RETURN w ELSE End:=w END;
ELSE
End := f;
END;
IF Down THEN
IF Scroll OR End THEN DisplayInfo END;
Scroll := NOT(Scroll);
ELSE
Down := w;
Scroll := w;
END;
RETURN f;
END Space;
PROCEDURE BackSpace; (* executed if backspace or RMB is pressed *)
BEGIN
Fast := Shift;
Scroll := Down OR NOT Scroll;
Down := f
END BackSpace;
BEGIN
sys.SETREG(13,e.exec.thisTask.userData);
sys.SETREG(0,e.Wait(mySig));
Down := w; End := f; Find[0] := 0X; Goto[0] := 0X;
LOOP
IF NewDisp THEN NewDisp := f; NewDisplay END;
(*------ Type Text: ------*)
LOOP
IF Scroll THEN
IF Down THEN
ScrollDown(Fast);
Scroll := (MyFile#NIL) OR (BottomLine.next#NIL);
ELSE
ScrollUp(Fast);
Scroll := TopLine.prev#NIL;
END;
ELSE
e.WaitPort(Window.userPort);
END;
MyMsgPtr := sys.VAL(LONGINT,e.GetMsg(Window.userPort));
IF (MyMsgPtr#NIL) THEN
IF NOT (I.inactiveWindow IN MyMsgPtr.class) THEN EXIT END;
EXCL(Window.idcmpFlags,I.mouseButtons);
e.ReplyMsg(MyMsgPtr);
e.WaitPort(Window.userPort);
INCL(Window.idcmpFlags,I.mouseButtons);
END;
END;
MyMsg := MyMsgPtr^;
e.ReplyMsg(MyMsgPtr);
IF MyMsg.code<80H THEN
IF Info THEN DelLine; Info := f;
ELSIF MyMsg.code=0FH THEN DisplayInfo; Scroll := f END;
END;
Shift := {} # {ie.lShift,ie.rShift,ie.capsLock} * MyMsg.qualifier;
Alt := {} # {ie.lAlt ,ie.rAlt} * MyMsg.qualifier;
Sync := NOT ( ie.control IN MyMsg.qualifier);
IF NOT(Sync OR Alt) THEN Shift := TRUE END;
IF I.mouseButtons IN MyMsg.class THEN
IF (ie.leftButton IN MyMsg.qualifier) AND Space() THEN EXIT
ELSIF ie.rightButton IN MyMsg.qualifier THEN BackSpace END;
ELSIF (I.rawKey IN MyMsg.class) AND (MyMsg.code<80H) THEN
CASE MyMsg.code OF
40H: IF Space() THEN EXIT END | (* Space *)
41H: BackSpace | (* BackSpace *)
4DH,1EH,1FH: (* Down *)
IF Shift THEN
Scroll := NOT(Down AND Scroll) OR NOT Fast;
Fast := w; Down := w;
ELSE
IF Alt OR (MyMsg.code=1FH) THEN i:=NumLines-1 ELSE i:=1 END;
REPEAT
ScrollDown(NOT Shift);
DEC(i);
UNTIL i=0;
Scroll := f;
END |
4CH,3EH,3FH: (* Up *)
IF Shift THEN
Scroll := Down OR NOT Scroll OR NOT Fast;
Fast := w; Down := f;
ELSE
IF Alt OR (MyMsg.code=3FH) THEN i:=NumLines-1 ELSE i:=1 END;
REPEAT
ScrollUp(NOT Shift);
Scroll := f;
DEC(i);
UNTIL i=0;
END; |
44H,43H: (* CR *)
ScrollDown(f);
Scroll := f; |
3DH: BottomLine := FirstLine; NewDisplay | (* Home *)
1DH: Bottom | (* End *)
50H..59H: (* F1..F10 *)
i := MyMsg.code-50H;
IF NOT Shift AND (TextMarkers[i]#NIL) THEN
BottomLine := TextMarkers[i];
IF BottomLine.prev#NIL THEN BottomLine := BottomLine.prev END;
NewDisplay;
ELSE
TextMarkers[i] := TopLine;
END |
5FH: Help |
45H,2EH: IF NOT Alt THEN EXIT END | (* Quit *)
ELSE
IF MyMsg.code<40H THEN (* examine vanilla keycode: *)
chr := KeyMap[MyMsg.code];
CASE chr OF
"t": BottomLine := FirstLine; NewDisplay | (* Home *)
"b": Bottom | (* End *)
"f","n","p": (* Find, Next, Previous *)
IF chr="f" THEN
GetString(Find,f); FindLine := NIL; flen := 0;
LOOP
FindStr[flen] := CAP(Find[flen]);
IF FindStr[flen]>80X THEN DEC(FindStr[flen],32)
ELSIF FindStr[flen]=0X THEN EXIT END;
INC(flen);
END;
ClearBitMaps();
END;
found := f;
IF FindStr[0]#0X THEN
i := NumLines;
IF FindLine#NIL THEN FindLine := FindLine.next END;
WHILE (i>0) AND (BottomLine#NIL) AND (BottomLine#FindLine) DO
BottomLine := BottomLine^.prev; DEC(i);
END;
IF (BottomLine#FindLine) OR (BottomLine=NIL) THEN BottomLine := TopLine END;
IF chr#"p" THEN (* next *)
WHILE (BottomLine#NIL) AND NOT Search() DO
sys.SETREG(0,TryBottomnext());
BottomLine := BottomLine.next;
END;
ELSE (* previous *)
IF BottomLine.prev#NIL THEN BottomLine:=BottomLine.prev END;
REPEAT
BottomLine := BottomLine.prev
UNTIL (BottomLine=NIL) OR Search();
END;
ELSE
BottomLine := NIL
END;
ChkBotNewDisp |
"w": (* write block *)
IF (TextMarkers[0]#NIL) AND (TextMarkers[1]#NIL) AND NOT print AND NOT save THEN
savefrom := 0; savesize := 0;
l := TextMarkers[0].prev; WHILE l.prev#NIL DO l := l.prev; INC(savefrom,l.len) END;
l := TextMarkers[1].prev; WHILE l#NIL DO INC(savesize,l.len); l := l.prev END;
l := TextMarkers[1]; i := NumLines; WHILE (i>1) AND (l#NIL) DO DEC(i); INC(savesize,LONG(l.len)); l := l.next END;
DEC(savesize,savefrom);
IF savesize>0 THEN
GetString(WriteName,f);
WaitAllRead; save := w; e.Signal(sys.ADR(Me.task),mySig); NewDisplay;
END
END |
"o": IF Shift AND Alt AND NOT print AND NOT save THEN (* Printout *)
PStr := 'TYPE "'; Append(PStr,sys.ADR(Name)); Append(PStr,sys.ADR('" TO PRT:'));
WaitAllRead; print := w; e.Signal(sys.ADR(Me.task),mySig);
END |
"l": ClearBitMaps; (* Load Text *)
MakeThink(TRUE); NewText := w; e.Signal(sys.ADR(Me.task),mySig);
REPEAT UNTIL (mySigBit IN e.Wait(mySig)) AND NOT NewText |
"g": (* goto *)
GetString(Goto,w);
li := SHORT(StrInfo.longInt);
BottomLine := FirstLine;
WHILE (li>0) AND TryBottomnext() DO
BottomLine := BottomLine.next;
DEC(li)
END;
NewDisplay |
"h": Help | (* Help *)
"q","x": EXIT | (* Quit *)
"s": (* Disappear *)
IF NOT print AND NOT save AND (e.FindPort(MMissleeping)=NIL) THEN
InputData.sleeping := w;
e.Signal(sys.ADR(Me.task),mySig);
sys.SETREG(0,e.Wait(mySig));
END |
ELSE END;
END; (* IF MyMsg.code<40H THEN *)
END; (* CASE MyMsg.code OF *)
END; (* IF I.rawKey IN MyMsg.class THEN *)
END; (* LOOP *)
Done := w;
e.Signal(sys.ADR(Me.task),mySig);
LOOP sys.SETREG(0,e.Wait(LONGSET{})) END;
END ShowProc;
(*-------------------------- File Requester: ----------------------------*)
PROCEDURE FileReq;
TYPE
TagItem = STRUCT
typ: LONGINT;
data: LONGINT;
END;
CONST
tagDone = 0;
tagIgnore = 1;
tagUser = MIN(LONGINT);
dummy = tagUser + 80000H;
taghail = dummy + 1;
leftEdge = dummy + 3; (* Initialize LeftEdge *)
topEdge = dummy + 4; (* Initialize TopEdge *)
width = dummy + 5;
height = dummy + 6;
hookFunc = dummy + 7; (* Hook function pointer *)
file = dummy + 8; (* Initial name of file follows *)
dir = dummy + 9; (* Initial string for filerequest dir *)
TYPE
NineTags = ARRAY 8 OF TagItem;
VAR
fr: FileRequesterPtr;
tags: NineTags;
res: BOOLEAN;
PROCEDURE AllocFileRequest {asl,-30} (tag{8}: ARRAY OF TagItem) : FileRequesterPtr;
PROCEDURE FreeFileRequest {asl,-36} (fr{8}: FileRequesterPtr);
PROCEDURE RequestFile {asl,-42} (fr{8}: FileRequesterPtr): BOOLEAN;
PROCEDURE FileRequest{arp,-294}(VAR filereq{8}: FileRequester): BOOLEAN;
BEGIN
LOOP
j := Length(Name);
WHILE (j>0) AND (Name[j]#":") AND (Name[j]#"/") DO DEC(j) END;
IF j=0 THEN j := -1 END;
i := 0;
WHILE i<=j DO Dirname[i] := Name[i]; INC(i) END; Dirname[i] := 0X;
j := 0;
REPEAT Filename[j] := Name[i]; INC(j); INC(i) UNTIL Name[i-1]=0X;
sys.SETREG(0,I.WBenchToFront());
IF asl=NIL THEN asl := e.OpenLibrary("asl.library",36) END;
IF asl#NIL THEN
tags := NineTags(taghail, sys.ADR(MuchText),
file, NIL,
dir, NIL,
leftEdge,20,
topEdge, 20,
width, 300,
height, 200,
tagDone, NIL);
tags[1].data := sys.ADR(Filename);
tags[2].data := sys.ADR(Dirname);
fr := AllocFileRequest(tags);
IF fr=NIL THEN Request(sys.ADR(oom)) END;
res := RequestFile(fr);
FreeFileRequest(fr);
IF NOT res THEN EXIT END;
Dirname := fr.ddir^;
Filename := fr.ddef^;
ELSE
IF arp=NIL THEN arp := e.OpenLibrary("arp.library",34) END;
IF arp#NIL THEN
FR.hail := sys.ADR(MuchText);
FR.ddef := sys.ADR(Filename);
FR.ddir := sys.ADR(Dirname);
FR.wind := NIL;
IF NOT FileRequest(FR) THEN EXIT END;
ELSE
Request(sys.ADR(noarp))
END;
END;
Name := Dirname;
i := Length(Name);
IF (i>0) THEN
CASE Name[i-1] OF "/",":": ELSE
Name[i] := "/"; INC(i);
END;
END;
j := 0;
LOOP
Name[i] := Filename[j];
IF (Name[i]=0X) OR (i=255) THEN EXIT END;
INC(i);
INC(j);
END;
Name[i] := 0X;
IF Screen#NIL THEN I.ScreenToFront(Screen) END;
IF Window#NIL THEN I.ActivateWindow(Window) END;
RETURN
END;
HALT(0);
END FileReq;
(*------ Sleep: ------*)
PROCEDURE Sleep();
BEGIN
InputDevPort.node.name := sys.ADR(MMissleeping);
InputData.sleeping := w;
sys.SETREG(0,e.Wait(mySig));
InputDevPort.node.name := sys.ADR(MMisawake);
END Sleep;
(*------------------------------ MAIN: ----------------------------------*)
BEGIN
(*------ Init: ------*)
(* These variables are automatically set to zero:
Screen := NIL; Window := NIL; FirstLine := NIL; TopLine := NIL;
BottomLine := NIL; MyFile := NIL; AnzLines := 0; Info := f;
MyLock := NIL; FileInfo := NIL; ScreenPos := 0; arp := NIL;
ShowTaskRunning := f; SignalNewData := f; SignalAllRead := f;
Done := f; print := f; bg := 0; style := SHORTSET{}; OldDir := NIL;
InputOpen := f; save := f; in := NIL; out := NIL;
*)
mySigBit := -1; Me := sys.VAL(d.ProcessPtr,ol.Me); fg := 1;
InputDevPort.sigBit := -1;
WriteName := "PRT:"; MemIndex := ChunkSize; OldDir := Me.currentDir;
Sync := TRUE;
I.GetPrefs(sys.ADR(Prefs),sys.SIZE(Prefs));
lace := Prefs.laceWB;
mySigBit := e.AllocSignal(-1);
IF mySigBit<0 THEN HALT(0) END;
mySig := LONGSET{mySigBit};
(*------ Setup: ------*)
NEW(FirstLine);
(*FirstLine.size := 0;
FirstLine.text[0] := 0X; *)
NEW(FileInfo);
IF FileInfo=NIL THEN Request(sys.ADR(oom)) END;
(*------ Init InputHandler: ------*)
InputData.wakeUpSignal := SHORT(mySigBit);
InputData.sigTask := sys.ADR(Me.task);
InputData.sleeping := f;
(* InputDevPort := CreatePort(NIL,0) *)
InputDevPort.node.name := sys.ADR(MMisawake);
InputDevPort.node.type:= e.msgPort;
InputDevPort.flags := e.signal;
InputDevPort.sigBit := e.AllocSignal(-1);
IF InputDevPort.sigBit<0 THEN HALT(0) END;
e.AddPort(sys.ADR(InputDevPort));
InputDevPort.sigTask := sys.ADR(Me.task);
(* InputRequestBlock := CreateStdIO(InputDevPort) *)
InputRequestBlock.message.node.type := e.message;
InputRequestBlock.message.length := sys.SIZE(InputRequestBlock);
InputRequestBlock.message.replyPort := sys.ADR(InputDevPort);
HandlerStuff.data := sys.ADR(InputData);
HandlerStuff.node.pri := 51;
IF e.OpenDevice("input.device",0,sys.ADR(InputRequestBlock),LONGSET{})#0 THEN
Request(sys.ADR("Need input.device"))
END;
InputOpen := w;
HandlerStuff.code := InputHandler;
InputRequestBlock.command := Input.addHandler;
InputRequestBlock.data := sys.ADR(HandlerStuff);
e.DoIO(sys.ADR(InputRequestBlock));
HandlerActive := w;
(*------ Start: ------*)
IF ol.wbStarted THEN
wbm := ol.wbenchMsg;
IF wbm.numArgs=2 THEN
ArgPtr := wbm.argList^[1].name; Name := ArgPtr^;
sys.SETREG(0,d.CurrentDir(wbm.argList^[1].lock));
ELSE
sys.SETREG(0,d.CurrentDir(wbm.argList^[0].lock));
FileReq
END
ELSE
IF ol.dosCmdLen<=1 THEN
FileReq
ELSE
CommLine := ol.dosCmdBuf;
LOOP
i:=0;
WHILE CommLine^=20X DO INC(CommLine) END;
IF CommLine^=0AX THEN EXIT END;
IF CommLine^='"' THEN
INC(CommLine);
LOOP
CASE CommLine^ OF
'"': INC(CommLine); EXIT |
0AX: EXIT |
ELSE
Name[i] := CommLine^; INC(i); INC(CommLine);
END;
END;
ELSE
WHILE (CommLine^#0AX) AND (CommLine^#20X) DO
Name[i] := CommLine^; INC(i); INC(CommLine);
END;
END;
Name[i]:= 0X;
IF Name="?" THEN Request(sys.ADR(usage)) END;
IF (Name[0]="-") AND (Name[2]=0X) THEN
Name[0] := 0X;
CASE Name[1] OF
"s": Sleep |
"l": lace := NOT lace |
END;
END;
END;
END;
END;
LOOP
MyFile := d.Open(Name,d.oldFile);
IF MyFile#NIL THEN EXIT END;
FileReq
END;
InitScreen();
(*------ Get KeyMap: ------*)
IF e.OpenDevice("console.device",-1,sys.ADR(wreq),LONGSET{})#0 THEN Request(sys.ADR(conerr)) END;
console := wreq.device;
(*ievent.nextEvent := NIL;
ievent.qualifier := {};
ievent.eventAddress := NIL; *)
ievent.class := ie.rawkey;
i := 0;
WHILE i<40H DO
ievent.code := i;
RawKeyConvert(sys.ADR(ievent),sys.ADR(KeyMap[i]),32,NIL);
INC(i);
END;
(*------ Init 2nd Task: ------*)
ShowTask.spLower := sys.ADR(ShowStack);
ShowTask.spUpper := sys.ADR(ShowStack[999]);
ShowTask.spReg := ShowTask.spUpper;
ShowTask.node.type := e.task;
ShowTask.node.name := sys.ADR("Show.MM");
ShowTask.node.pri := Me.task.node.pri+1;
ShowTask.userData := sys.REG(13); (* VarBase *)
e.Forbid;
e.AddTask(sys.ADR(ShowTask),ShowProc,NIL);
ShowTaskRunning := w;
Window.userPort.sigTask := sys.ADR(ShowTask);
e.Permit;
(*------ Main Load / Display Loop: ------*)
LOOP
RQLen := -1; RQPos := -1;
AnzLines := 1;
LastLine := FirstLine;
BottomLine := FirstLine;
TopLine := FirstLine;
TextLength := 0;
FindLine := NIL;
i := 0; REPEAT TextMarkers[i] := NIL; INC(i) UNTIL i=10;
MyLock := d.Lock(Name,d.sharedLock);
IF MyLock=NIL THEN Request(sys.ADR(cof)) END;
IF NOT d.Examine(MyLock,FileInfo) THEN Request(sys.ADR(cof)) END;
FileLength := FileInfo.size;
d.UnLock(MyLock); MyLock := NIL;
IF FileLength=0 THEN Request(sys.ADR("File empty")) END;
(*------ Start displaying & Loading: ------*)
NewDisp := TRUE;
e.Signal(sys.ADR(ShowTask),mySig);
REPEAT
LoadLine := GetTextLine();
IF LoadLine=NIL THEN
d.Close(MyFile);
MyFile := NIL;
ELSE
LoadLine.prev := LastLine;
LastLine.next := LoadLine;
LastLine := LoadLine;
END;
IF SignalNewData THEN e.Signal(sys.ADR(ShowTask),mySig) END;
UNTIL (MyFile=NIL) OR Done OR NewText OR InputData.sleeping;
IF SignalAllRead THEN e.Signal(sys.ADR(ShowTask),mySig) END;
REPEAT
sys.SETREG(0,e.Wait(mySig));
IF print THEN
in := d.Open(nil,d.oldFile); out := d.Open(nil,d.newFile);
sys.SETREG(0,d.Execute(PStr,in,out));
d.Close(in); in := NIL; d.Close(out); out := NIL; print := f;
END;
IF save THEN
in := d.Open(Name,d.oldFile);
IF in=NIL THEN I.DisplayBeep(NIL) ELSE
ol.New(buffer,savesize);
IF buffer=NIL THEN Request(sys.ADR(oom)) END;
sys.SETREG(0,d.Seek(in,savefrom,0));
IF d.Read(in,buffer^,savesize)#savesize THEN
I.DisplayBeep(NIL); d.Close(in); in := NIL;
ELSE
d.Close(in); in := NIL;
out := d.Open(WriteName,d.newFile);
IF out=NIL THEN I.DisplayBeep(NIL) ELSE
IF d.Write(out,buffer^,savesize)#savesize THEN I.DisplayBeep(NIL) END;
d.Close(out); out := NIL;
END;
END;
DISPOSE(buffer);
END;
save := f;
END;
IF Done THEN EXIT END;
UNTIL NewText OR InputData.sleeping;
IF MyFile#NIL THEN d.Close(MyFile); MyFile := NIL END;
DisposeLines();
FirstLine^.next := NIL; NewText := f;
IF InputData.sleeping THEN
CloseDisplay;
Sleep;
InitScreen;
Window.userPort.sigTask := sys.ADR(ShowTask);
END;
REPEAT
FileReq;
MyFile := d.Open(Name,d.oldFile);
UNTIL MyFile#NIL;
END; (* LOOP *)
CLOSE (* cleanup: *)
IF ShowTaskRunning THEN e.RemTask(sys.ADR(ShowTask)) END;
CloseDisplay;
IF MyFile#NIL THEN d.Close(MyFile) END;
IF in#NIL THEN d.Close(in) END;
IF out#NIL THEN d.Close(out) END;
IF MyLock#NIL THEN d.UnLock(MyLock) END;
IF OldDir#NIL THEN sys.SETREG(0,d.CurrentDir(OldDir)) END;
IF mySigBit>=0 THEN e.FreeSignal(mySigBit) END;
IF arp#NIL THEN e.CloseLibrary(arp) END;
IF asl#NIL THEN e.CloseLibrary(asl) END;
IF HandlerActive THEN
InputRequestBlock.command := Input.remHandler;
InputRequestBlock.data := sys.ADR(HandlerStuff);
e.DoIO(sys.ADR(InputRequestBlock));
END;
IF InputOpen THEN e.CloseDevice(sys.ADR(InputRequestBlock)) END;
IF InputDevPort.sigBit>0 THEN
e.RemPort(sys.ADR(InputDevPort));
e.FreeSignal(InputDevPort.sigBit)
END;
END MuchMore.