home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 296.lha / MuchMore_v1.8 / MuchMore.mod < prev    next >
Encoding:
Text File  |  1989-10-09  |  43.6 KB  |  1,267 lines

  1. (*---------------------------------------------------------------------------
  2.   :Program.    MuchMore.mod
  3.   :Author.     Fridtjof Siebert
  4.   :Address.    Nobileweg 67, D-7000-Stuttgart-40
  5.   :Phone.      (0)711/822509
  6.   :Shortcut.   [fbs]
  7.   :Version.    1.8
  8.   :Copyright.  PD
  9.   :Language.   Modula-II
  10.   :Translator. M2Amiga v3.2d
  11.   :History.    24-Sep-88: First published version                        [fbs]
  12.   :History.    26-Nov-88: Now Shows Filelength & Percentage              [fbs]
  13.   :History.    27-Nov-88: Mouse can be used instead of Space / BackSpace [fbs]
  14.   :History.    29-Apr-89: Strong increase in speed, removed WarpText     [fbs]
  15.   :History.    29-Apr-89: Now supports Numeric Keys (Home,PgUp etc.)     [fbs]
  16.   :History.    29-Apr-89: Now opens Screen as big as gfx^.normalDisplay  [fbs]
  17.   :History.    29/30-Apr-89: Asynchronus loading / displaying. Very nice [fbs]
  18.   :History.    30-Apr-89, 00:33: Removed bugs in Filelength & L-Command  [fbs]
  19.   :History.    30-Apr-89, 02:21: Added Find-Command                      [fbs]
  20.   :History.    30-Apr-89, 10:30: Scrolling stops when window is inactive [fbs]
  21.   :History.    01-May-89: Allocates no more unneeded memory for text     [fbs]
  22.   :History.    07-May-89: Allocates even less memory now                 [fbs]
  23.   :History.    14-May-89: Removed deadlock-bug with Find-Window          [fbs]
  24.   :History.    25-May-89: Added print feature                            [fbs]
  25.   :History.    25-May-89: Removed all imports (apart from Arts)          [fbs]
  26.   :History.    26-May-89: inspired by J. Kupfer, I added nk 5 to quit    [fbs]
  27.   :History.    26-May-89: Now handle BS correctly                        [fbs]
  28.   :History.    02-Jul-89: Now supports several fontstyles and colors     [fbs]
  29.   :History.    03-Jul-89: Is again as fast as it was with 2 colors       [fbs]
  30.   :History.    03-Jul-89: Now no more crashes when quitting while print  [fbs]
  31.   :History.    07-Jul-89: removed bug with texts of length 0             [fbs]
  32.   :History.    10-Jul-89: small bug in find-command removed              [fbs]
  33.   :History.    10-Jul-89: now found strings are highlighted              [fbs]
  34.   :History.    14-Jul-89: nk0 to display fileinfo                        [fbs]
  35.   :Contents.   A Soft-Scrolling ASCII-File Printer.
  36.   :Usage.      Usage: MuchMore <FileName>
  37.   :Remark.     Grüße an alle, die gerade bei der Post jobben!
  38. ---------------------------------------------------------------------------*)
  39.  
  40. MODULE MuchMore; (* $F- $V- $R- $S- I hope that there are no more bugs ! *)
  41.  
  42. FROM SYSTEM     IMPORT ADR, ADDRESS, LONGSET, INLINE, SETREG;
  43. FROM Arts       IMPORT TermProcedure, Assert, dosCmdBuf, startupMsg, wbStarted,
  44.                        Terminate, dosCmdLen;
  45. FROM Dos        IMPORT Open, Close, oldFile, Read, FileHandlePtr, FileLockPtr,
  46.                        FileInfoBlockPtr, Lock, UnLock, Examine, sharedLock,
  47.                        Execute, newFile, Delay, ParentDir, CurrentDir;
  48. FROM Exec       IMPORT GetMsg, ReplyMsg, MessagePtr, WaitPort, AllocMem,
  49.                        FreeMem, MemReqSet, MemReqs, Task, AddTask, RemTask,
  50.                        task, Forbid, Permit, TaskPtr, FindTask, Wait, Signal,
  51.                        AllocSignal, FreeSignal, AvailMem;
  52. FROM Graphics   IMPORT ViewModes, ViewModeSet, FontStyleSet, FontFlagSet, TextAttr,
  53.                        BltClear, OpenFont, CloseFont, TextFontPtr, GfxBase, BitMapPtr;
  54. FROM InputEvent IMPORT Qualifiers, QualifierSet;
  55. FROM Intuition  IMPORT NewScreen, ScreenFlags, ScreenFlagSet, customScreen,
  56.                        OpenScreen, CloseScreen, MakeScreen, RethinkDisplay,
  57.                        ScreenPtr, NewWindow, WindowFlags, WindowFlagSet,
  58.                        IDCMPFlags, IDCMPFlagSet, OpenWindow, CloseWindow,
  59.                        WindowPtr, IntuiMessage, IntuiMessagePtr, GadgetPtr,
  60.                        StringInfo, GadgetFlags, GadgetFlagSet, ActivationFlags,
  61.                        ActivationFlagSet, strGadget, ActivateGadget, DisplayBeep,
  62.                        ActivateWindow;
  63. FROM Hardware   IMPORT custom;
  64. FROM Workbench  IMPORT WBStartupPtr;
  65. IMPORT Graphics;
  66.  
  67. (*-------------------------------------------------------------------------*)
  68.  
  69. CONST
  70.   title   = "                       MuchMore 1.8";
  71.   underln = "                    ==================";
  72.   address = "© 1989 Fridtjof Siebert, Nobileweg 67, D-7000-Stuttgart-40";
  73.   empty = "";
  74.   oom = "Out of memory!";
  75.   cof = "Can't open file!";
  76.   nil = "NIL:";
  77.   w = TRUE;
  78.   f = FALSE;
  79.   MaxLen = 256;
  80.  
  81. (* Control codes for QText: *)
  82.   plain    = CHAR(17);
  83.   italic   = CHAR(18);
  84.   bold     = CHAR(19);
  85.   boldit   = CHAR(20);
  86.   ulineon  = CHAR(21);
  87.   ulineoff = CHAR(22);
  88.  
  89. TYPE
  90.   TextLinePtr = POINTER TO TextLine;
  91.   TextLine = RECORD
  92.                next: TextLinePtr;
  93.                prev: TextLinePtr;
  94.                len:  INTEGER;
  95.                size: INTEGER;
  96.                text: ARRAY[0..MaxLen] OF CHAR;
  97.              END;
  98.   LONG = LONGINT;
  99.   String = ARRAY [0..255] OF CHAR;
  100.   FontData = ARRAY [0..7] OF ARRAY [0..191] OF ARRAY[0..7] OF CHAR;
  101.   FontDataPtr = POINTER TO FontData;
  102.   StyleSet = SET OF (Italic,Bold,Ulin,Inv);
  103.  
  104. VAR
  105.   Screen: ScreenPtr;           (* Screen that contains the Text     *)
  106.   BM: BitMapPtr;               (* Screen's BitMap                   *)
  107.   Window: WindowPtr;
  108.   MyFont: TextAttr;
  109.   MyFile: FileHandlePtr;       (* For loading Textfile              *)
  110.   FirstLine: TextLinePtr;      (* Saved Text                        *)
  111.   TopLine: TextLinePtr;        (* Points to topmost Line            *)
  112.   BottomLine: TextLinePtr;     (* Last Line displayed on Screen     *)
  113.   LoadLine: TextLinePtr;       (* currently loaded Line             *)
  114.   LastLine: TextLinePtr;       (* Last element of LineList          *)
  115.   Name,IStr,PStr: String;(* Text's Name                       *)
  116.   Buffer: ARRAY[0..511] OF CHAR; (* Buffer for Reading              *)
  117.   RQPos: LONG;                 (* Position within ReadBuffer        *)
  118.   RQLen: LONG;                 (* Number of CHARs in Buffer         *)
  119.   NumLines: INTEGER;           (* Number of Lines on Screen         *)
  120.   NumColumns: INTEGER;         (* Number of Columns on Screen       *)
  121.   AnzLines: LONG;              (* Length of Text in Lines           *)
  122.   Font: TextFontPtr;           (* used Font                         *)
  123.   fontdata: FontData;          (* Fonts used by QText()             *)
  124.   MyLock,OldDir: FileLockPtr;
  125.   FileInfo: FileInfoBlockPtr;
  126.   FileLength, TextLength: LONG;(* Length of File and of Displayed Text *)
  127.   Gfxbase: POINTER TO GfxBase; (* Graphics                          *)
  128.   ScreenPos: INTEGER;          (* actual position within bitmap     *)
  129.   ShowTask: Task;              (* the task that displays the text   *)
  130.   ShowStack: ARRAY [0..3999] OF CHAR;  (* it's stack                *)
  131.   ShowTaskRunning: BOOLEAN;    (* is Showtask activated?            *)
  132.   mySig: INTEGER;              (* My SignalBit                      *)
  133.   SignalNewData,SignalAllRead,Done,print: BOOLEAN; (* Action to be done when signal arrives *)
  134.   Me: TaskPtr;
  135.   Info: BOOLEAN;               (* currently displaying info-Line ?  *)
  136.   MyMsgPtr: IntuiMessagePtr;   (* for receiving Messages            *)
  137.   i,j: INTEGER;                (* count                             *)
  138.   Scroll: BOOLEAN;             (* scrolling or waiting?             *)
  139.   Fast: BOOLEAN;               (* scrollquick?                      *)
  140.   nili,nilo: FileHandlePtr;    (* i/o for TYPE xxx TO PRT:          *)
  141.   fg,bg: INTEGER;              (* Text colors                       *)
  142.   style: StyleSet;             (* Text style                        *)
  143.   WBSt: WBStartupPtr;          (* Our WBMsg                         *)
  144.   CommLine: POINTER TO CHAR;   (* The CLI-commands                  *)
  145.   ArgPtr: POINTER TO String;   (* to get WBArg                      *)
  146.   NuScreen: NewScreen;
  147.   NuWindow: NewWindow;
  148.  
  149. (*-------------------------------------------------------------------------*)
  150.  
  151. PROCEDURE Alloc(size: LONG): ADDRESS;
  152.  
  153. VAR a: ADDRESS;
  154.  
  155. BEGIN
  156.   a := AllocMem(size,MemReqSet{memClear});
  157.   Assert(a#NIL,ADR(oom));
  158.   RETURN a;
  159. END Alloc;
  160.  
  161.  
  162. PROCEDURE Length(VAR s: ARRAY OF CHAR): INTEGER;
  163. VAR l: INTEGER;
  164. BEGIN l := 0; WHILE (l<=HIGH(s)) AND (s[l]#0C) DO INC(l) END; RETURN l;
  165. END Length;
  166.  
  167.  
  168. PROCEDURE Append(VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
  169. (* appends s2 to s1 *)
  170. VAR p,q: INTEGER;
  171. BEGIN
  172.   p := Length(s1); q := 0;
  173.   WHILE (p<=HIGH(s1)) AND (q<=HIGH(s2)) AND (p<NumColumns) DO
  174.     s1[p] := s2[q]; INC(p); INC(q)
  175.   END;
  176.   IF p<=HIGH(s1) THEN s1[p] := 0C END;
  177. END Append;
  178.  
  179. (*------  The fastest textoutput-Procedure in the world (maybe):  ------*)
  180.  
  181. PROCEDURE QText(y{1}: INTEGER;
  182.                 str{8}: ADDRESS;
  183.                 bm{9}: BitMapPtr;
  184.                 fd{10}: FontDataPtr);
  185.  
  186. BEGIN
  187. INLINE(
  188. (*0000*) 02F0DH,04BFAH,001FEH,04244H,051C6H,050C7H,03429H,00000H,
  189. (*0010*) 048C2H,0C2C2H,02869H,0000CH,02269H,00008H,0D3C1H,0D9C1H,
  190. (*0020*) 02649H,02C4CH,03202H,05341H,0429BH,0429BH,0429EH,0429EH,
  191. (*0030*) 051C9H,0FFF6H,03202H,0E741H,09242H,01018H,06700H,00500H,
  192. (*0040*) 0B03CH,00020H,06400H,00100H,0B03CH,00011H,06D00H,00028H,
  193. (*0050*) 0B03CH,00016H,0B03CH,00015H,06D00H,00008H,057C6H,056C7H,
  194. (*0060*) 060D8H,062D6H,0903CH,00011H,04880H,03800H,0E344H,0D840H,
  195. (*0070*) 0E144H,0D844H,060C4H,05300H,06600H,00008H,04BFAH,000DEH,
  196. (*0080*) 060B8H,05300H,06600H,00008H,04BFAH,000D6H,060ACH,05300H,
  197. (*0090*) 06600H,00008H,04BFAH,000F0H,060A0H,05300H,06600H,00008H,
  198. (*00A0*) 04BFAH,0010AH,06094H,05300H,06600H,00008H,04BFAH,00154H,
  199. (*00B0*) 06088H,05300H,06600H,0000AH,04BFAH,0016EH,06000H,0FF7CH,
  200. (*00C0*) 05300H,06600H,0000AH,04BFAH,00190H,06000H,0FF6EH,05300H,
  201. (*00D0*) 06600H,0000AH,04BFAH,001D8H,06000H,0FF60H,05300H,06600H,
  202. (*00E0*) 0000AH,04BFAH,0021CH,06000H,0FF52H,05300H,06600H,0000AH,
  203. (*00F0*) 04BFAH,00234H,06000H,0FF44H,05300H,06600H,0000AH,04BFAH,
  204. (*0100*) 0027CH,06000H,0FF36H,05300H,06600H,0000AH,04BFAH,00292H,
  205. (*0110*) 06000H,0FF28H,05300H,06600H,0000AH,04BFAH,002D6H,06000H,
  206. (*0120*) 0FF1AH,05300H,06600H,0000AH,04BFAH,0031EH,06000H,0FF0CH,
  207. (*0130*) 05300H,06600H,0000AH,04BFAH,00362H,06000H,0FEFEH,04BFAH,
  208. (*0140*) 003ACH,06000H,0FEF6H,0903CH,00020H,0C07CH,000FFH,0E740H,
  209. (*0150*) 0D044H,047F2H,00000H,04DEBH,01800H,04ED5H,06000H,003D8H,
  210. (*0160*) 0129EH,0D2C2H,0129EH,0D2C2H,0129EH,0D2C2H,0129EH,0D2C2H,
  211. (*0170*) 0129EH,0D2C2H,0129EH,0D2C2H,0129EH,0D2C2H,0129EH,0CF11H,
  212. (*0180*) 092C1H,06000H,003B2H,0189EH,0D8C2H,0189EH,0D8C2H,0189EH,
  213. (*0190*) 0D8C2H,0189EH,0D8C2H,0189EH,0D8C2H,0189EH,0D8C2H,0189EH,
  214. (*01A0*) 0D8C2H,0189EH,0CF14H,098C1H,06000H,0038CH,01296H,0189EH,
  215. (*01B0*) 03A02H,01396H,05000H,0199EH,05000H,0DA42H,01396H,05000H,
  216. (*01C0*) 0199EH,05000H,0DA42H,01396H,05000H,0199EH,05000H,0DA42H,
  217. (*01D0*) 01396H,05000H,0199EH,05000H,0DA42H,01396H,05000H,0199EH,
  218. (*01E0*) 05000H,0DA42H,01396H,05000H,0199EH,05000H,0DA42H,01396H,
  219. (*01F0*) 05000H,0199EH,05000H,0CF31H,05000H,0CF34H,05000H,06000H,
  220. (*0200*) 00336H,0129BH,0D2C2H,0129BH,0D2C2H,0129BH,0D2C2H,0129BH,
  221. (*0210*) 0D2C2H,0129BH,0D2C2H,0129BH,0D2C2H,0129BH,0D2C2H,0129BH,
  222. (*0220*) 08D11H,092C1H,06000H,00310H,050D1H,03A02H,050F1H,05000H,
  223. (*0230*) 0DA42H,050F1H,05000H,0DA42H,050F1H,05000H,0DA42H,050F1H,
  224. (*0240*) 05000H,0DA42H,050F1H,05000H,0DA42H,050F1H,05000H,0DA42H,
  225. (*0250*) 050F1H,05000H,06000H,002E0H,0129BH,0189EH,03A02H,0139BH,
  226. (*0260*) 05000H,0199EH,05000H,0DA42H,0139BH,05000H,0199EH,05000H,
  227. (*0270*) 0DA42H,0139BH,05000H,0199EH,05000H,0DA42H,0139BH,05000H,
  228. (*0280*) 0199EH,05000H,0DA42H,0139BH,05000H,0199EH,05000H,0DA42H,
  229. (*0290*) 0139BH,05000H,0199EH,05000H,0DA42H,0139BH,05000H,0199EH,
  230. (*02A0*) 05000H,08D31H,05000H,0CF34H,05000H,06000H,0028AH,050D1H,
  231. (*02B0*) 0189EH,03A02H,050F1H,05000H,0199EH,05000H,0DA42H,050F1H,
  232. (*02C0*) 05000H,0199EH,05000H,0DA42H,050F1H,05000H,0199EH,05000H,
  233. (*02D0*) 0DA42H,050F1H,05000H,0199EH,05000H,0DA42H,050F1H,05000H,
  234. (*02E0*) 0199EH,05000H,0DA42H,050F1H,05000H,0199EH,05000H,0DA42H,
  235. (*02F0*) 050F1H,05000H,0199EH,05000H,0CF34H,05000H,06000H,00238H,
  236. (*0300*) 0189BH,0D8C2H,0189BH,0D8C2H,0189BH,0D8C2H,0189BH,0D8C2H,
  237. (*0310*) 0189BH,0D8C2H,0189BH,0D8C2H,0189BH,0D8C2H,0189BH,08D14H,
  238. (*0320*) 098C1H,06000H,00212H,0129EH,0189BH,03A02H,0139EH,05000H,
  239. (*0330*) 0199BH,05000H,0DA42H,0139EH,05000H,0199BH,05000H,0DA42H,
  240. (*0340*) 0139EH,05000H,0199BH,05000H,0DA42H,0139EH,05000H,0199BH,
  241. (*0350*) 05000H,0DA42H,0139EH,05000H,0199BH,05000H,0DA42H,0139EH,
  242. (*0360*) 05000H,0199BH,05000H,0DA42H,0139EH,05000H,0199BH,05000H,
  243. (*0370*) 0CF31H,05000H,08D34H,05000H,06000H,001BCH,050D4H,0D8C2H,
  244. (*0380*) 050D4H,0D8C2H,050D4H,0D8C2H,050D4H,0D8C2H,050D4H,0D8C2H,
  245. (*0390*) 050D4H,0D8C2H,050D4H,0D8C2H,050D4H,098C1H,06000H,00198H,
  246. (*03A0*) 0129EH,050D4H,03A02H,0139EH,05000H,050F4H,05000H,0DA42H,
  247. (*03B0*) 0139EH,05000H,050F4H,05000H,0DA42H,0139EH,05000H,050F4H,
  248. (*03C0*) 05000H,0DA42H,0139EH,05000H,050F4H,05000H,0DA42H,0139EH,
  249. (*03D0*) 05000H,050F4H,05000H,0DA42H,0139EH,05000H,050F4H,05000H,
  250. (*03E0*) 0DA42H,0139EH,05000H,050F4H,05000H,0CF31H,05000H,06000H,
  251. (*03F0*) 00146H,01293H,0189BH,03A02H,01393H,05000H,0199BH,05000H,
  252. (*0400*) 0DA42H,01393H,05000H,0199BH,05000H,0DA42H,01393H,05000H,
  253. (*0410*) 0199BH,05000H,0DA42H,01393H,05000H,0199BH,05000H,0DA42H,
  254. (*0420*) 01393H,05000H,0199BH,05000H,0DA42H,01393H,05000H,0199BH,
  255. (*0430*) 05000H,0DA42H,01393H,05000H,0199BH,05000H,08D31H,05000H,
  256. (*0440*) 08D34H,05000H,06000H,000F0H,050D1H,0189BH,03A02H,050F1H,
  257. (*0450*) 05000H,0199BH,05000H,0DA42H,050F1H,05000H,0199BH,05000H,
  258. (*0460*) 0DA42H,050F1H,05000H,0199BH,05000H,0DA42H,050F1H,05000H,
  259. (*0470*) 0199BH,05000H,0DA42H,050F1H,05000H,0199BH,05000H,0DA42H,
  260. (*0480*) 050F1H,05000H,0199BH,05000H,0DA42H,050F1H,05000H,0199BH,
  261. (*0490*) 05000H,08D34H,05000H,06000H,0009EH,0129BH,050D4H,03A02H,
  262. (*04A0*) 0139BH,05000H,050F4H,05000H,0DA42H,0139BH,05000H,050F4H,
  263. (*04B0*) 05000H,0DA42H,0139BH,05000H,050F4H,05000H,0DA42H,0139BH,
  264. (*04C0*) 05000H,050F4H,05000H,0DA42H,0139BH,05000H,050F4H,05000H,
  265. (*04D0*) 0DA42H,0139BH,05000H,050F4H,05000H,0DA42H,0139BH,05000H,
  266. (*04E0*) 050F4H,05000H,08D31H,05000H,06000H,0004CH,050D1H,050D4H,
  267. (*04F0*) 03A02H,050F1H,05000H,050F4H,05000H,0DA42H,050F1H,05000H,
  268. (*0500*) 050F4H,05000H,0DA42H,050F1H,05000H,050F4H,05000H,0DA42H,
  269. (*0510*) 050F1H,05000H,050F4H,05000H,0DA42H,050F1H,05000H,050F4H,
  270. (*0520*) 05000H,0DA42H,050F1H,05000H,050F4H,05000H,0DA42H,050F1H,
  271. (*0530*) 05000H,050F4H,05000H,05249H,0524CH,06000H,0FAFEH,02A5FH);
  272. END QText;
  273.  
  274. (*------  Copy Line:  ------*)
  275.  
  276. PROCEDURE CopyLine1(BM{8}: BitMapPtr; w{0},h{1},pos{2}: INTEGER);
  277.  
  278. BEGIN
  279. INLINE(
  280. (*0000*) 02668H,00008H,02868H,0000CH,0E740H,0C5C0H,047F3H,02000H,
  281. (*0010*) 049F4H,02000H,0C3C0H,043F3H,01000H,045F4H,01000H,0E440H,
  282. (*0020*) 05340H,026D9H,028DAH,051C8H,0FFFAH);
  283. END CopyLine1;
  284.  
  285.  
  286. PROCEDURE CopyLine2(BM{8}: BitMapPtr; w{0},h{1},pos{2}: INTEGER);
  287.  
  288. BEGIN
  289. INLINE(
  290. (*0000*) 02668H,00008H,02868H,0000CH,0E740H,0C5C0H,047F3H,02000H,
  291. (*0010*) 049F4H,02000H,0C3C0H,043F3H,01000H,045F4H,01000H,0E440H,
  292. (*0020*) 05340H,022DBH,024DCH,051C8H,0FFFAH);
  293. END CopyLine2;
  294.  
  295. (*------  Get Fonts:  ------*)
  296.  
  297. PROCEDURE GetFontData(from{8},to{9}: ADDRESS);
  298.  
  299. BEGIN
  300. INLINE(
  301. (*0000*) 0303CH,000BFH,03200H,0E741H,03A01H,03C01H,03E01H,0DA7CH,
  302. (*0010*) 00600H,0DC7CH,00C00H,0DE7CH,01200H,045F0H,00000H,01412H,
  303. (*0020*) 01382H,01000H,01602H,0E40BH,06400H,00006H,008C3H,00000H,
  304. (*0030*) 01383H,05000H,01802H,0E20CH,08802H,01384H,06000H,01803H,
  305. (*0040*) 0E20CH,08803H,01384H,07000H,0D4FCH,000C0H,01412H,01382H,
  306. (*0050*) 01001H,01602H,0E40BH,06400H,00006H,008C3H,00000H,01383H,
  307. (*0060*) 05001H,01802H,0E20CH,08802H,01384H,06001H,01803H,0E20CH,
  308. (*0070*) 08803H,01384H,07001H,0D4FCH,000C0H,01412H,01382H,01002H,
  309. (*0080*) 01602H,0E20BH,06400H,00006H,008C3H,00000H,01383H,05002H,
  310. (*0090*) 01802H,0E20CH,08802H,01384H,06002H,01803H,0E20CH,08803H,
  311. (*00A0*) 01384H,07002H,0D4FCH,000C0H,01412H,01382H,01003H,01602H,
  312. (*00B0*) 0E20BH,06400H,00006H,008C3H,00000H,01383H,05003H,01802H,
  313. (*00C0*) 0E20CH,08802H,01384H,06003H,01803H,0E20CH,08803H,01384H,
  314. (*00D0*) 07003H,0D4FCH,000C0H,01412H,01382H,01004H,01382H,05004H,
  315. (*00E0*) 01802H,0E20CH,08802H,01384H,06004H,01384H,07004H,0D4FCH,
  316. (*00F0*) 000C0H,01412H,01382H,01005H,01382H,05005H,01802H,0E20CH,
  317. (*0100*) 08802H,01384H,06005H,01384H,07005H,0D4FCH,000C0H,01412H,
  318. (*0110*) 01382H,01006H,01602H,0E30BH,06400H,00006H,008C3H,00007H,
  319. (*0120*) 01383H,05006H,01802H,0E20CH,08802H,01384H,06006H,01803H,
  320. (*0130*) 0E20CH,08803H,01384H,07006H,0D4FCH,000C0H,01412H,01382H,
  321. (*0140*) 01007H,01602H,0E30BH,06400H,00006H,008C3H,00007H,01383H,
  322. (*0150*) 05007H,01802H,0E20CH,08802H,01384H,06007H,01803H,0E20CH,
  323. (*0160*) 08803H,01384H,07007H,051C8H,0FE9CH,02449H,0D4FCH,01800H,
  324. (*0170*) 0303CH,005FFH,02419H,04682H,024C2H,051C8H,0FFF8H);
  325. END GetFontData;
  326.  
  327. (*------------------------  Open Display:  --------------------------------*)
  328.  
  329. PROCEDURE InitScreen();
  330.  
  331. BEGIN
  332.  
  333. (*------  Get Font:  ------*)
  334.  
  335.   WITH MyFont DO
  336.     name := ADR("topaz.font");
  337.     ySize := 8;
  338.   END;
  339.   Font := OpenFont(ADR(MyFont));
  340.   GetFontData(Font^.charData,ADR(fontdata));
  341.   CloseFont(Font);
  342.  
  343. (*------  Open Screen:  ------*)
  344.  
  345.   NumColumns := Gfxbase^.normalDisplayColumns DIV 32 * 4;
  346.   IF NumColumns>MaxLen THEN NumColumns := MaxLen END;
  347.   NuScreen.width        := 8*NumColumns;
  348.   NumLines := Gfxbase^.normalDisplayRows DIV 8;
  349.   NuScreen.height       := 16*NumLines;
  350.   NuScreen.depth        := 2;
  351.   NuScreen.viewModes    := ViewModeSet{hires};
  352.   NuScreen.type         := customScreen+ScreenFlagSet{screenQuiet};
  353.   Screen := OpenScreen(NuScreen);
  354.   Assert(Screen#NIL,ADR(oom));
  355.   BM := Screen^.rastPort.bitMap;
  356.   Screen^.height := Screen^.height DIV 2;
  357.   MakeScreen(Screen); RethinkDisplay();
  358.  
  359. (*------  Open Window:  ------*)
  360.  
  361.   NuWindow.topEdge := 10;
  362.   NuWindow.width   := NumColumns*8;
  363.   NuWindow.height  := Screen^.height-10;
  364.   NuWindow.idcmpFlags := IDCMPFlagSet{inactiveWindow,mouseButtons,rawKey};
  365.   NuWindow.flags   := WindowFlagSet{activate};
  366.   NuWindow.screen  := Screen;
  367.   NuWindow.type    := customScreen;
  368.   Window := OpenWindow(NuWindow);
  369.   Assert(Window#NIL,ADR(oom));
  370.  
  371. END InitScreen;
  372.  
  373. (*------  Read one TextLine into a Variable:  ------*)
  374.  
  375. PROCEDURE GetTextLine(): TextLinePtr;
  376. (* returns NIL at EOF *)
  377.  
  378. VAR
  379.   l: TextLinePtr;
  380.   sz,wd,le,i,j: INTEGER;
  381.   c: CHAR;
  382.   txt: ARRAY[0..MaxLen] OF CHAR;
  383.   num: ARRAY [0..9] OF LONGINT;
  384.   newcol: BOOLEAN;
  385.   oldstyle: StyleSet;
  386.  
  387.   PROCEDURE GetCh();
  388.  
  389.   BEGIN
  390.     IF RQPos=RQLen THEN
  391.       RQLen := Read(MyFile,ADR(Buffer),SIZE(Buffer));
  392.       RQPos := 0;
  393.     END;
  394.     IF RQLen=0 THEN c := 0C ELSE
  395.       c := Buffer[RQPos]; IF c=0C THEN c:=1C END;
  396.       INC(RQPos); INC(le);
  397.     END;
  398.   END GetCh;
  399.  
  400. BEGIN
  401.   IF RQLen=0 THEN RETURN NIL END;
  402.   sz := 0; wd := 0; le := 0;
  403.   IF Italic IN style THEN
  404.     IF Bold IN style THEN txt[sz] := boldit ELSE txt[sz] := italic END; INC(sz);
  405.   ELSE
  406.     IF Bold IN style THEN txt[sz] := bold; INC(sz) END;
  407.   END;
  408.   IF Ulin IN style THEN txt[sz] := ulineon; INC(sz) END;
  409.   IF    Inv IN style     THEN txt[sz] := CHAR(fg+4*bg+1); INC(sz)
  410.   ELSIF (fg#1) OR (bg#0) THEN txt[sz] := CHAR(bg+4*fg+1); INC(sz) END;
  411.   REPEAT
  412.     LOOP
  413.       GetCh;
  414.       IF (c#33C) AND (c#233C) THEN EXIT END;
  415.       i := -1;
  416.       REPEAT
  417.         GetCh;
  418.         IF (c>="0") AND (c<="9") THEN
  419.           INC(i); num[i] := 0;
  420.           REPEAT
  421.             num[i] := 10*num[i]+ORD(c)-ORD("0"); GetCh;
  422.           UNTIL (c<"0") OR (c>"9");
  423.         END;
  424.         c := CAP(c);
  425.       UNTIL (c>="?") AND (c<="Z") OR (c=0C);
  426.       IF c="M" THEN
  427.         newcol := f; oldstyle := style; j := 0;
  428.         WHILE (i>=j) AND (sz<MaxLen-1) DO
  429.           CASE num[j] OF
  430.           0: style := StyleSet{}; fg := 1; bg := 0; newcol := w |
  431.           1: INCL(style,Bold) |
  432.           2: fg := 2; newcol := w (* I hope this is correct *) |
  433.           3: INCL(style,Italic) |
  434.           4: INCL(style,Ulin) |
  435.           7: INCL(style,Inv); newcol := w |
  436.           30..37: fg := (num[j]-30) MOD 4; newcol := w |
  437.           40..47: bg := (num[j]-40) MOD 4; newcol := w |
  438.           ELSE END;
  439.           INC(j);
  440.         END;
  441.         IF (oldstyle#style) AND (sz<MaxLen) THEN
  442.           IF Italic IN style THEN
  443.             IF Bold IN style THEN txt[sz] := boldit ELSE txt[sz] := italic END;
  444.           ELSE
  445.             IF Bold IN style THEN txt[sz] := bold   ELSE txt[sz] := plain  END;
  446.           END;
  447.           INC(sz);
  448.           IF ((Ulin IN style) # (Ulin IN oldstyle)) AND (sz<MaxLen) THEN
  449.             IF Ulin IN style THEN txt[sz] := ulineon ELSE txt[sz] := ulineoff END;
  450.             INC(sz);
  451.           END;
  452.         END;
  453.         IF newcol AND (sz<MaxLen) THEN
  454.           IF Inv IN style THEN txt[sz] := CHAR(fg+4*bg+1)
  455.                           ELSE txt[sz] := CHAR(bg+4*fg+1) END;
  456.           INC(sz);
  457.         END;
  458.       END;
  459.     END;
  460.     CASE c OF
  461.      40C..177C: txt[sz] := c; INC(sz); INC(wd) |
  462.     241C..377C: DEC(c,32); txt[sz] := c; INC(sz); INC(wd) |
  463.     10C: IF wd>0 THEN DEC(sz); DEC(wd); END |
  464.     11C:
  465.       REPEAT
  466.         txt[sz] := " "; INC(sz); INC(wd)
  467.       UNTIL (sz=MaxLen) OR (wd=NumColumns) OR (sz MOD 8 = 0) |
  468.     240C: txt[sz] := " "; INC(sz); INC(wd) |
  469.     ELSE END;
  470.   UNTIL (c=12C) OR (c=0C) OR (wd>=NumColumns) OR (sz>=MaxLen);
  471.   l := Alloc(SIZE(TextLine)-MaxLen+sz);
  472.   WITH l^ DO
  473.     len := le; size:= sz;
  474.     WHILE sz>0 DO DEC(sz); text[sz]:=txt[sz] END;
  475.   END;
  476.   RETURN l;
  477. END GetTextLine;
  478.  
  479. (*------  Write Line at Bottom of Text:  ------*)
  480.  
  481. PROCEDURE AddBottomLine(Line: TextLinePtr; Fast: BOOLEAN);
  482.  
  483. VAR
  484.   i,j: INTEGER;
  485.   trash: LONG;
  486.   s1,d1,s2,d2: POINTER TO LONG;
  487.   a,b: LONG;
  488.  
  489. BEGIN
  490.   WITH Screen^.viewPort.rasInfo^ DO
  491.     QText(8*(ScreenPos+NumLines),ADR(Line^.text),BM,ADR(fontdata));
  492.     IF Fast THEN
  493.       INC(ryOffset,8); MakeScreen(Screen); RethinkDisplay();
  494.       CopyLine1(BM,NumColumns,NumLines,ScreenPos);
  495.     ELSE
  496.       a := 8*LONG(ScreenPos)*LONG(NumColumns);
  497.       b := 8*LONG(NumLines )*LONG(NumColumns);
  498.       d1 := BM^.planes[0]; INC(d1,a); s1 := d1; INC(s1,b);
  499.       d2 := BM^.planes[1]; INC(d2,a); s2 := d2; INC(s2,b);
  500.       FOR i:=0 TO 7 DO
  501.         INC(ryOffset);
  502.         MakeScreen(Screen); RethinkDisplay();
  503.         FOR j:=1 TO NumColumns DIV 4 DO
  504.           d1^ := s1^; INC(d1,4); INC(s1,4);
  505.           d2^ := s2^; INC(d2,4); INC(s2,4)
  506.         END;
  507.       END;
  508.     END;
  509.     INC(ScreenPos);
  510.     IF ScreenPos=NumLines THEN
  511.       ScreenPos := 0;
  512.       ryOffset := 0;
  513.     END;
  514.   END;
  515. END AddBottomLine;
  516.  
  517. (*------  Write String to Screen:  ------*)
  518.  
  519. PROCEDURE Write(String: ARRAY OF CHAR; Fast: BOOLEAN);
  520.  
  521. VAR text: TextLine;
  522.  
  523. BEGIN
  524.   text := FirstLine^;
  525.   i := Length(String);
  526.   IF i>=NumColumns THEN i := NumColumns-1 END;
  527.   text.text[i+1] := 0C;
  528.   REPEAT
  529.     text.text[i] := String[i];
  530.     IF text.text[i]>200C THEN DEC(text.text[i],32) END;
  531.     DEC(i)
  532.   UNTIL i<0;
  533.   AddBottomLine(ADR(text),Fast);
  534. END Write;
  535.  
  536. (*------  Check whether BottomLine^.next is NIL or not:  ------*)
  537.  
  538. PROCEDURE TryBottomnext(): BOOLEAN;
  539. (* returns TRUE if BottomLine^.next#NIL END; *)
  540.  
  541. BEGIN
  542.   IF (BottomLine^.next=NIL) AND (MyFile#NIL) THEN
  543.     SignalNewData := w;
  544.     REPEAT UNTIL mySig IN Wait(LONGSET{mySig});
  545.     SignalNewData := f;
  546.   END;
  547.   RETURN BottomLine^.next#NIL;
  548. END TryBottomnext;
  549.  
  550. (*------  Scroll down one Line:  ------*)
  551.  
  552. PROCEDURE ScrollDown(Fast: BOOLEAN);
  553. (* Returns TRUE if EOF *)
  554.  
  555. BEGIN
  556.   IF TryBottomnext() THEN
  557.     BottomLine := BottomLine^.next;
  558.     INC(AnzLines);
  559.     INC(TextLength,BottomLine^.len);
  560.   ELSE RETURN END;
  561.   IF AnzLines>=NumLines THEN
  562.     TopLine := TopLine^.next;
  563.   END;
  564.   AddBottomLine(BottomLine,Fast);
  565. END ScrollDown;
  566.  
  567. (*------  Scroll Up one Line:  ------*)
  568.  
  569. PROCEDURE ScrollUp(Fast: BOOLEAN);
  570.  
  571. VAR
  572.   i,j: INTEGER;
  573.   s1,d1,s2,d2: POINTER TO LONG;
  574.   a,b: LONG;
  575.  
  576. BEGIN
  577.   IF TopLine^.prev#NIL THEN
  578.     TopLine := TopLine^.prev;
  579.     DEC(TextLength,BottomLine^.len);
  580.     DEC(AnzLines);
  581.     BottomLine := BottomLine^.prev;
  582.     WITH Screen^.viewPort.rasInfo^ DO
  583.       IF ScreenPos=0 THEN
  584.         ryOffset  := NumLines*8;
  585.         ScreenPos := NumLines-1;
  586.       ELSE
  587.         DEC(ScreenPos);
  588.       END;
  589.       QText(8*ScreenPos,ADR(TopLine^.prev^.text),BM,ADR(fontdata));
  590.       IF Fast THEN
  591.         DEC(ryOffset,8); MakeScreen(Screen); RethinkDisplay();
  592.         CopyLine2(BM,NumColumns,NumLines,ScreenPos);
  593.       ELSE
  594.         a := (LONG(ScreenPos)+1)*8*LONG(NumColumns)-4;
  595.         b := LONG(NumLines)*LONG(NumColumns)*8;
  596.         s1 := BM^.planes[0]; INC(s1,a); d1 := s1; INC(d1,b);
  597.         s2 := BM^.planes[1]; INC(s2,a); d2 := s2; INC(d2,b);
  598.         FOR i:=0 TO 7 DO
  599.           DEC(ryOffset);
  600.           MakeScreen(Screen); RethinkDisplay();
  601.           FOR j:=1 TO NumColumns DIV 4 DO
  602.             d1^ := s1^; DEC(d1,4); DEC(s1,4);
  603.             d2^ := s2^; DEC(d2,4); DEC(s2,4)
  604.           END;
  605.         END;
  606.       END;
  607.     END;
  608.   END;   (* IF TopLine#NIL ... *)
  609. END ScrollUp;
  610.  
  611. (*------  Undo last Write():  ------*)
  612.  
  613. PROCEDURE DelLine();
  614.  
  615. VAR
  616.   i,j: INTEGER;
  617.   s1,d1,s2,d2: POINTER TO LONG;
  618.   a,b: LONG;
  619.   text: TextLine;
  620.  
  621. BEGIN
  622.   WITH Screen^.viewPort.rasInfo^ DO
  623.     IF ScreenPos=0 THEN
  624.       ryOffset  := NumLines*8;
  625.       ScreenPos := NumLines-1;
  626.     ELSE
  627.       DEC(ScreenPos);
  628.     END;
  629.     IF TopLine^.prev#NIL THEN
  630.       QText(8*ScreenPos,ADR(TopLine^.prev^.text),BM,ADR(fontdata));
  631.     ELSE
  632.       QText(8*ScreenPos,ADR(FirstLine^.text),BM,ADR(fontdata));
  633.     END;
  634.     a := (LONG(ScreenPos)+1)*8*LONG(NumColumns)-4;
  635.     b := LONG(NumLines)*LONG(NumColumns)*8;
  636.     s1 := BM^.planes[0]; INC(s1,a); d1 := s1; INC(d1,b);
  637.     s2 := BM^.planes[1]; INC(s2,a); d2 := s2; INC(d2,b);
  638.     FOR i:=0 TO 7 DO
  639.       DEC(ryOffset);
  640.       MakeScreen(Screen); RethinkDisplay();
  641.       FOR j:=1 TO NumColumns DIV 4 DO
  642.         d1^ := s1^; DEC(d1,4); DEC(s1,4);
  643.         d2^ := s2^; DEC(d2,4); DEC(s2,4)
  644.       END;
  645.     END;
  646.   END;
  647. END DelLine;
  648.  
  649. (*------  Clear Display:  ------*)
  650.  
  651. PROCEDURE ClearBitMaps();
  652.  
  653. BEGIN
  654.   WITH BM^ DO
  655.     BltClear(planes[0],LONG(bytesPerRow)*LONG(rows),0);
  656.     BltClear(planes[1],LONG(bytesPerRow)*LONG(rows),0);
  657.     ScreenPos := 0;
  658.     Screen^.viewPort.rasInfo^.ryOffset := 0;
  659.   END;
  660. END ClearBitMaps;
  661.  
  662. (*------  Convert Integer to String:  ------*)
  663.  
  664. PROCEDURE IntToStr(VAR String: ARRAY OF CHAR;
  665.                        At,Chars: INTEGER;
  666.                        int: LONG);
  667.  
  668. VAR
  669.   Cnt: INTEGER;
  670.   Ziff: LONG;
  671.  
  672. BEGIN
  673.   IF (Length(String)<Chars+At) AND (HIGH(String)>=Chars+At) THEN
  674.     String[Chars+At] := 0C;
  675.   END;
  676.   Cnt := Chars; Ziff := 1;
  677.   WHILE Cnt>1 DO
  678.     Ziff := Ziff * 10;
  679.     DEC(Cnt);
  680.   END;
  681.   Cnt := 0;
  682.   WHILE Cnt<Chars DO
  683.     String[Cnt+At] := "0";
  684.     WHILE int>=Ziff DO
  685.       DEC(int,Ziff);
  686.       INC(String[Cnt+At]);
  687.     END;
  688.     Ziff := Ziff DIV 10;
  689.     INC(Cnt);
  690.   END;
  691.   Cnt := 0;
  692.   WHILE (Cnt<Chars-1) AND (String[Cnt+At]="0") DO String[Cnt+At] := " "; INC(Cnt)
  693.   END;
  694. END IntToStr;
  695.  
  696. (*-------------------------------------------------------------------------*)
  697.  
  698. PROCEDURE GetLength(t: TextLinePtr);
  699.  
  700. BEGIN
  701.   TextLength := 0; AnzLines := 0;
  702.   WHILE t#NIL DO INC(AnzLines); INC(TextLength,t^.len); t := t^.prev END;
  703. END GetLength;
  704.  
  705. (*-------------------------------------------------------------------------*)
  706.  
  707. PROCEDURE NewDisplay();
  708. (* Zeichnet ab BottomLine neu *)
  709.  
  710. VAR
  711.   i: INTEGER;
  712.   l: TextLinePtr;
  713.  
  714. BEGIN
  715.   ClearBitMaps;
  716.   i := 1;
  717.   l := BottomLine;
  718.   WHILE (i<NumLines) AND (BottomLine^.next#NIL) DO
  719.     BottomLine := BottomLine^.next;
  720.     INC(i);
  721.   END;
  722.   WHILE (i<NumLines) AND (l^.prev#NIL) DO l := l^.prev; INC(i) END;
  723.   BottomLine := l;
  724.   GetLength(l);
  725.   Write(empty,w);
  726.   AddBottomLine(BottomLine,w);
  727.   FOR i:=0 TO NumLines-2 DO
  728.     TopLine := l;
  729.     ScrollDown(w);
  730.   END;
  731.   Scroll := f;
  732. END NewDisplay;
  733.  
  734. (*-------------------------------------------------------------------------*)
  735.  
  736. PROCEDURE ShowProc();
  737.  
  738. VAR
  739.   l: TextLinePtr;
  740.   Down: BOOLEAN;               (* Scroll-Direction                  *)
  741.   End: BOOLEAN;                (* Quit next time Space is pressed ? *)
  742.   i,j,k,m: INTEGER;
  743.   MyMsg: IntuiMessage;         (* contains Message                  *)
  744.   Shift: BOOLEAN;              (* Shifted Keystroke ?               *)
  745.   Alt: BOOLEAN;                (* Altered Keystroke ?               *)
  746.   NuWindow: POINTER TO NewWindow;
  747.   win: WindowPtr;
  748.   StrGadget: GadgetPtr;
  749.   StrInfo: StringInfo;
  750.   Find,FindStr: String;
  751.   flen: INTEGER;
  752.   HiText: TextLine;            (* Highlited textline *)
  753.   OldHiText: TextLinePtr;      (* original, un-hilited text *)
  754.   found: BOOLEAN;
  755.  
  756.   PROCEDURE NuWin; (* $E- *)
  757.   BEGIN
  758.     INLINE(100,0,0,12,1,  (* size, pens   *)
  759.            8,64,0,4096,   (* idcmp, flags *)
  760.            0,0,0,0,0,0,   (* gadget, checkmark, title *)
  761.            0,0,0,0,       (* screen, bitmap *)
  762.            0,0,0,0,       (* min/max size *)
  763.            15);           (* customscreen *)
  764.   END NuWin;
  765.  
  766.   PROCEDURE StrGdg(); (* $E- *)
  767.   BEGIN
  768.     INLINE(0,0,            (* next *)
  769.            2,2,0,8,        (* size *)
  770.            0,513,          (* flags, activation *)
  771.            strGadget,
  772.            0,0,0,0,0,0,    (* render, selectr., text *)
  773.            0,0,0,0,0);     (* mutualexcl, specialinfo *)
  774.   END StrGdg;
  775.  
  776.   PROCEDURE WaitAllRead();
  777.  
  778.   BEGIN
  779.     IF MyFile#NIL THEN
  780.       SignalAllRead := w;
  781.       REPEAT UNTIL mySig IN Wait(LONGSET{mySig});
  782.       SignalAllRead := f;
  783.     END;
  784.   END WaitAllRead;
  785.  
  786.   PROCEDURE HiLite(t: TextLinePtr; at,len: INTEGER);
  787.   (* Hilites len chars of t^.text starting from at *)
  788.  
  789.   VAR
  790.     c: INTEGER;
  791.     col: CHAR;
  792.  
  793.   BEGIN
  794.     OldHiText := t; HiText := OldHiText^;
  795.     IF at+len+2<MaxLen THEN
  796.       c := 0; col := 5C;
  797.       WHILE c<at DO
  798.         IF HiText.text[c]<CHAR(17) THEN col := HiText.text[c] END;
  799.         INC(c);
  800.       END;
  801.       HiText.text[at] := CHR(17-ORD(col));
  802.       c := at; INC(len,at);
  803.       WHILE c<len DO
  804.         HiText.text[c+1] := OldHiText^.text[c];
  805.         INC(c);
  806.       END;
  807.       HiText.text[c+1] := col;
  808.       REPEAT
  809.         HiText.text[c+2] := OldHiText^.text[c];
  810.         INC(c);
  811.       UNTIL HiText.text[c-1]=0C;
  812.     END;
  813.     IF HiText.next#NIL THEN HiText.next^.prev := ADR(HiText) END;
  814.     IF HiText.prev#NIL THEN HiText.prev^.next := ADR(HiText) END;
  815.   END HiLite;
  816.  
  817.   PROCEDURE UnHiLite();
  818.  
  819.   BEGIN
  820.     IF HiText.next#NIL THEN HiText.next^.prev := OldHiText END;
  821.     IF HiText.prev#NIL THEN HiText.prev^.next := OldHiText END;
  822.   END UnHiLite;
  823.  
  824.   PROCEDURE ChkBotNewDisp();
  825.  
  826.   VAR c: INTEGER;
  827.  
  828.   BEGIN
  829.     IF NOT found THEN
  830.       DisplayBeep(Screen);
  831.       IF TopLine^.prev=NIL THEN BottomLine := TopLine
  832.                            ELSE BottomLine := TopLine^.prev END;
  833.     ELSE BottomLine := BottomLine^.prev^.next END;
  834.     NewDisplay;
  835.     IF found THEN UnHiLite END;
  836.   END ChkBotNewDisp;
  837.  
  838.   PROCEDURE Search(): BOOLEAN;
  839.   (* searches string and hilites it if found. result is TRUE if string found *)
  840.  
  841.   BEGIN
  842.     WITH BottomLine^ DO
  843.       i := 0;
  844.       IF len<NumColumns THEN m := len ELSE m := NumColumns END;
  845.       m := m-flen;
  846.       WHILE i<m DO
  847.         j := 0; k := i;
  848.         WHILE CAP(text[k])=FindStr[j] DO
  849.           INC(j); INC(k);
  850.           IF FindStr[j]=0C THEN
  851.             IF TryBottomnext() THEN END;
  852.             HiLite(BottomLine,k-flen,flen);
  853.             found := w; RETURN w;
  854.           END;
  855.         END;
  856.         INC(i);
  857.       END;
  858.     END;
  859.     RETURN f;
  860.   END Search;
  861.  
  862.   PROCEDURE DisplayInfo();
  863.  
  864.   BEGIN
  865. (* File: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xx % (xxxxxx of xxxxxx Bytes) xxxxxx Lines *)
  866.     IStr := "XFile: "; IStr[0] := 7C;
  867.     Append(IStr,Name);
  868.     Append(IStr,"                              ");
  869.     IStr[36] := 0C;
  870.     Append(IStr,"xxx % (xxxxxx of xxxxxx Bytes) xxxxxx Lines");
  871.     IntToStr(IStr,36,3,TextLength * 100 DIV FileLength);
  872.     IntToStr(IStr,43,6,TextLength);
  873.     IntToStr(IStr,53,6,FileLength);
  874.     IntToStr(IStr,67,6,AnzLines-1);
  875.     i := 79;
  876.     WHILE (i<255) AND (i<NumColumns+2) DO IStr[i] := " "; INC(i) END;
  877.     IStr[i] := 0C; Write(IStr,f);
  878.     Info := w;
  879.   END DisplayInfo;
  880.  
  881. BEGIN
  882.  
  883.   Scroll := w; Fast := f; Down := w; End := f; Find := empty;
  884.   LOOP
  885.  
  886. (*------  Type Text:  ------*)
  887.  
  888.     IF Scroll THEN
  889.       IF Down THEN
  890.         ScrollDown(Fast);
  891.         Scroll := (MyFile#NIL) OR (BottomLine^.next#NIL);
  892.       ELSE
  893.         ScrollUp(Fast);
  894.         Scroll := TopLine^.prev#NIL;
  895.       END;
  896.     ELSE
  897.       WaitPort(Window^.userPort);
  898.     END;
  899.  
  900.     MyMsgPtr := ADDRESS(GetMsg(Window^.userPort));
  901.     WHILE (MyMsgPtr#NIL) AND (inactiveWindow IN MyMsgPtr^.class) DO
  902.       WaitPort(Window^.userPort);
  903.       MyMsgPtr := ADDRESS(GetMsg(Window^.userPort));
  904.     END;
  905.  
  906.     IF MyMsgPtr#NIL THEN
  907.  
  908.       MyMsg := MyMsgPtr^;
  909.       ReplyMsg(MyMsgPtr);
  910.  
  911.       WITH MyMsg DO
  912.  
  913.         IF class=IDCMPFlagSet{mouseButtons} THEN
  914.           class := IDCMPFlagSet{rawKey};
  915.           IF leftButton IN QualifierSet(qualifier) THEN
  916.             code := 40H;
  917.           ELSIF rightButton IN QualifierSet(qualifier) THEN
  918.             code := 41H;
  919.           END;
  920.         END;
  921.  
  922.         IF (class=IDCMPFlagSet{rawKey}) AND (code<80H) THEN
  923.  
  924.           IF    Info     THEN DelLine; Info := f;
  925.           ELSIF code=0FH THEN DisplayInfo; Scroll := f END;
  926.  
  927.           Shift := QualifierSet{} # QualifierSet{lShift,rShift} * QualifierSet(qualifier);
  928.           Alt   := QualifierSet{} # QualifierSet{lAlt,rAlt} * QualifierSet(qualifier);
  929.  
  930.           CASE code OF
  931.  
  932.           40H:                                         (* Space *)
  933.                 Fast := Shift;
  934.                 IF (MyFile=NIL) AND (BottomLine^.next=NIL) THEN
  935.                   IF End THEN EXIT ELSE End:=w END;
  936.                 ELSE
  937.                   End := f;
  938.                 END;
  939.                 IF Down THEN
  940.                   IF Scroll OR End THEN DisplayInfo END;
  941.                   Scroll := NOT(Scroll);
  942.                 ELSE
  943.                   Down := w;
  944.                   Scroll := w;
  945.                 END |
  946.  
  947.           41H:                                       (* BackSpace *)
  948.                 Fast := Shift;
  949.                 Scroll := Down OR NOT(Scroll);
  950.                 Down := f |
  951.  
  952.           4DH,1EH,1FH:                                   (* Down *)
  953.                 IF Shift THEN
  954.                   Scroll := NOT(Down AND Scroll) OR NOT(Fast);
  955.                   Fast := w; Down := w;
  956.                 ELSE
  957.                   i:=1; IF Alt OR (code=1FH) THEN i:=NumLines END;
  958.                   WHILE i#0 DO
  959.                     ScrollDown(NOT(Shift));
  960.                     DEC(i);
  961.                   END;
  962.                   Scroll := f;
  963.                 END |
  964.  
  965.           4CH,3EH,3FH:                                        (* Up *)
  966.                 IF Shift THEN
  967.                   Scroll := Down OR NOT(Scroll) OR NOT(Fast);
  968.                   Fast := w; Down := f;
  969.                 ELSE
  970.                   i:=1; IF Alt OR (code=3FH) THEN i:=NumLines END;
  971.                   WHILE i#0 DO
  972.                     ScrollUp(NOT(Shift));
  973.                     Scroll := f;
  974.                     DEC(i);
  975.                   END;
  976.                 END; |
  977.  
  978.           44H,43H:                                        (* CR *)
  979.                 ScrollDown(f);
  980.                 Scroll := f; |
  981.  
  982.           14H,3DH:                                        (* Home *)
  983.                 i:=NumLines-AnzLines;
  984.                 IF i>0 THEN
  985.                   WHILE i>0 DO DEC(i); ScrollDown(w) END; Scroll := f;
  986.                 ELSE
  987.                   BottomLine := FirstLine; NewDisplay();
  988.                 END |
  989.  
  990.           35H,1DH:                                         (* End *)
  991.                 WaitAllRead;
  992.                 BottomLine := LastLine;
  993.                 i:=NumLines;
  994.                 WHILE (i>1) AND (BottomLine^.prev#NIL) DO
  995.                   BottomLine := BottomLine^.prev;
  996.                   DEC(i);
  997.                 END;
  998.                 NewDisplay() |
  999.  
  1000.           23H,36H:                                        (* Find, Next *)
  1001.                 IF code=23H THEN
  1002.                   Screen^.height := 2*Screen^.height;
  1003.                   MakeScreen(Screen); RethinkDisplay();
  1004.                   NuWindow := ADR(NuWin);
  1005.                   StrGadget := ADR(StrGdg);
  1006.                   WITH NuWindow^ DO
  1007.                     topEdge := NumLines*4-6+Screen^.viewPort.rasInfo^.ryOffset;
  1008.                     width   := NumColumns*8-200;
  1009.                     firstGadget:= StrGadget;
  1010.                     screen := Screen;
  1011.                     StrGadget^.width := width-4;
  1012.                     StrGadget^.specialInfo := ADR(StrInfo);
  1013.                   END;
  1014.                   StrInfo.buffer := ADR(Find);
  1015.                   StrInfo.maxChars := 80;
  1016.                   win := OpenWindow(NuWindow^);
  1017.                   IF win=NIL THEN EXIT END;
  1018.                   IF ActivateGadget(StrGadget,win,NIL) THEN END;
  1019.                   WaitPort(win^.userPort);
  1020.                   CloseWindow(win);
  1021.                   Screen^.height := Screen^.height DIV 2;
  1022.                 END;
  1023.                 ClearBitMaps();
  1024.                 flen := 0;
  1025.                 LOOP
  1026.                   FindStr[flen] := CAP(Find[flen]);
  1027.                   IF    FindStr[flen]>200C THEN DEC(FindStr[flen],32)
  1028.                   ELSIF FindStr[flen]=0C   THEN EXIT END;
  1029.                   INC(flen);
  1030.                 END;
  1031.                 found := f;
  1032.                 IF flen#0 THEN
  1033.                   BottomLine := TopLine;
  1034.                   LOOP
  1035.                     IF Search() THEN EXIT END;
  1036.                     IF TryBottomnext() THEN END;
  1037.                     BottomLine := BottomLine^.next;
  1038.                     IF BottomLine=NIL THEN EXIT END;
  1039.                   END;
  1040.                 ELSE
  1041.                   BottomLine := NIL;
  1042.                 END;
  1043.                 ChkBotNewDisp |
  1044.  
  1045.           19H:                                      (* find previous *)
  1046.                 IF FindStr[0]#0C THEN
  1047.                   ClearBitMaps();
  1048.                   BottomLine := TopLine;
  1049.                   IF BottomLine^.prev#NIL THEN BottomLine:=BottomLine^.prev END;
  1050.                   found := f;
  1051.                   REPEAT
  1052.                     BottomLine := BottomLine^.prev
  1053.                   UNTIL Search() OR (BottomLine=NIL);
  1054.                   ChkBotNewDisp
  1055.                 END |
  1056.  
  1057.           18H:  IF Shift AND Alt AND NOT print THEN                (* Printout *)
  1058.                   PStr := "TYPE "; Append(PStr,Name); Append(PStr," TO PRT:");
  1059.                   WaitAllRead; print := w; Signal(Me,LONGSET{mySig});
  1060.                 END |
  1061.  
  1062.           5FH,25H: ClearBitMaps(); Write(empty,w);
  1063.                 Write(title,w);
  1064.                 Write(underln,w);
  1065.                 Write(empty,w);
  1066.                 Write("Commands:",w);
  1067.                 Write(empty,w);
  1068.                 Write(" Space, LMB:      Start / Stop scrolling. Quit at end of file.",w);
  1069.                 Write(" BackSpace, RMB:  Start / Stop scrolling backwards.",w);
  1070.                 Write(" Up/Down:         Move one line up or down.",w);
  1071.                 Write(" Shift + Up/Down: Start / Stop quick scrolling up or down.",w);
  1072.                 Write(" Alt + Up/Dwn:    Move one page up or down.",w);
  1073.                 Write(" PgUp/PgDn:       Move one page up or down.",w);
  1074.                 Write(" T, Home:         Jump to top of text.",w);
  1075.                 Write(" B, End:          Jump to bottom of text.",w);
  1076.                 Write(" NK 0:            Display Filelength etc.",w);
  1077.                 Write(" F:               Find string.",w);
  1078.                 Write(" N:               Jump to next occurance of string.",w);
  1079.                 Write(" P:               Jump to previous occurance of string.",w);
  1080.                 Write(" Shift + Alt + O: Create printout of the text",w);
  1081.                 Write(" HELP, H:         Show Commands.",w);
  1082.                 Write(" ESC, Q, X, NK 5: Quit.",w);
  1083.                 Write(empty,w);
  1084.                 Write(address,w);
  1085.                 Write(empty,w);
  1086.                 LOOP
  1087.                   WaitPort(Window^.userPort);
  1088.                   MyMsgPtr := ADDRESS(GetMsg(Window^.userPort));
  1089.                   IF (rawKey IN MyMsgPtr^.class) AND (MyMsgPtr^.code<128) THEN EXIT END;
  1090.                   ReplyMsg(MyMsgPtr);
  1091.                 END;
  1092.                 ReplyMsg(MyMsgPtr);
  1093.                 BottomLine := TopLine;
  1094.                 NewDisplay |
  1095.  
  1096.           10H,45H,32H,2EH: EXIT |                        (* ESC, Q, X, NK 5 *)
  1097.  
  1098.           ELSE END;   (* CASE code OF *)
  1099.         END;   (* IF class=IDCMPFlagSet{rawKey} THEN *)
  1100.       END;   (* WITH MyMsg DO *)
  1101.     END;   (* IF MyMsgPtr#NIL THEN *)
  1102.   END;   (* LOOP *)
  1103.  
  1104.   Done := w;
  1105.   Signal(Me,LONGSET{mySig});
  1106.   WHILE w OR (1 IN Wait(LONGSET{})) DO END;
  1107.  
  1108. END ShowProc;
  1109.  
  1110. (*------  Usage:  ------*)
  1111.  
  1112. PROCEDURE Usage;
  1113.  
  1114. BEGIN
  1115.   Write(title,f); Write(underln,f); Write(empty,f);
  1116.   Write("A soft-scrolling ASCII-File-Printer.",f); Write(empty,f);
  1117.   Write("Usage: ",f); Write(empty,f);
  1118.   Write("  MuchMore <FileName>",f); Write(empty,f);
  1119.   Write("To start from Workbench click text to print before",f); Write(empty,f);
  1120.   Write("shift-doubleclicking MuchMore. ",f); Write(empty,f);
  1121.   Write("Texts with MuchMore as their default-tool just have to be doubleclicked",f); Write(empty,f);
  1122.   Write("This can be run on NTSC as well as on PAL Amigas.",f); Write(empty,f);
  1123.   Write(address,f);
  1124.   Write("MuchMore is free to be spread on PD or Shareware Disks, with the limitations",f);
  1125.   Write("described in MuchMore.ReadMe.",f);
  1126.   Write("It's illegal to make comercial use of MuchMore without my written permission!",f);
  1127.   Write(empty,f);
  1128.   WaitPort(Window^.userPort);
  1129.   Terminate(0);
  1130. END Usage;
  1131.  
  1132. (*------  CleanUp:  ------*)
  1133.  
  1134. PROCEDURE CleanUp();
  1135.  
  1136. VAR t: TextLinePtr;
  1137.  
  1138. BEGIN
  1139.   IF ShowTaskRunning THEN RemTask(ADR(ShowTask)) END;
  1140.   IF Window#NIL THEN CloseWindow(Window) END;
  1141.   IF Screen#NIL THEN CloseScreen(Screen) END;
  1142.   IF MyFile#NIL THEN Close(MyFile) END;
  1143.   WHILE FirstLine#NIL DO
  1144.     t := FirstLine;
  1145.     FirstLine := FirstLine^.next;
  1146.     FreeMem(t,SIZE(TextLine)-MaxLen+t^.size);
  1147.   END;
  1148.   IF MyLock#NIL THEN UnLock(MyLock) END;
  1149.   IF OldDir#NIL THEN OldDir := CurrentDir(OldDir) END;
  1150.   IF FileInfo#NIL THEN FreeMem(FileInfo,SIZE(FileInfo^)) END;
  1151.   IF mySig#-1 THEN FreeSignal(mySig) END;
  1152. END CleanUp;
  1153.  
  1154. (*------------------------------  MAIN:  ----------------------------------*)
  1155.  
  1156. BEGIN
  1157.  
  1158. (*------  Init:  ------*)
  1159.  
  1160. (* These variables are automatically set to zero:
  1161.   Screen := NIL; Window := NIL; FirstLine := NIL; TopLine := NIL;
  1162.   BottomLine := NIL; MyFile := NIL; AnzLines := 0; Info := f;
  1163.   MyLock := NIL; FileInfo := NIL; TextLength := 0; ScreenPos := 0;
  1164.   ShowTaskRunning := f; SignalNewData := f; SignalAllRead := f;
  1165.   Done := f; print := f; bg := 0; style := StyleSet{}; OldDir := NIL;
  1166. *)
  1167.   mySig := -1; Me := FindTask(0); Gfxbase := ADR(Graphics); fg := 1;
  1168.  
  1169.   TermProcedure(CleanUp);
  1170.  
  1171. (*------  Setup:  ------*)
  1172.  
  1173.   InitScreen();
  1174.   FirstLine := Alloc(SIZE(TextLine)-MaxLen);
  1175.   FirstLine^.size := 0;
  1176.   FirstLine^.text[0] := 0C;
  1177.   LastLine := FirstLine;
  1178.   BottomLine := FirstLine;
  1179.   TopLine := FirstLine;
  1180.   AnzLines := 1;
  1181.   FileInfo   := Alloc(SIZE(FileInfo^));
  1182.  
  1183. (*------  Start:  ------*)
  1184.  
  1185.   WBSt:= startupMsg;
  1186.   IF wbStarted THEN
  1187.  
  1188.     WITH WBSt^ DO
  1189.       IF numArgs=2 THEN
  1190.         ArgPtr := argList^[1].name; Name := ArgPtr^;
  1191.         OldDir := CurrentDir(argList^[1].lock);
  1192.       ELSE Usage END
  1193.     END;
  1194.  
  1195.   ELSE
  1196.  
  1197.     IF dosCmdLen<=1 THEN Usage END;
  1198.     CommLine:=dosCmdBuf; i:=0; j:=0;
  1199.     WHILE CommLine^=" " DO INC(CommLine); INC(j) END;
  1200.     WHILE (i+j<dosCmdLen) AND (CommLine^#12C) DO
  1201.       Name[i] := CommLine^; INC(i); INC(CommLine);
  1202.     END;
  1203.     Name[i]:= 0C;
  1204.  
  1205.   END;
  1206.  
  1207.   MyFile := Open(ADR(Name),oldFile);
  1208.   Assert(MyFile#NIL,ADR(cof));
  1209.   RQPos := -1; RQLen := -1;
  1210.  
  1211.   MyLock := Lock(ADR(Name),sharedLock);
  1212.   Assert(MyLock#NIL,ADR(cof));
  1213.   Assert(Examine(MyLock,FileInfo),ADR(cof));
  1214.   FileLength := FileInfo^.size;
  1215.  
  1216.   UnLock(MyLock); MyLock := NIL;
  1217.   IF FileLength=0 THEN Terminate(0) END;
  1218.  
  1219.   mySig := AllocSignal(-1);
  1220.   IF mySig<0 THEN Terminate(0) END;
  1221.  
  1222.   WITH ShowTask DO
  1223.     spLower := ADR(ShowStack);
  1224.     spUpper := ADR(ShowStack[3996]);
  1225.     spReg   := spUpper;
  1226.     node.type := task;
  1227.     node.name := ADR("Show.MM");
  1228.     node.pri  := Me^.node.pri + 1;
  1229.   END;
  1230.   Forbid();
  1231.     Window^.userPort^.sigTask := ADR(ShowTask);
  1232.     AddTask(ADR(ShowTask),ADR(ShowProc),NIL);
  1233.     ShowTaskRunning := w;
  1234.   Permit();
  1235.  
  1236.   i := 0;
  1237.   REPEAT
  1238.     INC(i);
  1239.     IF i=20 THEN
  1240.       Assert(AvailMem(MemReqSet{chip,largest})>10000,ADR(oom));
  1241.       i := 0;
  1242.     END;
  1243.     LoadLine := GetTextLine();
  1244.     IF LoadLine=NIL THEN
  1245.       Close(MyFile);
  1246.       MyFile := NIL;
  1247.     ELSE
  1248.       LoadLine^.prev := LastLine;
  1249.       Forbid();
  1250.         LastLine^.next := LoadLine;
  1251.         LastLine := LoadLine;
  1252.       Permit;
  1253.     END;
  1254.     IF SignalNewData THEN Signal(ADR(ShowTask),LONGSET{mySig}) END;
  1255.   UNTIL (MyFile=NIL) OR Done;
  1256.   IF SignalAllRead THEN Signal(ADR(ShowTask),LONGSET{mySig}) END;
  1257.   REPEAT
  1258.     REPEAT UNTIL mySig IN Wait(LONGSET{mySig});
  1259.     IF print THEN
  1260.       nili := Open(ADR(nil),oldFile); nilo := Open(ADR(nil),newFile);
  1261.       SETREG(0,Execute(ADR(PStr),nili,nilo)); Close(nili); Close(nilo); print := f;
  1262.     END;
  1263.   UNTIL Done;
  1264.  
  1265. END MuchMore.
  1266.  
  1267.