home *** CD-ROM | disk | FTP | other *** search
Text File | 1989-10-09 | 43.6 KB | 1,267 lines |
- (*---------------------------------------------------------------------------
- :Program. MuchMore.mod
- :Author. Fridtjof Siebert
- :Address. Nobileweg 67, D-7000-Stuttgart-40
- :Phone. (0)711/822509
- :Shortcut. [fbs]
- :Version. 1.8
- :Copyright. PD
- :Language. Modula-II
- :Translator. M2Amiga v3.2d
- :History. 24-Sep-88: First published version [fbs]
- :History. 26-Nov-88: Now Shows Filelength & Percentage [fbs]
- :History. 27-Nov-88: Mouse can be used instead of Space / BackSpace [fbs]
- :History. 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. 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. 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. 02-Jul-89: Now supports several fontstyles and colors [fbs]
- :History. 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. 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]
- :Contents. A Soft-Scrolling ASCII-File Printer.
- :Usage. Usage: MuchMore <FileName>
- :Remark. Grüße an alle, die gerade bei der Post jobben!
- ---------------------------------------------------------------------------*)
-
- MODULE MuchMore; (* $F- $V- $R- $S- I hope that there are no more bugs ! *)
-
- FROM SYSTEM IMPORT ADR, ADDRESS, LONGSET, INLINE, SETREG;
- FROM Arts IMPORT TermProcedure, Assert, dosCmdBuf, startupMsg, wbStarted,
- Terminate, dosCmdLen;
- FROM Dos IMPORT Open, Close, oldFile, Read, FileHandlePtr, FileLockPtr,
- FileInfoBlockPtr, Lock, UnLock, Examine, sharedLock,
- Execute, newFile, Delay, ParentDir, CurrentDir;
- FROM Exec IMPORT GetMsg, ReplyMsg, MessagePtr, WaitPort, AllocMem,
- FreeMem, MemReqSet, MemReqs, Task, AddTask, RemTask,
- task, Forbid, Permit, TaskPtr, FindTask, Wait, Signal,
- AllocSignal, FreeSignal, AvailMem;
- FROM Graphics IMPORT ViewModes, ViewModeSet, FontStyleSet, FontFlagSet, TextAttr,
- BltClear, OpenFont, CloseFont, TextFontPtr, GfxBase, BitMapPtr;
- FROM InputEvent IMPORT Qualifiers, QualifierSet;
- FROM Intuition IMPORT NewScreen, ScreenFlags, ScreenFlagSet, customScreen,
- OpenScreen, CloseScreen, MakeScreen, RethinkDisplay,
- ScreenPtr, NewWindow, WindowFlags, WindowFlagSet,
- IDCMPFlags, IDCMPFlagSet, OpenWindow, CloseWindow,
- WindowPtr, IntuiMessage, IntuiMessagePtr, GadgetPtr,
- StringInfo, GadgetFlags, GadgetFlagSet, ActivationFlags,
- ActivationFlagSet, strGadget, ActivateGadget, DisplayBeep,
- ActivateWindow;
- FROM Hardware IMPORT custom;
- FROM Workbench IMPORT WBStartupPtr;
- IMPORT Graphics;
-
- (*-------------------------------------------------------------------------*)
-
- CONST
- title = " MuchMore 1.8";
- underln = " ==================";
- address = "© 1989 Fridtjof Siebert, Nobileweg 67, D-7000-Stuttgart-40";
- empty = "";
- oom = "Out of memory!";
- cof = "Can't open file!";
- nil = "NIL:";
- w = TRUE;
- f = FALSE;
- MaxLen = 256;
-
- (* Control codes for QText: *)
- plain = CHAR(17);
- italic = CHAR(18);
- bold = CHAR(19);
- boldit = CHAR(20);
- ulineon = CHAR(21);
- ulineoff = CHAR(22);
-
- TYPE
- TextLinePtr = POINTER TO TextLine;
- TextLine = RECORD
- next: TextLinePtr;
- prev: TextLinePtr;
- len: INTEGER;
- size: INTEGER;
- text: ARRAY[0..MaxLen] OF CHAR;
- END;
- LONG = LONGINT;
- String = ARRAY [0..255] OF CHAR;
- FontData = ARRAY [0..7] OF ARRAY [0..191] OF ARRAY[0..7] OF CHAR;
- FontDataPtr = POINTER TO FontData;
- StyleSet = SET OF (Italic,Bold,Ulin,Inv);
-
- VAR
- Screen: ScreenPtr; (* Screen that contains the Text *)
- BM: BitMapPtr; (* Screen's BitMap *)
- Window: WindowPtr;
- MyFont: TextAttr;
- MyFile: 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,IStr,PStr: String;(* Text's Name *)
- Buffer: ARRAY[0..511] OF CHAR; (* Buffer for Reading *)
- RQPos: LONG; (* Position within ReadBuffer *)
- RQLen: LONG; (* Number of CHARs in Buffer *)
- NumLines: INTEGER; (* Number of Lines on Screen *)
- NumColumns: INTEGER; (* Number of Columns on Screen *)
- AnzLines: LONG; (* Length of Text in Lines *)
- Font: TextFontPtr; (* used Font *)
- fontdata: FontData; (* Fonts used by QText() *)
- MyLock,OldDir: FileLockPtr;
- FileInfo: FileInfoBlockPtr;
- FileLength, TextLength: LONG;(* Length of File and of Displayed Text *)
- Gfxbase: POINTER TO GfxBase; (* Graphics *)
- ScreenPos: INTEGER; (* actual position within bitmap *)
- ShowTask: Task; (* the task that displays the text *)
- ShowStack: ARRAY [0..3999] OF CHAR; (* it's stack *)
- ShowTaskRunning: BOOLEAN; (* is Showtask activated? *)
- mySig: INTEGER; (* My SignalBit *)
- SignalNewData,SignalAllRead,Done,print: BOOLEAN; (* Action to be done when signal arrives *)
- Me: TaskPtr;
- Info: BOOLEAN; (* currently displaying info-Line ? *)
- MyMsgPtr: IntuiMessagePtr; (* for receiving Messages *)
- i,j: INTEGER; (* count *)
- Scroll: BOOLEAN; (* scrolling or waiting? *)
- Fast: BOOLEAN; (* scrollquick? *)
- nili,nilo: FileHandlePtr; (* i/o for TYPE xxx TO PRT: *)
- fg,bg: INTEGER; (* Text colors *)
- style: StyleSet; (* Text style *)
- WBSt: WBStartupPtr; (* Our WBMsg *)
- CommLine: POINTER TO CHAR; (* The CLI-commands *)
- ArgPtr: POINTER TO String; (* to get WBArg *)
- NuScreen: NewScreen;
- NuWindow: NewWindow;
-
- (*-------------------------------------------------------------------------*)
-
- PROCEDURE Alloc(size: LONG): ADDRESS;
-
- VAR a: ADDRESS;
-
- BEGIN
- a := AllocMem(size,MemReqSet{memClear});
- Assert(a#NIL,ADR(oom));
- RETURN a;
- END Alloc;
-
-
- PROCEDURE Length(VAR s: ARRAY OF CHAR): INTEGER;
- VAR l: INTEGER;
- BEGIN l := 0; WHILE (l<=HIGH(s)) AND (s[l]#0C) DO INC(l) END; RETURN l;
- END Length;
-
-
- PROCEDURE Append(VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
- (* appends s2 to s1 *)
- VAR p,q: INTEGER;
- BEGIN
- p := Length(s1); q := 0;
- WHILE (p<=HIGH(s1)) AND (q<=HIGH(s2)) AND (p<NumColumns) DO
- s1[p] := s2[q]; INC(p); INC(q)
- END;
- IF p<=HIGH(s1) THEN s1[p] := 0C END;
- END Append;
-
- (*------ The fastest textoutput-Procedure in the world (maybe): ------*)
-
- PROCEDURE QText(y{1}: INTEGER;
- str{8}: ADDRESS;
- bm{9}: BitMapPtr;
- fd{10}: FontDataPtr);
-
- BEGIN
- INLINE(
- (*0000*) 02F0DH,04BFAH,001FEH,04244H,051C6H,050C7H,03429H,00000H,
- (*0010*) 048C2H,0C2C2H,02869H,0000CH,02269H,00008H,0D3C1H,0D9C1H,
- (*0020*) 02649H,02C4CH,03202H,05341H,0429BH,0429BH,0429EH,0429EH,
- (*0030*) 051C9H,0FFF6H,03202H,0E741H,09242H,01018H,06700H,00500H,
- (*0040*) 0B03CH,00020H,06400H,00100H,0B03CH,00011H,06D00H,00028H,
- (*0050*) 0B03CH,00016H,0B03CH,00015H,06D00H,00008H,057C6H,056C7H,
- (*0060*) 060D8H,062D6H,0903CH,00011H,04880H,03800H,0E344H,0D840H,
- (*0070*) 0E144H,0D844H,060C4H,05300H,06600H,00008H,04BFAH,000DEH,
- (*0080*) 060B8H,05300H,06600H,00008H,04BFAH,000D6H,060ACH,05300H,
- (*0090*) 06600H,00008H,04BFAH,000F0H,060A0H,05300H,06600H,00008H,
- (*00A0*) 04BFAH,0010AH,06094H,05300H,06600H,00008H,04BFAH,00154H,
- (*00B0*) 06088H,05300H,06600H,0000AH,04BFAH,0016EH,06000H,0FF7CH,
- (*00C0*) 05300H,06600H,0000AH,04BFAH,00190H,06000H,0FF6EH,05300H,
- (*00D0*) 06600H,0000AH,04BFAH,001D8H,06000H,0FF60H,05300H,06600H,
- (*00E0*) 0000AH,04BFAH,0021CH,06000H,0FF52H,05300H,06600H,0000AH,
- (*00F0*) 04BFAH,00234H,06000H,0FF44H,05300H,06600H,0000AH,04BFAH,
- (*0100*) 0027CH,06000H,0FF36H,05300H,06600H,0000AH,04BFAH,00292H,
- (*0110*) 06000H,0FF28H,05300H,06600H,0000AH,04BFAH,002D6H,06000H,
- (*0120*) 0FF1AH,05300H,06600H,0000AH,04BFAH,0031EH,06000H,0FF0CH,
- (*0130*) 05300H,06600H,0000AH,04BFAH,00362H,06000H,0FEFEH,04BFAH,
- (*0140*) 003ACH,06000H,0FEF6H,0903CH,00020H,0C07CH,000FFH,0E740H,
- (*0150*) 0D044H,047F2H,00000H,04DEBH,01800H,04ED5H,06000H,003D8H,
- (*0160*) 0129EH,0D2C2H,0129EH,0D2C2H,0129EH,0D2C2H,0129EH,0D2C2H,
- (*0170*) 0129EH,0D2C2H,0129EH,0D2C2H,0129EH,0D2C2H,0129EH,0CF11H,
- (*0180*) 092C1H,06000H,003B2H,0189EH,0D8C2H,0189EH,0D8C2H,0189EH,
- (*0190*) 0D8C2H,0189EH,0D8C2H,0189EH,0D8C2H,0189EH,0D8C2H,0189EH,
- (*01A0*) 0D8C2H,0189EH,0CF14H,098C1H,06000H,0038CH,01296H,0189EH,
- (*01B0*) 03A02H,01396H,05000H,0199EH,05000H,0DA42H,01396H,05000H,
- (*01C0*) 0199EH,05000H,0DA42H,01396H,05000H,0199EH,05000H,0DA42H,
- (*01D0*) 01396H,05000H,0199EH,05000H,0DA42H,01396H,05000H,0199EH,
- (*01E0*) 05000H,0DA42H,01396H,05000H,0199EH,05000H,0DA42H,01396H,
- (*01F0*) 05000H,0199EH,05000H,0CF31H,05000H,0CF34H,05000H,06000H,
- (*0200*) 00336H,0129BH,0D2C2H,0129BH,0D2C2H,0129BH,0D2C2H,0129BH,
- (*0210*) 0D2C2H,0129BH,0D2C2H,0129BH,0D2C2H,0129BH,0D2C2H,0129BH,
- (*0220*) 08D11H,092C1H,06000H,00310H,050D1H,03A02H,050F1H,05000H,
- (*0230*) 0DA42H,050F1H,05000H,0DA42H,050F1H,05000H,0DA42H,050F1H,
- (*0240*) 05000H,0DA42H,050F1H,05000H,0DA42H,050F1H,05000H,0DA42H,
- (*0250*) 050F1H,05000H,06000H,002E0H,0129BH,0189EH,03A02H,0139BH,
- (*0260*) 05000H,0199EH,05000H,0DA42H,0139BH,05000H,0199EH,05000H,
- (*0270*) 0DA42H,0139BH,05000H,0199EH,05000H,0DA42H,0139BH,05000H,
- (*0280*) 0199EH,05000H,0DA42H,0139BH,05000H,0199EH,05000H,0DA42H,
- (*0290*) 0139BH,05000H,0199EH,05000H,0DA42H,0139BH,05000H,0199EH,
- (*02A0*) 05000H,08D31H,05000H,0CF34H,05000H,06000H,0028AH,050D1H,
- (*02B0*) 0189EH,03A02H,050F1H,05000H,0199EH,05000H,0DA42H,050F1H,
- (*02C0*) 05000H,0199EH,05000H,0DA42H,050F1H,05000H,0199EH,05000H,
- (*02D0*) 0DA42H,050F1H,05000H,0199EH,05000H,0DA42H,050F1H,05000H,
- (*02E0*) 0199EH,05000H,0DA42H,050F1H,05000H,0199EH,05000H,0DA42H,
- (*02F0*) 050F1H,05000H,0199EH,05000H,0CF34H,05000H,06000H,00238H,
- (*0300*) 0189BH,0D8C2H,0189BH,0D8C2H,0189BH,0D8C2H,0189BH,0D8C2H,
- (*0310*) 0189BH,0D8C2H,0189BH,0D8C2H,0189BH,0D8C2H,0189BH,08D14H,
- (*0320*) 098C1H,06000H,00212H,0129EH,0189BH,03A02H,0139EH,05000H,
- (*0330*) 0199BH,05000H,0DA42H,0139EH,05000H,0199BH,05000H,0DA42H,
- (*0340*) 0139EH,05000H,0199BH,05000H,0DA42H,0139EH,05000H,0199BH,
- (*0350*) 05000H,0DA42H,0139EH,05000H,0199BH,05000H,0DA42H,0139EH,
- (*0360*) 05000H,0199BH,05000H,0DA42H,0139EH,05000H,0199BH,05000H,
- (*0370*) 0CF31H,05000H,08D34H,05000H,06000H,001BCH,050D4H,0D8C2H,
- (*0380*) 050D4H,0D8C2H,050D4H,0D8C2H,050D4H,0D8C2H,050D4H,0D8C2H,
- (*0390*) 050D4H,0D8C2H,050D4H,0D8C2H,050D4H,098C1H,06000H,00198H,
- (*03A0*) 0129EH,050D4H,03A02H,0139EH,05000H,050F4H,05000H,0DA42H,
- (*03B0*) 0139EH,05000H,050F4H,05000H,0DA42H,0139EH,05000H,050F4H,
- (*03C0*) 05000H,0DA42H,0139EH,05000H,050F4H,05000H,0DA42H,0139EH,
- (*03D0*) 05000H,050F4H,05000H,0DA42H,0139EH,05000H,050F4H,05000H,
- (*03E0*) 0DA42H,0139EH,05000H,050F4H,05000H,0CF31H,05000H,06000H,
- (*03F0*) 00146H,01293H,0189BH,03A02H,01393H,05000H,0199BH,05000H,
- (*0400*) 0DA42H,01393H,05000H,0199BH,05000H,0DA42H,01393H,05000H,
- (*0410*) 0199BH,05000H,0DA42H,01393H,05000H,0199BH,05000H,0DA42H,
- (*0420*) 01393H,05000H,0199BH,05000H,0DA42H,01393H,05000H,0199BH,
- (*0430*) 05000H,0DA42H,01393H,05000H,0199BH,05000H,08D31H,05000H,
- (*0440*) 08D34H,05000H,06000H,000F0H,050D1H,0189BH,03A02H,050F1H,
- (*0450*) 05000H,0199BH,05000H,0DA42H,050F1H,05000H,0199BH,05000H,
- (*0460*) 0DA42H,050F1H,05000H,0199BH,05000H,0DA42H,050F1H,05000H,
- (*0470*) 0199BH,05000H,0DA42H,050F1H,05000H,0199BH,05000H,0DA42H,
- (*0480*) 050F1H,05000H,0199BH,05000H,0DA42H,050F1H,05000H,0199BH,
- (*0490*) 05000H,08D34H,05000H,06000H,0009EH,0129BH,050D4H,03A02H,
- (*04A0*) 0139BH,05000H,050F4H,05000H,0DA42H,0139BH,05000H,050F4H,
- (*04B0*) 05000H,0DA42H,0139BH,05000H,050F4H,05000H,0DA42H,0139BH,
- (*04C0*) 05000H,050F4H,05000H,0DA42H,0139BH,05000H,050F4H,05000H,
- (*04D0*) 0DA42H,0139BH,05000H,050F4H,05000H,0DA42H,0139BH,05000H,
- (*04E0*) 050F4H,05000H,08D31H,05000H,06000H,0004CH,050D1H,050D4H,
- (*04F0*) 03A02H,050F1H,05000H,050F4H,05000H,0DA42H,050F1H,05000H,
- (*0500*) 050F4H,05000H,0DA42H,050F1H,05000H,050F4H,05000H,0DA42H,
- (*0510*) 050F1H,05000H,050F4H,05000H,0DA42H,050F1H,05000H,050F4H,
- (*0520*) 05000H,0DA42H,050F1H,05000H,050F4H,05000H,0DA42H,050F1H,
- (*0530*) 05000H,050F4H,05000H,05249H,0524CH,06000H,0FAFEH,02A5FH);
- END QText;
-
- (*------ Copy Line: ------*)
-
- PROCEDURE CopyLine1(BM{8}: BitMapPtr; w{0},h{1},pos{2}: INTEGER);
-
- BEGIN
- INLINE(
- (*0000*) 02668H,00008H,02868H,0000CH,0E740H,0C5C0H,047F3H,02000H,
- (*0010*) 049F4H,02000H,0C3C0H,043F3H,01000H,045F4H,01000H,0E440H,
- (*0020*) 05340H,026D9H,028DAH,051C8H,0FFFAH);
- END CopyLine1;
-
-
- PROCEDURE CopyLine2(BM{8}: BitMapPtr; w{0},h{1},pos{2}: INTEGER);
-
- BEGIN
- INLINE(
- (*0000*) 02668H,00008H,02868H,0000CH,0E740H,0C5C0H,047F3H,02000H,
- (*0010*) 049F4H,02000H,0C3C0H,043F3H,01000H,045F4H,01000H,0E440H,
- (*0020*) 05340H,022DBH,024DCH,051C8H,0FFFAH);
- END CopyLine2;
-
- (*------ Get Fonts: ------*)
-
- PROCEDURE GetFontData(from{8},to{9}: ADDRESS);
-
- BEGIN
- INLINE(
- (*0000*) 0303CH,000BFH,03200H,0E741H,03A01H,03C01H,03E01H,0DA7CH,
- (*0010*) 00600H,0DC7CH,00C00H,0DE7CH,01200H,045F0H,00000H,01412H,
- (*0020*) 01382H,01000H,01602H,0E40BH,06400H,00006H,008C3H,00000H,
- (*0030*) 01383H,05000H,01802H,0E20CH,08802H,01384H,06000H,01803H,
- (*0040*) 0E20CH,08803H,01384H,07000H,0D4FCH,000C0H,01412H,01382H,
- (*0050*) 01001H,01602H,0E40BH,06400H,00006H,008C3H,00000H,01383H,
- (*0060*) 05001H,01802H,0E20CH,08802H,01384H,06001H,01803H,0E20CH,
- (*0070*) 08803H,01384H,07001H,0D4FCH,000C0H,01412H,01382H,01002H,
- (*0080*) 01602H,0E20BH,06400H,00006H,008C3H,00000H,01383H,05002H,
- (*0090*) 01802H,0E20CH,08802H,01384H,06002H,01803H,0E20CH,08803H,
- (*00A0*) 01384H,07002H,0D4FCH,000C0H,01412H,01382H,01003H,01602H,
- (*00B0*) 0E20BH,06400H,00006H,008C3H,00000H,01383H,05003H,01802H,
- (*00C0*) 0E20CH,08802H,01384H,06003H,01803H,0E20CH,08803H,01384H,
- (*00D0*) 07003H,0D4FCH,000C0H,01412H,01382H,01004H,01382H,05004H,
- (*00E0*) 01802H,0E20CH,08802H,01384H,06004H,01384H,07004H,0D4FCH,
- (*00F0*) 000C0H,01412H,01382H,01005H,01382H,05005H,01802H,0E20CH,
- (*0100*) 08802H,01384H,06005H,01384H,07005H,0D4FCH,000C0H,01412H,
- (*0110*) 01382H,01006H,01602H,0E30BH,06400H,00006H,008C3H,00007H,
- (*0120*) 01383H,05006H,01802H,0E20CH,08802H,01384H,06006H,01803H,
- (*0130*) 0E20CH,08803H,01384H,07006H,0D4FCH,000C0H,01412H,01382H,
- (*0140*) 01007H,01602H,0E30BH,06400H,00006H,008C3H,00007H,01383H,
- (*0150*) 05007H,01802H,0E20CH,08802H,01384H,06007H,01803H,0E20CH,
- (*0160*) 08803H,01384H,07007H,051C8H,0FE9CH,02449H,0D4FCH,01800H,
- (*0170*) 0303CH,005FFH,02419H,04682H,024C2H,051C8H,0FFF8H);
- END GetFontData;
-
- (*------------------------ Open Display: --------------------------------*)
-
- PROCEDURE InitScreen();
-
- BEGIN
-
- (*------ Get Font: ------*)
-
- WITH MyFont DO
- name := ADR("topaz.font");
- ySize := 8;
- END;
- Font := OpenFont(ADR(MyFont));
- GetFontData(Font^.charData,ADR(fontdata));
- CloseFont(Font);
-
- (*------ Open Screen: ------*)
-
- NumColumns := Gfxbase^.normalDisplayColumns DIV 32 * 4;
- IF NumColumns>MaxLen THEN NumColumns := MaxLen END;
- NuScreen.width := 8*NumColumns;
- NumLines := Gfxbase^.normalDisplayRows DIV 8;
- NuScreen.height := 16*NumLines;
- NuScreen.depth := 2;
- NuScreen.viewModes := ViewModeSet{hires};
- NuScreen.type := customScreen+ScreenFlagSet{screenQuiet};
- Screen := OpenScreen(NuScreen);
- Assert(Screen#NIL,ADR(oom));
- BM := Screen^.rastPort.bitMap;
- Screen^.height := Screen^.height DIV 2;
- MakeScreen(Screen); RethinkDisplay();
-
- (*------ Open Window: ------*)
-
- NuWindow.topEdge := 10;
- NuWindow.width := NumColumns*8;
- NuWindow.height := Screen^.height-10;
- NuWindow.idcmpFlags := IDCMPFlagSet{inactiveWindow,mouseButtons,rawKey};
- NuWindow.flags := WindowFlagSet{activate};
- NuWindow.screen := Screen;
- NuWindow.type := customScreen;
- Window := OpenWindow(NuWindow);
- Assert(Window#NIL,ADR(oom));
-
- END InitScreen;
-
- (*------ Read one TextLine into a Variable: ------*)
-
- PROCEDURE GetTextLine(): TextLinePtr;
- (* returns NIL at EOF *)
-
- VAR
- l: TextLinePtr;
- sz,wd,le,i,j: INTEGER;
- c: CHAR;
- txt: ARRAY[0..MaxLen] OF CHAR;
- num: ARRAY [0..9] OF LONGINT;
- newcol: BOOLEAN;
- oldstyle: StyleSet;
-
- PROCEDURE GetCh();
-
- BEGIN
- IF RQPos=RQLen THEN
- RQLen := Read(MyFile,ADR(Buffer),SIZE(Buffer));
- RQPos := 0;
- END;
- IF RQLen=0 THEN c := 0C ELSE
- c := Buffer[RQPos]; IF c=0C THEN c:=1C 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] := CHAR(fg+4*bg+1); INC(sz)
- ELSIF (fg#1) OR (bg#0) THEN txt[sz] := CHAR(bg+4*fg+1); INC(sz) END;
- REPEAT
- LOOP
- GetCh;
- IF (c#33C) AND (c#233C) THEN EXIT END;
- i := -1;
- REPEAT
- GetCh;
- IF (c>="0") AND (c<="9") THEN
- INC(i); num[i] := 0;
- REPEAT
- num[i] := 10*num[i]+ORD(c)-ORD("0"); GetCh;
- UNTIL (c<"0") OR (c>"9");
- END;
- c := CAP(c);
- UNTIL (c>="?") AND (c<="Z") OR (c=0C);
- IF c="M" THEN
- newcol := f; oldstyle := style; j := 0;
- WHILE (i>=j) AND (sz<MaxLen-1) DO
- CASE num[j] OF
- 0: style := StyleSet{}; 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 := (num[j]-30) MOD 4; newcol := w |
- 40..47: bg := (num[j]-40) MOD 4; 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) # (Ulin IN oldstyle)) AND (sz<MaxLen) THEN
- IF Ulin IN style THEN txt[sz] := ulineon ELSE txt[sz] := ulineoff END;
- INC(sz);
- END;
- END;
- IF newcol AND (sz<MaxLen) THEN
- IF Inv IN style THEN txt[sz] := CHAR(fg+4*bg+1)
- ELSE txt[sz] := CHAR(bg+4*fg+1) END;
- INC(sz);
- END;
- END;
- END;
- CASE c OF
- 40C..177C: txt[sz] := c; INC(sz); INC(wd) |
- 241C..377C: DEC(c,32); txt[sz] := c; INC(sz); INC(wd) |
- 10C: IF wd>0 THEN DEC(sz); DEC(wd); END |
- 11C:
- REPEAT
- txt[sz] := " "; INC(sz); INC(wd)
- UNTIL (sz=MaxLen) OR (wd=NumColumns) OR (sz MOD 8 = 0) |
- 240C: txt[sz] := " "; INC(sz); INC(wd) |
- ELSE END;
- UNTIL (c=12C) OR (c=0C) OR (wd>=NumColumns) OR (sz>=MaxLen);
- l := Alloc(SIZE(TextLine)-MaxLen+sz);
- WITH l^ DO
- len := le; size:= sz;
- WHILE sz>0 DO DEC(sz); text[sz]:=txt[sz] END;
- END;
- RETURN l;
- END GetTextLine;
-
- (*------ Write Line at Bottom of Text: ------*)
-
- PROCEDURE AddBottomLine(Line: TextLinePtr; Fast: BOOLEAN);
-
- VAR
- i,j: INTEGER;
- trash: LONG;
- s1,d1,s2,d2: POINTER TO LONG;
- a,b: LONG;
-
- BEGIN
- WITH Screen^.viewPort.rasInfo^ DO
- QText(8*(ScreenPos+NumLines),ADR(Line^.text),BM,ADR(fontdata));
- IF Fast THEN
- INC(ryOffset,8); MakeScreen(Screen); RethinkDisplay();
- CopyLine1(BM,NumColumns,NumLines,ScreenPos);
- ELSE
- a := 8*LONG(ScreenPos)*LONG(NumColumns);
- b := 8*LONG(NumLines )*LONG(NumColumns);
- d1 := BM^.planes[0]; INC(d1,a); s1 := d1; INC(s1,b);
- d2 := BM^.planes[1]; INC(d2,a); s2 := d2; INC(s2,b);
- FOR i:=0 TO 7 DO
- INC(ryOffset);
- MakeScreen(Screen); RethinkDisplay();
- FOR j:=1 TO NumColumns DIV 4 DO
- d1^ := s1^; INC(d1,4); INC(s1,4);
- d2^ := s2^; INC(d2,4); INC(s2,4)
- END;
- END;
- END;
- INC(ScreenPos);
- IF ScreenPos=NumLines THEN
- ScreenPos := 0;
- ryOffset := 0;
- END;
- END;
- END AddBottomLine;
-
- (*------ Write String to Screen: ------*)
-
- PROCEDURE Write(String: ARRAY OF CHAR; Fast: BOOLEAN);
-
- VAR text: TextLine;
-
- BEGIN
- text := FirstLine^;
- i := Length(String);
- IF i>=NumColumns THEN i := NumColumns-1 END;
- text.text[i+1] := 0C;
- REPEAT
- text.text[i] := String[i];
- IF text.text[i]>200C THEN DEC(text.text[i],32) END;
- DEC(i)
- UNTIL i<0;
- AddBottomLine(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;
- REPEAT UNTIL mySig IN Wait(LONGSET{mySig});
- SignalNewData := f;
- END;
- RETURN BottomLine^.next#NIL;
- END TryBottomnext;
-
- (*------ Scroll down one Line: ------*)
-
- PROCEDURE ScrollDown(Fast: BOOLEAN);
- (* Returns TRUE if EOF *)
-
- 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 LONG;
- a,b: LONG;
-
- BEGIN
- IF TopLine^.prev#NIL THEN
- TopLine := TopLine^.prev;
- DEC(TextLength,BottomLine^.len);
- DEC(AnzLines);
- BottomLine := BottomLine^.prev;
- WITH Screen^.viewPort.rasInfo^ DO
- IF ScreenPos=0 THEN
- ryOffset := NumLines*8;
- ScreenPos := NumLines-1;
- ELSE
- DEC(ScreenPos);
- END;
- QText(8*ScreenPos,ADR(TopLine^.prev^.text),BM,ADR(fontdata));
- IF Fast THEN
- DEC(ryOffset,8); MakeScreen(Screen); RethinkDisplay();
- CopyLine2(BM,NumColumns,NumLines,ScreenPos);
- ELSE
- a := (LONG(ScreenPos)+1)*8*LONG(NumColumns)-4;
- b := LONG(NumLines)*LONG(NumColumns)*8;
- s1 := BM^.planes[0]; INC(s1,a); d1 := s1; INC(d1,b);
- s2 := BM^.planes[1]; INC(s2,a); d2 := s2; INC(d2,b);
- FOR i:=0 TO 7 DO
- DEC(ryOffset);
- MakeScreen(Screen); RethinkDisplay();
- FOR j:=1 TO NumColumns DIV 4 DO
- d1^ := s1^; DEC(d1,4); DEC(s1,4);
- d2^ := s2^; DEC(d2,4); DEC(s2,4)
- END;
- END;
- END;
- END;
- END; (* IF TopLine#NIL ... *)
- END ScrollUp;
-
- (*------ Undo last Write(): ------*)
-
- PROCEDURE DelLine();
-
- VAR
- i,j: INTEGER;
- s1,d1,s2,d2: POINTER TO LONG;
- a,b: LONG;
- text: TextLine;
-
- BEGIN
- WITH Screen^.viewPort.rasInfo^ DO
- IF ScreenPos=0 THEN
- ryOffset := NumLines*8;
- ScreenPos := NumLines-1;
- ELSE
- DEC(ScreenPos);
- END;
- IF TopLine^.prev#NIL THEN
- QText(8*ScreenPos,ADR(TopLine^.prev^.text),BM,ADR(fontdata));
- ELSE
- QText(8*ScreenPos,ADR(FirstLine^.text),BM,ADR(fontdata));
- END;
- a := (LONG(ScreenPos)+1)*8*LONG(NumColumns)-4;
- b := LONG(NumLines)*LONG(NumColumns)*8;
- s1 := BM^.planes[0]; INC(s1,a); d1 := s1; INC(d1,b);
- s2 := BM^.planes[1]; INC(s2,a); d2 := s2; INC(d2,b);
- FOR i:=0 TO 7 DO
- DEC(ryOffset);
- MakeScreen(Screen); RethinkDisplay();
- FOR j:=1 TO NumColumns DIV 4 DO
- d1^ := s1^; DEC(d1,4); DEC(s1,4);
- d2^ := s2^; DEC(d2,4); DEC(s2,4)
- END;
- END;
- END;
- END DelLine;
-
- (*------ Clear Display: ------*)
-
- PROCEDURE ClearBitMaps();
-
- BEGIN
- WITH BM^ DO
- BltClear(planes[0],LONG(bytesPerRow)*LONG(rows),0);
- BltClear(planes[1],LONG(bytesPerRow)*LONG(rows),0);
- ScreenPos := 0;
- Screen^.viewPort.rasInfo^.ryOffset := 0;
- END;
- END ClearBitMaps;
-
- (*------ Convert Integer to String: ------*)
-
- PROCEDURE IntToStr(VAR String: ARRAY OF CHAR;
- At,Chars: INTEGER;
- int: LONG);
-
- VAR
- Cnt: INTEGER;
- Ziff: LONG;
-
- BEGIN
- IF (Length(String)<Chars+At) AND (HIGH(String)>=Chars+At) THEN
- String[Chars+At] := 0C;
- END;
- Cnt := Chars; Ziff := 1;
- WHILE Cnt>1 DO
- Ziff := Ziff * 10;
- DEC(Cnt);
- END;
- Cnt := 0;
- WHILE Cnt<Chars DO
- String[Cnt+At] := "0";
- WHILE int>=Ziff DO
- DEC(int,Ziff);
- INC(String[Cnt+At]);
- END;
- Ziff := Ziff DIV 10;
- INC(Cnt);
- END;
- Cnt := 0;
- WHILE (Cnt<Chars-1) AND (String[Cnt+At]="0") DO String[Cnt+At] := " "; INC(Cnt)
- 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(empty,w);
- AddBottomLine(BottomLine,w);
- FOR i:=0 TO NumLines-2 DO
- TopLine := l;
- ScrollDown(w);
- 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: IntuiMessage; (* contains Message *)
- Shift: BOOLEAN; (* Shifted Keystroke ? *)
- Alt: BOOLEAN; (* Altered Keystroke ? *)
- NuWindow: POINTER TO NewWindow;
- win: WindowPtr;
- StrGadget: GadgetPtr;
- StrInfo: StringInfo;
- Find,FindStr: String;
- flen: INTEGER;
- HiText: TextLine; (* Highlited textline *)
- OldHiText: TextLinePtr; (* original, un-hilited text *)
- found: BOOLEAN;
-
- PROCEDURE NuWin; (* $E- *)
- BEGIN
- INLINE(100,0,0,12,1, (* size, pens *)
- 8,64,0,4096, (* idcmp, flags *)
- 0,0,0,0,0,0, (* gadget, checkmark, title *)
- 0,0,0,0, (* screen, bitmap *)
- 0,0,0,0, (* min/max size *)
- 15); (* customscreen *)
- END NuWin;
-
- PROCEDURE StrGdg(); (* $E- *)
- BEGIN
- INLINE(0,0, (* next *)
- 2,2,0,8, (* size *)
- 0,513, (* flags, activation *)
- strGadget,
- 0,0,0,0,0,0, (* render, selectr., text *)
- 0,0,0,0,0); (* mutualexcl, specialinfo *)
- END StrGdg;
-
- PROCEDURE WaitAllRead();
-
- BEGIN
- IF MyFile#NIL THEN
- SignalAllRead := w;
- REPEAT UNTIL mySig IN Wait(LONGSET{mySig});
- SignalAllRead := f;
- END;
- END WaitAllRead;
-
- PROCEDURE HiLite(t: TextLinePtr; at,len: INTEGER);
- (* Hilites len chars of t^.text starting from at *)
-
- VAR
- c: INTEGER;
- col: CHAR;
-
- BEGIN
- OldHiText := t; HiText := OldHiText^;
- IF at+len+2<MaxLen THEN
- c := 0; col := 5C;
- WHILE c<at DO
- IF HiText.text[c]<CHAR(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]=0C;
- END;
- IF HiText.next#NIL THEN HiText.next^.prev := ADR(HiText) END;
- IF HiText.prev#NIL THEN HiText.prev^.next := 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;
-
- BEGIN
- IF NOT found THEN
- DisplayBeep(Screen);
- IF TopLine^.prev=NIL THEN BottomLine := TopLine
- ELSE BottomLine := TopLine^.prev END;
- ELSE BottomLine := BottomLine^.prev^.next 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
- WITH BottomLine^ DO
- i := 0;
- IF len<NumColumns THEN m := len ELSE m := NumColumns END;
- m := m-flen;
- WHILE i<m DO
- j := 0; k := i;
- WHILE CAP(text[k])=FindStr[j] DO
- INC(j); INC(k);
- IF FindStr[j]=0C THEN
- IF TryBottomnext() THEN END;
- HiLite(BottomLine,k-flen,flen);
- found := w; RETURN w;
- END;
- END;
- INC(i);
- END;
- END;
- RETURN f;
- END Search;
-
- PROCEDURE DisplayInfo();
-
- BEGIN
- (* File: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xx % (xxxxxx of xxxxxx Bytes) xxxxxx Lines *)
- IStr := "XFile: "; IStr[0] := 7C;
- Append(IStr,Name);
- Append(IStr," ");
- IStr[36] := 0C;
- Append(IStr,"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;
- WHILE (i<255) AND (i<NumColumns+2) DO IStr[i] := " "; INC(i) END;
- IStr[i] := 0C; Write(IStr,f);
- Info := w;
- END DisplayInfo;
-
- BEGIN
-
- Scroll := w; Fast := f; Down := w; End := f; Find := empty;
- LOOP
-
- (*------ Type Text: ------*)
-
- IF Scroll THEN
- IF Down THEN
- ScrollDown(Fast);
- Scroll := (MyFile#NIL) OR (BottomLine^.next#NIL);
- ELSE
- ScrollUp(Fast);
- Scroll := TopLine^.prev#NIL;
- END;
- ELSE
- WaitPort(Window^.userPort);
- END;
-
- MyMsgPtr := ADDRESS(GetMsg(Window^.userPort));
- WHILE (MyMsgPtr#NIL) AND (inactiveWindow IN MyMsgPtr^.class) DO
- WaitPort(Window^.userPort);
- MyMsgPtr := ADDRESS(GetMsg(Window^.userPort));
- END;
-
- IF MyMsgPtr#NIL THEN
-
- MyMsg := MyMsgPtr^;
- ReplyMsg(MyMsgPtr);
-
- WITH MyMsg DO
-
- IF class=IDCMPFlagSet{mouseButtons} THEN
- class := IDCMPFlagSet{rawKey};
- IF leftButton IN QualifierSet(qualifier) THEN
- code := 40H;
- ELSIF rightButton IN QualifierSet(qualifier) THEN
- code := 41H;
- END;
- END;
-
- IF (class=IDCMPFlagSet{rawKey}) AND (code<80H) THEN
-
- IF Info THEN DelLine; Info := f;
- ELSIF code=0FH THEN DisplayInfo; Scroll := f END;
-
- Shift := QualifierSet{} # QualifierSet{lShift,rShift} * QualifierSet(qualifier);
- Alt := QualifierSet{} # QualifierSet{lAlt,rAlt} * QualifierSet(qualifier);
-
- CASE code OF
-
- 40H: (* Space *)
- Fast := Shift;
- IF (MyFile=NIL) AND (BottomLine^.next=NIL) THEN
- IF End THEN EXIT 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 |
-
- 41H: (* BackSpace *)
- Fast := Shift;
- Scroll := Down OR NOT(Scroll);
- Down := f |
-
- 4DH,1EH,1FH: (* Down *)
- IF Shift THEN
- Scroll := NOT(Down AND Scroll) OR NOT(Fast);
- Fast := w; Down := w;
- ELSE
- i:=1; IF Alt OR (code=1FH) THEN i:=NumLines END;
- WHILE i#0 DO
- ScrollDown(NOT(Shift));
- DEC(i);
- END;
- Scroll := f;
- END |
-
- 4CH,3EH,3FH: (* Up *)
- IF Shift THEN
- Scroll := Down OR NOT(Scroll) OR NOT(Fast);
- Fast := w; Down := f;
- ELSE
- i:=1; IF Alt OR (code=3FH) THEN i:=NumLines END;
- WHILE i#0 DO
- ScrollUp(NOT(Shift));
- Scroll := f;
- DEC(i);
- END;
- END; |
-
- 44H,43H: (* CR *)
- ScrollDown(f);
- Scroll := f; |
-
- 14H,3DH: (* Home *)
- i:=NumLines-AnzLines;
- IF i>0 THEN
- WHILE i>0 DO DEC(i); ScrollDown(w) END; Scroll := f;
- ELSE
- BottomLine := FirstLine; NewDisplay();
- END |
-
- 35H,1DH: (* End *)
- WaitAllRead;
- BottomLine := LastLine;
- i:=NumLines;
- WHILE (i>1) AND (BottomLine^.prev#NIL) DO
- BottomLine := BottomLine^.prev;
- DEC(i);
- END;
- NewDisplay() |
-
- 23H,36H: (* Find, Next *)
- IF code=23H THEN
- Screen^.height := 2*Screen^.height;
- MakeScreen(Screen); RethinkDisplay();
- NuWindow := ADR(NuWin);
- StrGadget := ADR(StrGdg);
- WITH NuWindow^ DO
- topEdge := NumLines*4-6+Screen^.viewPort.rasInfo^.ryOffset;
- width := NumColumns*8-200;
- firstGadget:= StrGadget;
- screen := Screen;
- StrGadget^.width := width-4;
- StrGadget^.specialInfo := ADR(StrInfo);
- END;
- StrInfo.buffer := ADR(Find);
- StrInfo.maxChars := 80;
- win := OpenWindow(NuWindow^);
- IF win=NIL THEN EXIT END;
- IF ActivateGadget(StrGadget,win,NIL) THEN END;
- WaitPort(win^.userPort);
- CloseWindow(win);
- Screen^.height := Screen^.height DIV 2;
- END;
- ClearBitMaps();
- flen := 0;
- LOOP
- FindStr[flen] := CAP(Find[flen]);
- IF FindStr[flen]>200C THEN DEC(FindStr[flen],32)
- ELSIF FindStr[flen]=0C THEN EXIT END;
- INC(flen);
- END;
- found := f;
- IF flen#0 THEN
- BottomLine := TopLine;
- LOOP
- IF Search() THEN EXIT END;
- IF TryBottomnext() THEN END;
- BottomLine := BottomLine^.next;
- IF BottomLine=NIL THEN EXIT END;
- END;
- ELSE
- BottomLine := NIL;
- END;
- ChkBotNewDisp |
-
- 19H: (* find previous *)
- IF FindStr[0]#0C THEN
- ClearBitMaps();
- BottomLine := TopLine;
- IF BottomLine^.prev#NIL THEN BottomLine:=BottomLine^.prev END;
- found := f;
- REPEAT
- BottomLine := BottomLine^.prev
- UNTIL Search() OR (BottomLine=NIL);
- ChkBotNewDisp
- END |
-
- 18H: IF Shift AND Alt AND NOT print THEN (* Printout *)
- PStr := "TYPE "; Append(PStr,Name); Append(PStr," TO PRT:");
- WaitAllRead; print := w; Signal(Me,LONGSET{mySig});
- END |
-
- 5FH,25H: ClearBitMaps(); Write(empty,w);
- Write(title,w);
- Write(underln,w);
- Write(empty,w);
- Write("Commands:",w);
- Write(empty,w);
- Write(" Space, LMB: Start / Stop scrolling. Quit at end of file.",w);
- Write(" BackSpace, RMB: Start / Stop scrolling backwards.",w);
- Write(" Up/Down: Move one line up or down.",w);
- Write(" Shift + Up/Down: Start / Stop quick scrolling up or down.",w);
- Write(" Alt + Up/Dwn: Move one page up or down.",w);
- Write(" PgUp/PgDn: Move one page up or down.",w);
- Write(" T, Home: Jump to top of text.",w);
- Write(" B, End: Jump to bottom of text.",w);
- Write(" NK 0: Display Filelength etc.",w);
- Write(" F: Find string.",w);
- Write(" N: Jump to next occurance of string.",w);
- Write(" P: Jump to previous occurance of string.",w);
- Write(" Shift + Alt + O: Create printout of the text",w);
- Write(" HELP, H: Show Commands.",w);
- Write(" ESC, Q, X, NK 5: Quit.",w);
- Write(empty,w);
- Write(address,w);
- Write(empty,w);
- LOOP
- WaitPort(Window^.userPort);
- MyMsgPtr := ADDRESS(GetMsg(Window^.userPort));
- IF (rawKey IN MyMsgPtr^.class) AND (MyMsgPtr^.code<128) THEN EXIT END;
- ReplyMsg(MyMsgPtr);
- END;
- ReplyMsg(MyMsgPtr);
- BottomLine := TopLine;
- NewDisplay |
-
- 10H,45H,32H,2EH: EXIT | (* ESC, Q, X, NK 5 *)
-
- ELSE END; (* CASE code OF *)
- END; (* IF class=IDCMPFlagSet{rawKey} THEN *)
- END; (* WITH MyMsg DO *)
- END; (* IF MyMsgPtr#NIL THEN *)
- END; (* LOOP *)
-
- Done := w;
- Signal(Me,LONGSET{mySig});
- WHILE w OR (1 IN Wait(LONGSET{})) DO END;
-
- END ShowProc;
-
- (*------ Usage: ------*)
-
- PROCEDURE Usage;
-
- BEGIN
- Write(title,f); Write(underln,f); Write(empty,f);
- Write("A soft-scrolling ASCII-File-Printer.",f); Write(empty,f);
- Write("Usage: ",f); Write(empty,f);
- Write(" MuchMore <FileName>",f); Write(empty,f);
- Write("To start from Workbench click text to print before",f); Write(empty,f);
- Write("shift-doubleclicking MuchMore. ",f); Write(empty,f);
- Write("Texts with MuchMore as their default-tool just have to be doubleclicked",f); Write(empty,f);
- Write("This can be run on NTSC as well as on PAL Amigas.",f); Write(empty,f);
- Write(address,f);
- Write("MuchMore is free to be spread on PD or Shareware Disks, with the limitations",f);
- Write("described in MuchMore.ReadMe.",f);
- Write("It's illegal to make comercial use of MuchMore without my written permission!",f);
- Write(empty,f);
- WaitPort(Window^.userPort);
- Terminate(0);
- END Usage;
-
- (*------ CleanUp: ------*)
-
- PROCEDURE CleanUp();
-
- VAR t: TextLinePtr;
-
- BEGIN
- IF ShowTaskRunning THEN RemTask(ADR(ShowTask)) END;
- IF Window#NIL THEN CloseWindow(Window) END;
- IF Screen#NIL THEN CloseScreen(Screen) END;
- IF MyFile#NIL THEN Close(MyFile) END;
- WHILE FirstLine#NIL DO
- t := FirstLine;
- FirstLine := FirstLine^.next;
- FreeMem(t,SIZE(TextLine)-MaxLen+t^.size);
- END;
- IF MyLock#NIL THEN UnLock(MyLock) END;
- IF OldDir#NIL THEN OldDir := CurrentDir(OldDir) END;
- IF FileInfo#NIL THEN FreeMem(FileInfo,SIZE(FileInfo^)) END;
- IF mySig#-1 THEN FreeSignal(mySig) END;
- END CleanUp;
-
- (*------------------------------ 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; TextLength := 0; ScreenPos := 0;
- ShowTaskRunning := f; SignalNewData := f; SignalAllRead := f;
- Done := f; print := f; bg := 0; style := StyleSet{}; OldDir := NIL;
- *)
- mySig := -1; Me := FindTask(0); Gfxbase := ADR(Graphics); fg := 1;
-
- TermProcedure(CleanUp);
-
- (*------ Setup: ------*)
-
- InitScreen();
- FirstLine := Alloc(SIZE(TextLine)-MaxLen);
- FirstLine^.size := 0;
- FirstLine^.text[0] := 0C;
- LastLine := FirstLine;
- BottomLine := FirstLine;
- TopLine := FirstLine;
- AnzLines := 1;
- FileInfo := Alloc(SIZE(FileInfo^));
-
- (*------ Start: ------*)
-
- WBSt:= startupMsg;
- IF wbStarted THEN
-
- WITH WBSt^ DO
- IF numArgs=2 THEN
- ArgPtr := argList^[1].name; Name := ArgPtr^;
- OldDir := CurrentDir(argList^[1].lock);
- ELSE Usage END
- END;
-
- ELSE
-
- IF dosCmdLen<=1 THEN Usage END;
- CommLine:=dosCmdBuf; i:=0; j:=0;
- WHILE CommLine^=" " DO INC(CommLine); INC(j) END;
- WHILE (i+j<dosCmdLen) AND (CommLine^#12C) DO
- Name[i] := CommLine^; INC(i); INC(CommLine);
- END;
- Name[i]:= 0C;
-
- END;
-
- MyFile := Open(ADR(Name),oldFile);
- Assert(MyFile#NIL,ADR(cof));
- RQPos := -1; RQLen := -1;
-
- MyLock := Lock(ADR(Name),sharedLock);
- Assert(MyLock#NIL,ADR(cof));
- Assert(Examine(MyLock,FileInfo),ADR(cof));
- FileLength := FileInfo^.size;
-
- UnLock(MyLock); MyLock := NIL;
- IF FileLength=0 THEN Terminate(0) END;
-
- mySig := AllocSignal(-1);
- IF mySig<0 THEN Terminate(0) END;
-
- WITH ShowTask DO
- spLower := ADR(ShowStack);
- spUpper := ADR(ShowStack[3996]);
- spReg := spUpper;
- node.type := task;
- node.name := ADR("Show.MM");
- node.pri := Me^.node.pri + 1;
- END;
- Forbid();
- Window^.userPort^.sigTask := ADR(ShowTask);
- AddTask(ADR(ShowTask),ADR(ShowProc),NIL);
- ShowTaskRunning := w;
- Permit();
-
- i := 0;
- REPEAT
- INC(i);
- IF i=20 THEN
- Assert(AvailMem(MemReqSet{chip,largest})>10000,ADR(oom));
- i := 0;
- END;
- LoadLine := GetTextLine();
- IF LoadLine=NIL THEN
- Close(MyFile);
- MyFile := NIL;
- ELSE
- LoadLine^.prev := LastLine;
- Forbid();
- LastLine^.next := LoadLine;
- LastLine := LoadLine;
- Permit;
- END;
- IF SignalNewData THEN Signal(ADR(ShowTask),LONGSET{mySig}) END;
- UNTIL (MyFile=NIL) OR Done;
- IF SignalAllRead THEN Signal(ADR(ShowTask),LONGSET{mySig}) END;
- REPEAT
- REPEAT UNTIL mySig IN Wait(LONGSET{mySig});
- IF print THEN
- nili := Open(ADR(nil),oldFile); nilo := Open(ADR(nil),newFile);
- SETREG(0,Execute(ADR(PStr),nili,nilo)); Close(nili); Close(nilo); print := f;
- END;
- UNTIL Done;
-
- END MuchMore.
-
-