home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / GEM / TEXTWIND.I < prev    next >
Encoding:
Text File  |  1994-01-21  |  76.4 KB  |  3 lines
  1. ⓪ IMPLEMENTATION MODULE TextWindows;
  2. ⓪ (*$Y+*)
  3. ⓪ 
  4. ⓪ (*
  5. ⓪ IMPORT Terminal;        (*  for debuging only  *)
  6. ⓪ *)
  7. ⓪ 
  8. ⓪ 
  9. ⓪ (*      Implementation des 'TextWindows' Modul der Megamax Modula-2 Library
  10. ⓪!*
  11. ⓪!*      Written and copyright by Manuel Chakravarty
  12. ⓪!*
  13. ⓪!*      Version 2.10   V#0891                   Created 24.09.1987
  14. ⓪!*)
  15. ⓪!
  16. ⓪!
  17. ⓪ (* 24.09.87     | Definitionen; 'levelCounter', 'Close' und 'Open' impl.
  18. ⓪!* 25.09.87     | 'writeSpaceBlock' mit drumherum impl. +
  19. ⓪!*                'WriteString' ohne VT-52, dabei auch 'writeStringPart'
  20. ⓪!* 27.09.87     | 'WriteString' optimiert
  21. ⓪!* 28.09.87     | 'WriteString' optimiert (jetzt Terminal:Windows ~ 1:4)
  22. ⓪!*                scrolling + 'Write' impl.
  23. ⓪!* 29.09.87     | 'Read' impl. + 'ReadString' vorl. Vers. + Redraw
  24. ⓪!* 30.09.87     | Verarbeitung der window events
  25. ⓪!* 01.10.87     | Modul  verwendet Sys... und berücksichtigt fremde
  26. ⓪!*                'GemHandle's richtig.
  27. ⓪!* 02.10.87     | V 0.2: Umdef. von Open-Param.; besserer Redraw
  28. ⓪!* 06.10.87     | Neues 'windowText'            ; Anpassung an GEM V 0.9
  29. ⓪!*                + VT-52 Emulator (Teile)
  30. ⓪!* 07.10.87     | 'SelectChar' impl.
  31. ⓪!* 08.10.87     | VT-52 fertiggestellt + 'IsTop' + 'CursorPos'
  32. ⓪!* 09.10.87     | Scrolling im Hintergrund funkt. endlich + 'WasClosed'
  33. ⓪!* 13.10.87     | 'ReSpecify' impl.
  34. ⓪!* 14.10.87     | Enhanced output + 'getCharSize' über VDI
  35. ⓪!* 07.11.87     | Anpassung an GEM V 0.10 + 'WindowHandle' -> 'Window' +
  36. ⓪!*                'SelectChar' gibt Zeichenbox mit zurück
  37. ⓪!* ??.11.87     | Anpassung an endgültige Definitionen
  38. ⓪!*                'SelectChar' -> 'FindChar', usw.
  39. ⓪!* 02.12.87     | Redrawgeschwindigkeit erhöht
  40. ⓪!* 03.12.87     | 'Open' auf endgültige Def gebracht und 'EditString' von
  41. ⓪!*                'Terminal' geklaut
  42. ⓪!* 07.12.87     | 'ReSpecify' fordert neuen Speicher nur an, falls sich
  43. ⓪!*                die Bufferausmaße geändert haben. Enhanced-Status abge-
  44. ⓪!*                sichert, dazu 'enhcdWind' eingeführt.
  45. ⓪!* 08.12.87     | Check auf Zeilenende wird immer vor der Ausgabe sicht-
  46. ⓪!*                barer Zeichen durchgeführt.
  47. ⓪!* 22.12.87     | 'DetectChar' läßt jetzt auch 'NoWind' als Element im
  48. ⓪!*                open array zu (Ermöglicht Fenstercheck ohne das beim
  49. ⓪!*                Aufrufer irgendwelche 'Window'-Handle bekannt sind)
  50. ⓪!* 27.12.87     | 'takeCareOfForce' auch am Anfang einer Stringausgabe
  51. ⓪!* 12.01.88     | 'copyOpaque' impl.
  52. ⓪!* 13.01.88     | CTRL-E/F für 'EnhancedOutput (TRUE/FALSE)'
  53. ⓪!*              | Neues 'adjust'
  54. ⓪!* 17.01.88     | Falls Fensterausmaße bei 'Open' zu klein sind werden
  55. ⓪!*                sie auf Min.maße vergößert.
  56. ⓪!* 21.01.88     | 'WasClosed' bereinigt A3 und 'copyOpaque's hoffentlich
  57. ⓪!*                letzten Fehler beseitigt.
  58. ⓪!* 24.01.88     | 'nextChar' in ASM und 'forceLine' eingeführt
  59. ⓪!* 26.01.88     | 'copyOpaque' macht vdiCopy bei Farbe.
  60. ⓪!* 31.01.88     | Während der Behandlung eines Events (watch dog) darf
  61. ⓪!*                kein 'ShareTime' gemacht werden => siehe 'eventHandling'
  62. ⓪!* 05.04.88     | 'KeyPressed' arbeitet jetzt mit globalem Tastenbuffer für
  63. ⓪!*                ein Zeichen.
  64. ⓪!*                'ReadString' schaltet Cursor nicht ein, falls
  65. ⓪!*                noch Zeichen im Tastaturpuffer vorliegen.
  66. ⓪!*                Bei 'interpretCtrl' werden auch die nicht interpretierbaren
  67. ⓪!*                Ctrl-Zeichen nicht angezeigt.
  68. ⓪!* 06.04.88     | Beim Schreiben in unsichtbare Fenster wird nun auch im
  69. ⓪!*                enhanced mode der Mauscursor nicht mehr versteckt.
  70. ⓪!*                Lokales Modul 'Timer'.
  71. ⓪!* 07.04.88     | VT-52-Emulation für ESC-L und ESC-M impl.
  72. ⓪!*
  73. ⓪!*  02.02.89 MCH 0.04   | Beginn der Umstellung auf 'WindowBase' und der
  74. ⓪!*                        Trennung der Bufferschreibenden und -lesenden
  75. ⓪!*                        Vorgänge.
  76. ⓪!*  15.02.89 MCH 0.04   | Pipes + 'insertIntoWritePipe'.
  77. ⓪!*  16.02.89 MCH 0.04   | write proc.s newly + 'escAutomat' impl.
  78. ⓪!*  21.02.89 MCH 0.04   | 'flushWritePipe' impl.
  79. ⓪!*  22.02.89 MCH 0.04   | 'doWaitingRedraws' + server proc.s impl.
  80. ⓪!*  23.02.89 MCH 0.04   | server proc.s weiter
  81. ⓪!*  26.02.89 MCH 0.04   | Debugging.
  82. ⓪!*  27.02.89 MCH 0.04   | No internal esc sequences.
  83. ⓪!*  28.02.89 MCH 0.04   | While redrawing, background is cleared first.
  84. ⓪!*                        'insertIntoWritePipe' copys until a 0C is matched.
  85. ⓪!*                        'SetPosAndSize', 'SetTop' and 'ReadTextBuffer' impl.
  86. ⓪!*  01.03.89 MCH 2.00   | The 'escAutomat' sets the 'status.state' to the
  87. ⓪!*                        right value, at the end of 'gotoXY', 'fgCol' and
  88. ⓪!*                        'bgCol'.
  89. ⓪!*                        THE NEW VERSION IS COMPLETELY IMPLEMENTED.
  90. ⓪!*  04.06.89 MCH 2.01   | 'takeCareOfForce' is not applied at hidden wdw.s
  91. ⓪!*  27.06.89 MCH 2.02   | Uses 'ResCtrl'
  92. ⓪!*  30.07.89 MCH 2.03   | 'doWaitingRedraws' inserted into 'scrollUp/Down',
  93. ⓪!*                        Not Tested!
  94. ⓪!*  31.07.89 MCH 2.03   | While enhanced mode on, no redraw before scrolling;
  95. ⓪!*                        movement of redraw area, while scrolling.
  96. ⓪!*  01.08.89 MCH 2.04   | 'takeCareOfForce' uses 'SetWindowSliderPos'
  97. ⓪!*  02.08.89 MCH 2.04   | Uses 'SysCreateWindow' and 'FlushEvents';
  98. ⓪!*                        'SetTop' -> 'PutOnTop'
  99. ⓪!*  11.08.89 MCH 2.05   | Uses 'reverseWrt'; 'maxCharPerRow' raus; 
  100. ⓪!*                        'pointToCharPos' arbeitet jetzt auch richtig, wenn
  101. ⓪!*                        das 'WindowBase'-Fenster größer als der Puffer ist.
  102. ⓪!*  15.08.89 MCH 2.06   | Uses 'WindowBase' V0.12 
  103. ⓪!*  16.08.89 MCH 2.06   | Some changes in 'checkSpec'
  104. ⓪!*  17.08.89 MCH 2.06   | 'pipeEscStatus' eingeführt
  105. ⓪!*  19.08.89 MCH 2.07   | 'GetGSX' und 'GetKey' def. + impl.
  106. ⓪!*  30.08.89 TT  2.08   | ReadLine, EditLine, ReadToken, UndoRead;
  107. ⓪!*                        keyBuffer-Verwaltung geändert (neue BOOLEAN-Var);
  108. ⓪!*                        Done-Funktion neu (ebenso done-feld in Window-Record)
  109. ⓪!*  15.02.90 MCH 2.9    | Anpassung an Compilerversion 4.0 (REFs)
  110. ⓪!*  06.04.90 MCH 2.9    | 'DetectChar' liefert jetzt hoffentlich korrekte 'box'
  111. ⓪!*  25.11.90 TT         | GrafMouse-Aufruf nun in connectToGem statt in
  112. ⓪!*                        levelCounter, weil sont ModLoad nicht funktioniert
  113. ⓪!*  17.12.90 TT         | FastGEM0-Import erstmal entfernt, da immer noch
  114. ⓪!*                        Fehler bei Bigscreen
  115. ⓪!*  15.02.91 TT         | 'scrollDown' (reverse LF) benutzt copyVertWdw statt
  116. ⓪!*                        copyHorWdw; 'insert/deleteLine' funktionieren auch in
  117. ⓪!*                        1. Zeile (Abfrage auf f.y>0 durch f.y>=0 ersetzt);
  118. ⓪!*                        Cursor ist wieder sichtbar (cursorOn: / gg. + ers.).
  119. ⓪!*  02.03.91 TT         | Close mit undef. Ptr meldet keinen Laufzeitfehler
  120. ⓪!*  08.04.91 TT         | Open: Wenn alle Fenster belegt, liefert success FALSE
  121. ⓪!*  15.09.91 MS         | Open: Speicher f. redrawStr wird bei Fehlern wieder
  122. ⓪!*                        freigegeben.
  123. ⓪!*  21.05.93 TT         | Mittels Respecify kann nun auch der Font bestimmt
  124. ⓪!*                        werden; SetPosAndSize rundet nicht mehr ab.
  125. ⓪!*  07.06.93 TT         | Auch wenn kein Force-Modus, wird bei Eingaben (Read)
  126. ⓪!*                        das Fenster getopped und Cursor sichtbar gescrollt.
  127. ⓪!*  14.01.94 TT         | checkSpec korrigiert.
  128. ⓪!*)
  129. ⓪ 
  130. ⓪ (*  =============== to do: ====================
  131. ⓪!*
  132. ⓪!*  =============== docu: =====================
  133. ⓪!*
  134. ⓪!*)
  135. ⓪!
  136. ⓪!
  137. ⓪ FROM SYSTEM     IMPORT ASSEMBLER, WORD, ADDRESS, BYTE,
  138. ⓪7TSIZE, ADR;
  139. ⓪ 
  140. ⓪ (*  MOS  *)
  141. ⓪ 
  142. ⓪ IMPORT StringEditor, MOSConfig;
  143. ⓪ 
  144. ⓪ FROM Calls      IMPORT CallSupervisor;
  145. ⓪ 
  146. ⓪ FROM Storage    IMPORT SysAlloc, DEALLOCATE;
  147. ⓪ 
  148. ⓪ FROM MOSGlobals IMPORT IllegalPointer, GeneralErr, MemArea, Key;
  149. ⓪ 
  150. ⓪ FROM PrgCtrl    IMPORT EnvlpCarrier, TermCarrier,
  151. ⓪7SetEnvelope, CatchProcessTerm;
  152. ⓪ 
  153. ⓪ FROM ResCtrl    IMPORT RemovalCarrier,
  154. ⓪7CatchRemoval;
  155. ⓪ 
  156. ⓪ FROM Strings    IMPORT Assign, Length, StrEqual, Delete;
  157. ⓪ 
  158. ⓪ (*  GEM  *)
  159. ⓪ 
  160. ⓪ FROM GrafBase           IMPORT Point, Rectangle, MemFormDef, white, black,
  161. ⓪?BitOperation, LongPnt, LongRect,
  162. ⓪?Pnt, Rect, TransRect, ClipRect, GetBlitterMode,
  163. ⓪?GetScreen, MinPoint, MaxPoint, FrameRects,
  164. ⓪?WritingMode, LPnt, LRect;
  165. ⓪5
  166. ⓪ FROM GEMGlobals         IMPORT TextEffect, TEffectSet, GemChar, MButtonSet,
  167. ⓪?THorJust, TVertJust,
  168. ⓪?SpecialKeySet, MouseButton, FillType;
  169. ⓪ 
  170. ⓪ FROM GEMEnv             IMPORT RC, GemHandle, DeviceHandle, GDOSAvailable,
  171. ⓪?SysInitGem, ExitGem, CurrGemHandle, PtrDevParm,
  172. ⓪?DeviceParameter, SetCurrGemHandle, GemActive;
  173. ⓪ 
  174. ⓪ FROM AESEvents          IMPORT Event, RectEnterMode;
  175. ⓪ 
  176. ⓪ FROM AESGraphics        IMPORT MouseForm, GrafMouse;
  177. ⓪ 
  178. ⓪ FROM VDIControls        IMPORT LoadFonts, SetClipping, DisableClipping;
  179. ⓪ 
  180. ⓪ FROM VDIAttributes      IMPORT SetTextColor, SetTextEffects, SetFillColor,
  181. ⓪?SetFillType, SetFillPerimeter, SetWritingMode,
  182. ⓪?SetPtsTHeight, SetAbsTHeight, SetTextFace;
  183. ⓪ 
  184. ⓪ FROM VDIOutputs         IMPORT FillRectangle, GrafText;
  185. ⓪ 
  186. ⓪ FROM VDIInputs          IMPORT HideCursor, ShowCursor;
  187. ⓪ 
  188. ⓪ FROM VDIInquires        IMPORT GetTextStyle, GetFaceName, GetFaceInfo;
  189. ⓪ 
  190. ⓪ IMPORT AESWindows, GEMBase;
  191. ⓪ 
  192. ⓪ (*  Beyond GEM  *)
  193. ⓪ 
  194. ⓪ FROM EventHandler       IMPORT EventProc, WatchDogCarrier,
  195. ⓪?SysInstallWatchDog, DeInstallWatchDog,
  196. ⓪?HandleEvents, FlushEvents;
  197. ⓪ 
  198. ⓪ IMPORT WindowBase;
  199. ⓪ 
  200. ⓪ FROM VDIRasters  IMPORT CopyOpaque;
  201. ⓪ 
  202. ⓪ CONST   TestVersion     = FALSE; (*  Debugging?  *)
  203. ⓪ 
  204. ⓪ (*$? NOT TestVersion:  (*$R-*)
  205. ⓪!*)
  206. ⓪ 
  207. ⓪ 
  208. ⓪ CONST   windowMagic     = 170469;       (* Woher kommt diese Zahl ??!? *)
  209. ⓪(
  210. ⓪(bufMax          = MaxCard;
  211. ⓪(maxNameLen      = 80;
  212. ⓪(
  213. ⓪(pipeMax         = 512;  (*  Number of elem.s per pipe  *)
  214. ⓪(
  215. ⓪(fractionBaseL   = 10000L;
  216. ⓪/
  217. ⓪(noErrorTrap     = 6;
  218. ⓪(
  219. ⓪((*  char const.s  *)
  220. ⓪(
  221. ⓪(null            = 0C;
  222. ⓪(ctrlE           = 5C;
  223. ⓪(ctrlF           = 6C;
  224. ⓪(bell            = 7C;
  225. ⓪(bs              = 10C;
  226. ⓪(lf              = 12C;
  227. ⓪(cr              = 15C;
  228. ⓪(ctrlP           = 20C;
  229. ⓪(esc             = 33C;
  230. ⓪(space           = 40C;
  231. ⓪ 
  232. ⓪ 
  233. ⓪ TYPE    twoChars        = ARRAY[0..1] OF CHAR;
  234. ⓪(fourChars       = ARRAY[0..3] OF CHAR;
  235. ⓪ 
  236. ⓪((*  pipes
  237. ⓪)*)
  238. ⓪(pipe            = POINTER TO pipeDesc;
  239. ⓪(pipeDesc        = RECORD
  240. ⓪<data        : ARRAY[1..pipeMax] OF CHAR;
  241. ⓪<head,                       (*  write here  *)
  242. ⓪<tail        : CARDINAL;     (*  read here  *)
  243. ⓪:END;
  244. ⓪(
  245. ⓪((*  esc automat
  246. ⓪)*)
  247. ⓪(escState        = (normalEsc, escEsc, gotoXEsc, gotoYEsc, fgEsc, bgEsc);
  248. ⓪(escStatusDesc   = RECORD
  249. ⓪<state        : escState;
  250. ⓪<first        : CHAR;
  251. ⓪:END;
  252. ⓪(escComand       = (normalCharEsc, nothingEsc, cursUpEsc, cursDownEsc,
  253. ⓪;cursLeftEsc, cursRightEsc, clsEsc, homeEsc,
  254. ⓪;eraseEOPEsc, reverseLfEsc, clrEOLEsc, insLnEsc,
  255. ⓪;delLnEsc, gotoXYEsc, fgColEsc, bgColEsc,
  256. ⓪;eraseBegDispEsc, cursOnEsc, cursOffEsc,
  257. ⓪;saveCursPosEsc, restoreCursPosEsc, eraseLnEsc,
  258. ⓪;eraseBegLnEsc, reverseOnEsc, reverseOffEsc,
  259. ⓪;wrapOnEsc, wrapOffEsc, flushEsc, enhanceOffEsc,
  260. ⓪;enhanceOnEsc);
  261. ⓪(escResultDesc   = RECORD
  262. ⓪(
  263. ⓪<comand      : escComand;
  264. ⓪<
  265. ⓪<(*  valid, if 'comand = normalCharEsc'.
  266. ⓪=*)
  267. ⓪<ch          : CHAR;
  268. ⓪<
  269. ⓪<(*  valid, if 'comand = gotoXYEsc'.
  270. ⓪=*)
  271. ⓪<x, y,
  272. ⓪<
  273. ⓪<(*  valid, if 'comand = fgColEsc'.
  274. ⓪=*)
  275. ⓪<fgCol,
  276. ⓪<
  277. ⓪<(*  valid, if 'comand = bgColEsc'.
  278. ⓪=*)
  279. ⓪<bgCol       : CARDINAL;
  280. ⓪<
  281. ⓪:END;
  282. ⓪(
  283. ⓪((*  types for the text buffer.
  284. ⓪)*)
  285. ⓪(effect          = (inverse);
  286. ⓪(effectSet       = SET OF effect;
  287. ⓪(bufferElem      = RECORD         (* TSIZE (bufferElem) = 2 !!!!! *)
  288. ⓪<effects      : effectSet;
  289. ⓪<ch           : CHAR;
  290. ⓪:END;
  291. ⓪(ptrBufferElem   = POINTER TO bufferElem;
  292. ⓪(bufRange        = [0..bufMax];
  293. ⓪ 
  294. ⓪((*  window descriptor.
  295. ⓪)*)
  296. ⓪(ptrWindow       = POINTER TO window;
  297. ⓪(window          = RECORD
  298. ⓪<handle       : WindowBase.Window;  (* AES handle *)
  299. ⓪<columns, rows: CARDINAL;  (* Textausmaße *)
  300. ⓪<force        : ForceMode;
  301. ⓪<quality      : WQualitySet;
  302. ⓪<
  303. ⓪<ctrlMode     : CtrlMode;  (* Ctrl-Zeichen drucken?*)
  304. ⓪<echoMode     : EchoMode;  (* Echo bei Read's? *)
  305. ⓪<wrapAround   : BOOLEAN;   (* Verhalten am Zeilenende*)
  306. ⓪<
  307. ⓪<bgCol, fgCol : CARDINAL;  (* Hinter-/Vordergrund *)
  308. ⓪<fontHdl      : CARDINAL;
  309. ⓪<fontSize     : CARDINAL;  (* Größe in Pts *)
  310. ⓪<charW, charH : INTEGER; (* Breite und Höhe einer Zeichenzelle *)
  311. ⓪<topToBase    : INTEGER; (* Abstand von top- zu baseline *)
  312. ⓪<minADE, maxADE: CHAR; (* Kleinstes und größtes Zeichen des Fonts *)
  313. ⓪<
  314. ⓪<noCursHides  : CARDINAL;  (* number of curs. hides*)
  315. ⓪<cursX, cursY : CARDINAL;  (* Cursorposition *)
  316. ⓪<cursIndex    : bufRange;  (* Curs.pos. als Index *)
  317. ⓪<
  318. ⓪<revMode      : BOOLEAN;   (* Reverse mode? *)
  319. ⓪<
  320. ⓪<closed       : BOOLEAN;
  321. ⓪<
  322. ⓪<pipeEscStatus,
  323. ⓪<escStatus    : escStatusDesc; (*  VT52  *)
  324. ⓪<cursXSave,
  325. ⓪<cursYSave    : CARDINAL;
  326. ⓪<
  327. ⓪<done         : BOOLEAN;   (* f. Done-Funktion *)
  328. ⓪<
  329. ⓪<enhanced     : BOOLEAN;   (* enhanced-mode? *)
  330. ⓪<
  331. ⓪<writePipe    : pipe;      (* buffers the in-stream*)
  332. ⓪<redrawArea   : Rectangle; (* '.w = 0' means none *)
  333. ⓪<
  334. ⓪<textOrg      : bufRange;  (* Zeichen links oben *)
  335. ⓪<buffer       : POINTER TO (* Textbuffer *)
  336. ⓪MARRAY bufRange OF bufferElem;
  337. ⓪<
  338. ⓪<redrawStr    : POINTER TO ARRAY[0..32767] OF CHAR;
  339. ⓪<
  340. ⓪<magic        : LONGCARD;
  341. ⓪<level        : INTEGER;   (* modLevel bei Anmeldung *)
  342. ⓪<next         : ptrWindow; (* Listenzeiger *)
  343. ⓪:END;
  344. ⓪(Window          = ptrWindow;
  345. ⓪(
  346. ⓪ CONST   noWindPtr       = ptrWindow (NoWind);
  347. ⓪(
  348. ⓪ 
  349. ⓪ VAR     windowRoot      : ptrWindow;
  350. ⓪(eventHandling   : BOOLEAN;      (*  '= TRUE' ~ Event-Behandlung  *)
  351. ⓪(gemHdl          : GemHandle;
  352. ⓪(device          : DeviceHandle;
  353. ⓪(stdMFDB         : MemFormDef;
  354. ⓪(Fonts           : CARDINAL;
  355. ⓪(StdFontHdl      : CARDINAL;
  356. ⓪(StdFontHeight   : CARDINAL;
  357. ⓪(stdCharW, stdCharH: CARDINAL;
  358. ⓪(
  359. ⓪(voidO           : BOOLEAN;  (* BOOLEAN-Var. zum Param. füllen *)
  360. ⓪(voidI           : INTEGER;
  361. ⓪(voidC           : CARDINAL;
  362. ⓪(
  363. ⓪(modLevel        : INTEGER;  (*  0 ~ SysLevel; -1 nach 'removalProc'  *)
  364. ⓪(
  365. ⓪(globToken       : BOOLEAN;
  366. ⓪(globHdl         : Window;
  367. ⓪ 
  368. ⓪ 
  369. ⓪(
  370. ⓪ MODULE Timer;           (*  Lokales Modul, das eine Proc. regelmäßig aufruft  *)
  371. ⓪ 
  372. ⓪ 
  373. ⓪ IMPORT ASSEMBLER, ADDRESS, MemArea,
  374. ⓪'ADR, CallSupervisor;
  375. ⓪ 
  376. ⓪ EXPORT installTimeProc, careOfTime;
  377. ⓪ 
  378. ⓪ 
  379. ⓪ VAR     timeProc                : PROC;
  380. ⓪(timeGap                 : CARDINAL;
  381. ⓪(passedTime              : LONGCARD;
  382. ⓪(
  383. ⓪(
  384. ⓪ PROCEDURE installTimeProc (proc:PROC; gap:CARDINAL);
  385. ⓪ 
  386. ⓪"BEGIN
  387. ⓪$timeProc:=proc; timeGap:=gap; passedTime:=0L;
  388. ⓪"END installTimeProc;
  389. ⓪"
  390. ⓪ VAR     readTimeLast    : LONGCARD;
  391. ⓪ 
  392. ⓪ PROCEDURE readTime (adr:ADDRESS);
  393. ⓪ 
  394. ⓪"VAR     _hz_200 [$4BA]  : LONGCARD;
  395. ⓪*_timer_ms [$442]: CARDINAL;
  396. ⓪"
  397. ⓪"(*$L-*)
  398. ⓪"BEGIN
  399. ⓪$ASSEMBLER
  400. ⓪(SUBQ.L  #4,A3
  401. ⓪(
  402. ⓪(MOVE.L  _hz_200,D0
  403. ⓪(SUB.L   readTimeLast,D0
  404. ⓪(MULU    _timer_ms,D0
  405. ⓪(ADD.L   passedTime,D0
  406. ⓪(MOVE.L  D0,passedTime
  407. ⓪"END;
  408. ⓪"END readTime;
  409. ⓪"(*$L=*)
  410. ⓪ 
  411. ⓪ PROCEDURE careOfTime;
  412. ⓪ 
  413. ⓪"VAR     stack   : ARRAY[0..511] OF CARDINAL;
  414. ⓪*wsp     : MemArea;
  415. ⓪"
  416. ⓪"BEGIN
  417. ⓪$IF timeGap > 0 THEN
  418. ⓪&wsp.bottom:=ADR (stack); wsp.length:=SIZE (stack);
  419. ⓪&CallSupervisor (readTime, NIL, wsp);
  420. ⓪&IF passedTime >= LONG (timeGap) THEN passedTime:=0L; timeProc END;
  421. ⓪$END;
  422. ⓪"END careOfTime;
  423. ⓪ 
  424. ⓪ 
  425. ⓪ BEGIN
  426. ⓪"timeGap:=0;
  427. ⓪"readTimeLast:=0L;
  428. ⓪ END Timer;              (*  -- Ende des lokalen Moduls --  *)
  429. ⓪ 
  430. ⓪ 
  431. ⓪8(*  graphic proc.s  *)
  432. ⓪8(*  ==============  *)
  433. ⓪ 
  434. ⓪ (*  grafText -- Gibt String mit Effekten aus.
  435. ⓪!*              REF wegen Effizenz (und wegen Übergabe von 'MaxCard + 1'
  436. ⓪!*              Elementen).
  437. ⓪!*)
  438. ⓪ 
  439. ⓪ PROCEDURE grafText (    device : DeviceHandle;
  440. ⓪8p      : Point;
  441. ⓪4REF str    : ARRAY OF CHAR;
  442. ⓪8effects: effectSet);
  443. ⓪ 
  444. ⓪"BEGIN
  445. ⓪$IF inverse IN effects THEN SetWritingMode (device, reverseWrt) END;
  446. ⓪$
  447. ⓪$(*  GrafText (device, p, str);
  448. ⓪%*
  449. ⓪%*  Damit nicht 'MaxCard + 1' als Stringlänge übergeben wird, muß dies in
  450. ⓪%*  Assembler geschrieben werden.
  451. ⓪%*)
  452. ⓪$ASSEMBLER
  453. ⓪$
  454. ⓪(;  Berechne: D0 := Length (str)
  455. ⓪(;
  456. ⓪(MOVE.W  #1, D0
  457. ⓪(MOVE.L  str(A6), A0
  458. ⓪ loop1
  459. ⓪(ADDQ.W  #1, D0
  460. ⓪(TST.B   (A0)+
  461. ⓪(BNE     loop1
  462. ⓪(ANDI.W  #-2, D0         ; gerade Anzahl!
  463. ⓪(
  464. ⓪(;  call 'GrafText'
  465. ⓪(;
  466. ⓪(MOVE.L  device(A6), (A3)+
  467. ⓪(MOVE.L  p(A6), (A3)+
  468. ⓪(MOVE.L  str(A6), (A3)+
  469. ⓪(MOVE.W  D0, (A3)+
  470. ⓪(JSR     GrafText
  471. ⓪$END;
  472. ⓪%
  473. ⓪$IF inverse IN effects THEN SetWritingMode (device, replaceWrt) END;
  474. ⓪"END grafText;
  475. ⓪ 
  476. ⓪ 
  477. ⓪8(*  misc.  *)
  478. ⓪8(*  =====  *)
  479. ⓪(
  480. ⓪ (*  getCharSize -- Liefert die Breite 'w' und Höhe 'h' einer Zeichenzelle
  481. ⓪!*                 und den Abstand von der topline zur baseline 'tb' und
  482. ⓪!*                 größtes und kleinstes Zeichen des aktuellen Fonts.
  483. ⓪!*)
  484. ⓪ 
  485. ⓪ PROCEDURE getCharSize (VAR w, h, tb: CARDINAL; VAR minADE, maxADE: CHAR);
  486. ⓪ 
  487. ⓪"VAR     min, max        : CARDINAL;
  488. ⓪*bottom, top     : CARDINAL;
  489. ⓪*width           : INTEGER;
  490. ⓪"
  491. ⓪"BEGIN
  492. ⓪$GetFaceInfo (device, min,max, bottom,voidC,voidC,voidC, top,
  493. ⓪1width ,voidI,voidI,voidI);
  494. ⓪0
  495. ⓪$minADE := CHR (min); maxADE := CHR (max);
  496. ⓪$tb := CARDINAL (top);
  497. ⓪$w := CARDINAL (width);
  498. ⓪$h := CARDINAL (bottom) + tb + 1;     (* Topline selber mitzählen *)
  499. ⓪"END getCharSize;
  500. ⓪ 
  501. ⓪ PROCEDURE setFont (hdl, size: INTEGER);
  502. ⓪"VAR c: CARDINAL;
  503. ⓪"BEGIN
  504. ⓪$SetTextFace (device, hdl);
  505. ⓪$SetAbsTHeight (device, size, c, c, c, c); (* Größe setzen *)
  506. ⓪"END setFont;
  507. ⓪ 
  508. ⓪ PROCEDURE getCharSizes (hdl: ptrWindow);
  509. ⓪"VAR   w, h, tb        : CARDINAL;
  510. ⓪"BEGIN
  511. ⓪$WITH hdl^ DO
  512. ⓪&getCharSize(w, h, tb, minADE, maxADE);
  513. ⓪&charW := INTEGER (w);
  514. ⓪&charH := INTEGER (h);
  515. ⓪&topToBase := INTEGER (tb);
  516. ⓪$END
  517. ⓪"END getCharSizes;
  518. ⓪ 
  519. ⓪ 
  520. ⓪8(*  calc. proc.s  *)
  521. ⓪8(*  ============  *)
  522. ⓪ 
  523. ⓪ (*  buffer  *)
  524. ⓪ 
  525. ⓪ (*  pointToCharPos - Berechnet die Zeichenposition, die dem Bildschirm-
  526. ⓪!*                   pixel 'p' entspricht. Liegt 'p' nicht in 'hdl', so
  527. ⓪!*                   ist 'success = FALSE'.
  528. ⓪!*                   Dabei überschreiten die Ergebnisse nie die maximal
  529. ⓪!*                   Werte für Zeilen- und Spaltenposition.
  530. ⓪!*)
  531. ⓪!
  532. ⓪ PROCEDURE pointToCharPos (    hdl    :ptrWindow;
  533. ⓪>p      :Point;
  534. ⓪:VAR column,
  535. ⓪>row    : CARDINAL;
  536. ⓪:VAR success: BOOLEAN);
  537. ⓪ 
  538. ⓪"VAR   lp: LongPnt;
  539. ⓪"
  540. ⓪"BEGIN
  541. ⓪$WITH hdl^ DO
  542. ⓪$
  543. ⓪&WindowBase.CalcWindowCoor (handle, p, lp, success);
  544. ⓪&IF NOT success THEN RETURN END;
  545. ⓪&
  546. ⓪&column := CARDINAL (SHORT (lp.x DIV LONG (charW)));
  547. ⓪&row := CARDINAL (SHORT (lp.y DIV LONG (charH)));
  548. ⓪&IF column >= hdl^.columns THEN column := hdl^.columns - 1 END;
  549. ⓪&IF row >= hdl^.rows THEN row := hdl^.rows - 1 END;
  550. ⓪&
  551. ⓪$END;
  552. ⓪"END pointToCharPos;
  553. ⓪"
  554. ⓪ (*  charToPointPos - Calculates the real pixel coor.s of the char. coor.s
  555. ⓪!*                   (column/row).
  556. ⓪!*)
  557. ⓪!
  558. ⓪ PROCEDURE charToPointPos (hdl: ptrWindow; column, row: CARDINAL): Point;
  559. ⓪ 
  560. ⓪"VAR   result: Point;
  561. ⓪"
  562. ⓪"BEGIN
  563. ⓪$WITH hdl^ DO
  564. ⓪&WindowBase.CalcScreenCoor (handle,
  565. ⓪ALPnt (LONG (INTEGER (column)) * LONG (charW),
  566. ⓪GLONG (INTEGER (row)) * LONG (charH)),
  567. ⓪Aresult, voidO);
  568. ⓪$END;
  569. ⓪$RETURN result
  570. ⓪"END charToPointPos;
  571. ⓪ 
  572. ⓪ (*  textBufferIndex - Calc.s the index in the text buffer for the char.
  573. ⓪!*                    pos. specified.
  574. ⓪!*)
  575. ⓪ 
  576. ⓪ PROCEDURE textBufferIndex (hdl: ptrWindow; column, row: CARDINAL): bufRange;
  577. ⓪ 
  578. ⓪"VAR     (* $Reg*)a, b    : CARDINAL;
  579. ⓪"
  580. ⓪"BEGIN
  581. ⓪$IF (column >= hdl^.columns) OR (row >= hdl^.rows) THEN RETURN 0 END;
  582. ⓪$WITH hdl^ DO
  583. ⓪&a := textOrg + row * columns + column;
  584. ⓪&b := rows * columns;
  585. ⓪$END;
  586. ⓪$IF a >= b THEN RETURN a - b ELSE RETURN a END;
  587. ⓪"END textBufferIndex;
  588. ⓪ 
  589. ⓪ 
  590. ⓪8(*  misc. gem proc.s  *)
  591. ⓪8(*  ================  *)
  592. ⓪ 
  593. ⓪ PROCEDURE connectToGem (): BOOLEAN;
  594. ⓪ 
  595. ⓪"VAR     w, h            : CARDINAL;
  596. ⓪"VAR     c               : CHAR;
  597. ⓪*proc            : EventProc;
  598. ⓪*success         : BOOLEAN;
  599. ⓪*devpar          : PtrDevParm;
  600. ⓪*mode    : WritingMode;
  601. ⓪*hor     : THorJust;
  602. ⓪*vert    : TVertJust;
  603. ⓪ 
  604. ⓪"BEGIN
  605. ⓪$SysInitGem(RC,device, success);
  606. ⓪$IF success THEN
  607. ⓪$
  608. ⓪&gemHdl := CurrGemHandle ();
  609. ⓪&
  610. ⓪&AESWindows.UpdateWindow (TRUE);
  611. ⓪&
  612. ⓪&IF GDOSAvailable () THEN
  613. ⓪(LoadFonts (device, 0, Fonts)
  614. ⓪&ELSE
  615. ⓪(Fonts:= 0;
  616. ⓪&END;
  617. ⓪&devpar:= DeviceParameter (device);
  618. ⓪&INC (Fonts, devpar^.fonts); (* Anzahl der Fonts: Systemfonts mitzählen *)
  619. ⓪&
  620. ⓪&IF StdFontHeight = 0 THEN
  621. ⓪((* Systemfont ermitteln *)
  622. ⓪(GetTextStyle (device, StdFontHdl, w, w, hor, vert, mode, 
  623. ⓪0stdCharW, stdCharH, w, w);
  624. ⓪(getCharSize (w, h, StdFontHeight, c, c);
  625. ⓪&END;
  626. ⓪&
  627. ⓪&SetTextColor (device, white);
  628. ⓪&SetTextEffects (device, TEffectSet{});
  629. ⓪&SetFillPerimeter (device, FALSE);
  630. ⓪&
  631. ⓪&GrafMouse (arrow, NIL);
  632. ⓪&
  633. ⓪&AESWindows.UpdateWindow (FALSE);
  634. ⓪&
  635. ⓪$END;
  636. ⓪$RETURN success
  637. ⓪"END connectToGem;
  638. ⓪ 
  639. ⓪ PROCEDURE deConnectFromGem;
  640. ⓪ 
  641. ⓪"BEGIN
  642. ⓪%ExitGem (gemHdl);
  643. ⓪%gemHdl := GemHandle (0);
  644. ⓪"END deConnectFromGem;
  645. ⓪"
  646. ⓪ (*  saveCurrHdl -- Rettet das aktuelle GEM-Hdl. in 'saveArea' und setzt
  647. ⓪!*                 stattdessen das handle von 'TextWindows' ein. Tritt
  648. ⓪!*                 beim Setzen ein Fehler auf, so wird ein Laufzeitfehler
  649. ⓪!*                 ausgelößt.
  650. ⓪!*)
  651. ⓪ 
  652. ⓪ PROCEDURE saveCurrHdl (VAR saveArea : GemHandle);
  653. ⓪ 
  654. ⓪"(*$L-*)
  655. ⓪"BEGIN
  656. ⓪$ASSEMBLER
  657. ⓪(JSR     CurrGemHandle
  658. ⓪(MOVE.L  -(A3),D0
  659. ⓪(MOVE.L  -(A3),A0
  660. ⓪(MOVE.L  D0,(A0)
  661. ⓪(
  662. ⓪(MOVE.L  gemHdl,(A3)+
  663. ⓪(SUBQ.L  #2,A7
  664. ⓪(MOVE.L  A7,(A3)+
  665. ⓪(JSR     SetCurrGemHandle
  666. ⓪(TST.W   (A7)+
  667. ⓪(BNE     ende
  668. ⓪(
  669. ⓪(TRAP    #noErrorTrap
  670. ⓪(DC.W    GeneralErr - $E000
  671. ⓪(ACZ     "TextWindows:Can't set own GEMHdl"
  672. ⓪(SYNC
  673. ⓪(
  674. ⓪ ende
  675. ⓪$END;
  676. ⓪"END saveCurrHdl;
  677. ⓪"(*$L=*)
  678. ⓪ 
  679. ⓪ (*  restoreCurrHdl -- Setzt 'saveArea' als GEM-Hdl. ein. Falls dabei ein
  680. ⓪!*                    Fehlere auftritt, wird ein Laufzeitfehler ausgelößt.
  681. ⓪!*)
  682. ⓪(
  683. ⓪ PROCEDURE restoreCurrHdl (saveArea : GemHandle);
  684. ⓪ 
  685. ⓪"(*$L-*)
  686. ⓪"BEGIN
  687. ⓪$ASSEMBLER
  688. ⓪(TST.L   -4(A3)
  689. ⓪(BEQ     ende            ; jump, if 'saveArea = noGem'
  690. ⓪(
  691. ⓪(SUBQ.L  #2,A7
  692. ⓪(MOVE.L  A7,(A3)+
  693. ⓪(JSR     SetCurrGemHandle
  694. ⓪(TST.W   (A7)+
  695. ⓪(BNE     ende
  696. ⓪(
  697. ⓪(TRAP    #noErrorTrap
  698. ⓪(DC.W    GeneralErr - $E000
  699. ⓪(ACZ     "TextWindows:Can't set old GEMHdl"
  700. ⓪(SYNC
  701. ⓪(
  702. ⓪ ende
  703. ⓪$END;
  704. ⓪"END restoreCurrHdl;
  705. ⓪"(*$L=*)
  706. ⓪ 
  707. ⓪ 
  708. ⓪8(*  pipes  *)
  709. ⓪8(*  =====  *)
  710. ⓪ 
  711. ⓪ (*  createPipe -- Alloc.s and init.s a new pipe.
  712. ⓪!*                'success = FALSE', if out of memory.
  713. ⓪!*)
  714. ⓪!
  715. ⓪ PROCEDURE createPipe (VAR p: pipe; VAR success: BOOLEAN);
  716. ⓪ 
  717. ⓪"BEGIN
  718. ⓪$SysAlloc (p, SIZE (p^));
  719. ⓪$success := (p # NIL);
  720. ⓪$IF ~ success THEN RETURN END;
  721. ⓪$
  722. ⓪$WITH p^ DO
  723. ⓪&head := 1;
  724. ⓪&tail := 1;
  725. ⓪$END;
  726. ⓪"END createPipe;
  727. ⓪ 
  728. ⓪ (*  deletePipe -- Dealloc.s pipe.
  729. ⓪!*)
  730. ⓪!
  731. ⓪ PROCEDURE deletePipe (VAR p: pipe);
  732. ⓪ 
  733. ⓪"BEGIN
  734. ⓪$DEALLOCATE (p, SIZE (p^));
  735. ⓪"END deletePipe;
  736. ⓪ 
  737. ⓪ (*  pipeFull -- Returns, if the pipe is full (further insertions would be
  738. ⓪!*              ignored).
  739. ⓪!*)
  740. ⓪!
  741. ⓪ PROCEDURE pipeFull (p: pipe): BOOLEAN;
  742. ⓪ 
  743. ⓪"BEGIN
  744. ⓪$RETURN p^.tail = p^.head MOD pipeMax + 1
  745. ⓪"END pipeFull;
  746. ⓪ 
  747. ⓪ (*  pipeEmpty -- Returns, if the pipe is empty (further read operations
  748. ⓪!*               would be ignored.
  749. ⓪!*)
  750. ⓪!
  751. ⓪ PROCEDURE pipeEmpty (p: pipe): BOOLEAN;
  752. ⓪ 
  753. ⓪"BEGIN
  754. ⓪$RETURN p^.head = p^.tail
  755. ⓪"END pipeEmpty;
  756. ⓪ 
  757. ⓪ (*  writeIntoPipe -- Writes one character into the pipe, if it is none full,
  758. ⓪!*                   else the call is ignored.
  759. ⓪!*)
  760. ⓪ 
  761. ⓪ PROCEDURE writeIntoPipe (VAR p: pipe; ch: CHAR);
  762. ⓪ 
  763. ⓪"BEGIN
  764. ⓪$IF ~ pipeFull (p)
  765. ⓪$THEN
  766. ⓪&WITH p^ DO
  767. ⓪(data[head] := ch;
  768. ⓪(head := head MOD pipeMax + 1;
  769. ⓪&END;
  770. ⓪$END;
  771. ⓪"END writeIntoPipe;
  772. ⓪ 
  773. ⓪ (*  readFromPipe  -- Reads the element from the pipe which was inserted first
  774. ⓪!*                   (fifo), means the one, that is in there the longest time.
  775. ⓪!*                   If the pipe is empty, 0C is returned.
  776. ⓪!*)
  777. ⓪ 
  778. ⓪ PROCEDURE readFromPipe (VAR p: pipe; VAR ch: CHAR);
  779. ⓪ 
  780. ⓪"BEGIN
  781. ⓪$IF ~ pipeEmpty (p)
  782. ⓪$THEN
  783. ⓪&WITH p^ DO
  784. ⓪(ch := data[tail];
  785. ⓪(tail := tail MOD pipeMax + 1;
  786. ⓪&END;
  787. ⓪$ELSE ch := 0C END;
  788. ⓪"END readFromPipe;
  789. ⓪"
  790. ⓪ 
  791. ⓪8(*  misc. managment  *)
  792. ⓪8(*  ===============  *)
  793. ⓪ 
  794. ⓪ PROCEDURE isValid (hdl: ptrWindow; errorMsg: BOOLEAN): BOOLEAN;
  795. ⓪ 
  796. ⓪"(*$L-*)
  797. ⓪"BEGIN
  798. ⓪$ASSEMBLER
  799. ⓪(JSR     careOfTime      ; evtl. zeitabhänige Proc. aufrufen
  800. ⓪(
  801. ⓪(MOVE.W  -(A3),D1
  802. ⓪(MOVE.L  -(A3),A0
  803. ⓪(CMPA.L  #NIL,A0
  804. ⓪(BNE     cont
  805. ⓪(;       ???? Falls hier etwas eingesetzt wird, muß body geändert werden
  806. ⓪(MOVE.W  #FALSE,(A3)+
  807. ⓪(BRA     return
  808. ⓪ cont
  809. ⓪(MOVE.L  A0,D0
  810. ⓪(AND.W   #$FFFE,D0               ; Keine ungeraden Adr. zulassen
  811. ⓪(MOVE.L  D0,A0
  812. ⓪(MOVE.L  window.magic(A0),D0
  813. ⓪(CMP.L   #windowMagic,D0
  814. ⓪(BEQ     cont2
  815. ⓪(TST.W   D1
  816. ⓪(BEQ     noMsg                   ; keinen Laufzeitfehler auslösen
  817. ⓪(TRAP    #noErrorTrap
  818. ⓪(DC.W    IllegalPointer
  819. ⓪ noMsg   MOVE.W  #FALSE,(A3)+
  820. ⓪(BRA     return
  821. ⓪ cont2
  822. ⓪(MOVE.W  #TRUE,(A3)+
  823. ⓪ return
  824. ⓪$END;
  825. ⓪"END isValid;
  826. ⓪"(*$L=*)
  827. ⓪"
  828. ⓪ PROCEDURE notValid (hdl: Window; errorMsg: BOOLEAN): BOOLEAN;
  829. ⓪ 
  830. ⓪"(*$L-*)
  831. ⓪"BEGIN
  832. ⓪$ASSEMBLER
  833. ⓪(JSR     isValid
  834. ⓪(EORI.W  #1,-2(A3)
  835. ⓪$END;
  836. ⓪"END notValid;
  837. ⓪"(*$L=*)
  838. ⓪"
  839. ⓪ PROCEDURE isMagicOrNIL (hdl: ptrWindow): BOOLEAN;
  840. ⓪ 
  841. ⓪"(*$L-*)
  842. ⓪"BEGIN
  843. ⓪$ASSEMBLER
  844. ⓪(MOVE.L  -4(A3),D0
  845. ⓪(BNE     cont
  846. ⓪(SUBQ.L  #4,A3
  847. ⓪(MOVE.W  #TRUE,(A3)+
  848. ⓪(BRA     ende
  849. ⓪ 
  850. ⓪ cont    MOVE.W  #TRUE,(A3)+
  851. ⓪(JSR     isValid
  852. ⓪ ende
  853. ⓪$END;
  854. ⓪"END isMagicOrNIL;
  855. ⓪"(*$L=*)
  856. ⓪ 
  857. ⓪ 
  858. ⓪8(*  misc. window managment proc.s  *)
  859. ⓪8(*  =============================  *)
  860. ⓪ 
  861. ⓪ (*  isHidden -- Returns 'TRUE', if 'hdl's window is not visible.
  862. ⓪!*)
  863. ⓪!
  864. ⓪ PROCEDURE isHidden (hdl: ptrWindow): BOOLEAN;
  865. ⓪ 
  866. ⓪"BEGIN
  867. ⓪$RETURN WindowBase.hiddenWdw IN WindowBase.WindowFlags (hdl^.handle)
  868. ⓪"END isHidden;
  869. ⓪ 
  870. ⓪ (*  isTop -- Returns 'TRUE, if 'hdl's window is the top window.
  871. ⓪!*)
  872. ⓪ 
  873. ⓪ PROCEDURE isTop (hdl: ptrWindow): BOOLEAN;
  874. ⓪ 
  875. ⓪"BEGIN
  876. ⓪$RETURN WindowBase.topWdw IN WindowBase.WindowFlags (hdl^.handle)
  877. ⓪"END isTop;
  878. ⓪ 
  879. ⓪ (*  setPosAndSize -- Sets the current window position and size.
  880. ⓪!*                   The parm.s are in char. coor.s and the special
  881. ⓪!*                   values 'CenterWindow' and 'MaxWindow' are allowed.
  882. ⓪!*)
  883. ⓪ 
  884. ⓪ PROCEDURE setPosAndSize (hdl: ptrWindow; x, y, w, h: INTEGER);
  885. ⓪ 
  886. ⓪"BEGIN
  887. ⓪$WITH hdl^ DO
  888. ⓪&IF x = CenterWindow THEN x := WindowBase.CenterWdw ELSE x := x * INT(stdCharW) END;
  889. ⓪&IF y = CenterWindow THEN y := WindowBase.CenterWdw ELSE y := y * INT(stdCharH) END;
  890. ⓪&IF w = MaxWindow THEN w := WindowBase.MaxWdw ELSE w := w * charW END;
  891. ⓪&IF h = MaxWindow THEN h := WindowBase.MaxWdw ELSE h := h * charH END;
  892. ⓪&WindowBase.SetWindowWorkArea (handle, Rect (x, y, w, h));
  893. ⓪$END
  894. ⓪"END setPosAndSize;
  895. ⓪"
  896. ⓪"
  897. ⓪8(*  VT52-Emulator, Part I  *)
  898. ⓪8(*  =====================  *)
  899. ⓪ 
  900. ⓪ (*  escAutomat -- Does one step of the finite automat for the VT52-Emulator.
  901. ⓪!*
  902. ⓪!*                in: 'status' - current automat state
  903. ⓪!*                    'ch'     - char to accept
  904. ⓪!*
  905. ⓪!*                out: 'status' - new automat state
  906. ⓪!*                     'result' - generated data (VT52-Comand)
  907. ⓪!*
  908. ⓪!*                fct: Calculates the new automat state and generates a
  909. ⓪!*                     VT52-Comand, while accepting 'ch'.
  910. ⓪!*)
  911. ⓪!
  912. ⓪ PROCEDURE escAutomat (VAR status: escStatusDesc;
  913. ⓪:inCh  : CHAR;
  914. ⓪6VAR result: escResultDesc);
  915. ⓪ 
  916. ⓪"BEGIN
  917. ⓪$WITH result DO
  918. ⓪$
  919. ⓪&comand := nothingEsc;
  920. ⓪&ch := null;
  921. ⓪&
  922. ⓪&CASE status.state OF
  923. ⓪&
  924. ⓪(normalEsc: IF inCh = esc THEN status.state := escEsc
  925. ⓪3ELSE ch := inCh; comand := normalCharEsc END|
  926. ⓪(
  927. ⓪(escEsc   : status.state := normalEsc;
  928. ⓪3CASE inCh OF
  929. ⓪(
  930. ⓪5ctrlE: comand := enhanceOnEsc|
  931. ⓪5ctrlF: comand := enhanceOffEsc|
  932. ⓪5ctrlP: comand := flushEsc|
  933. ⓪(
  934. ⓪5'A'  : comand := cursUpEsc|
  935. ⓪5'B'  : comand := cursDownEsc|
  936. ⓪5'C'  : comand := cursRightEsc|
  937. ⓪5'D'  : comand := cursLeftEsc|
  938. ⓪5'E'  : comand := clsEsc|
  939. ⓪5'H'  : comand := homeEsc|
  940. ⓪5'J'  : comand := eraseEOPEsc|
  941. ⓪5'I'  : comand := reverseLfEsc|
  942. ⓪5'K'  : comand := clrEOLEsc|
  943. ⓪5'L'  : comand := insLnEsc|
  944. ⓪5'M'  : comand := delLnEsc|
  945. ⓪5'Y'  : status.state := gotoYEsc|
  946. ⓪5'b'  : status.state := fgEsc|
  947. ⓪5'c'  : status.state := bgEsc|
  948. ⓪5'd'  : comand := eraseBegDispEsc|
  949. ⓪5'e'  : comand := cursOnEsc|
  950. ⓪5'f'  : comand := cursOffEsc|
  951. ⓪5'j'  : comand := saveCursPosEsc|
  952. ⓪5'k'  : comand := restoreCursPosEsc|
  953. ⓪5'l'  : comand := eraseLnEsc|
  954. ⓪5'o'  : comand := eraseBegLnEsc|
  955. ⓪5'p'  : comand := reverseOnEsc|
  956. ⓪5'q'  : comand := reverseOffEsc|
  957. ⓪5'v'  : comand := wrapOnEsc|
  958. ⓪5'w'  : comand := wrapOffEsc|
  959. ⓪5
  960. ⓪3END|
  961. ⓪3
  962. ⓪(gotoXEsc : IF (inCh >= space) AND (status.first >= space)
  963. ⓪3THEN
  964. ⓪5x := ORD (inCh) - ORD (space);
  965. ⓪5y := ORD (status.first) - ORD (space);
  966. ⓪5comand := gotoXYEsc;
  967. ⓪3END;
  968. ⓪3status.state := normalEsc|
  969. ⓪3
  970. ⓪(gotoYEsc : status.first := inCh;
  971. ⓪3status.state := gotoXEsc|
  972. ⓪3
  973. ⓪(fgEsc   : IF (ORD (inCh) >= ORD ('0')) AND (ORD (inCh) <= ORD ('?'))
  974. ⓪2THEN
  975. ⓪4fgCol := ORD (inCh) - ORD ('0');
  976. ⓪4comand := fgColEsc;
  977. ⓪2END;
  978. ⓪2status.state := normalEsc|
  979. ⓪2
  980. ⓪(bgEsc   : IF (ORD (inCh) >= ORD ('0')) AND (ORD (inCh) <= ORD ('?'))
  981. ⓪2THEN
  982. ⓪4bgCol := ORD (inCh) - ORD ('0');
  983. ⓪4comand := bgColEsc;
  984. ⓪2END;
  985. ⓪2status.state := normalEsc|
  986. ⓪&
  987. ⓪&END;
  988. ⓪&
  989. ⓪$END;
  990. ⓪"END escAutomat;
  991. ⓪ 
  992. ⓪ 
  993. ⓪8(*  buffer reading proc.s  *)
  994. ⓪8(*  =====================  *)
  995. ⓪ 
  996. ⓪ (*  window server  *)
  997. ⓪ 
  998. ⓪ PROCEDURE update (wdw   : WindowBase.Window;
  999. ⓪2env   : ADDRESS;
  1000. ⓪2source,
  1001. ⓪2dest,
  1002. ⓪2new   : Rectangle);
  1003. ⓪ 
  1004. ⓪"VAR   hdl             : ptrWindow;
  1005. ⓪(oldHdl          : GemHandle;
  1006. ⓪(
  1007. ⓪(currElemPtr     : ptrBufferElem;
  1008. ⓪(l, t, r, b, c   : CARDINAL;
  1009. ⓪(dRev            : effectSet;
  1010. ⓪(p               : Point;
  1011. ⓪(collectSpaces   : BOOLEAN;
  1012. ⓪((* $Reg*)x, j, sp,
  1013. ⓪0row     : CARDINAL;
  1014. ⓪"
  1015. ⓪"BEGIN
  1016. ⓪$IF source.w # 0 THEN
  1017. ⓪&DisableClipping (device);
  1018. ⓪&CopyOpaque (device, ADR (stdMFDB), ADR (stdMFDB), source, dest, onlyS);
  1019. ⓪$END;
  1020. ⓪$
  1021. ⓪$IF (new.w <= 0) OR (new.h <= 0) THEN RETURN END;
  1022. ⓪$
  1023. ⓪$hdl := ptrWindow (env);
  1024. ⓪$saveCurrHdl (oldHdl);
  1025. ⓪$
  1026. ⓪$WITH hdl^ DO
  1027. ⓪&
  1028. ⓪&pointToCharPos (hdl, Pnt (new.x, new.y), l, t, voidO);
  1029. ⓪&pointToCharPos (hdl, Pnt (new.x + new.w - 1, new.y + new.h - 1),
  1030. ⓪6r, b, voidO);
  1031. ⓪&
  1032. ⓪&SetWritingMode (device, replaceWrt);
  1033. ⓪&SetFillType (device, solidFill);
  1034. ⓪&SetFillColor (device, bgCol);
  1035. ⓪&SetClipping (device, new);
  1036. ⓪&FillRectangle (device, new);
  1037. ⓪&
  1038. ⓪&SetTextColor (device, fgCol);
  1039. ⓪&setFont (fontHdl, topToBase);
  1040. ⓪&
  1041. ⓪&FOR row := t TO b DO
  1042. ⓪&
  1043. ⓪(currElemPtr := ADR (buffer^[textBufferIndex (hdl, l, row)]);
  1044. ⓪(x := l;
  1045. ⓪(REPEAT
  1046. ⓪(
  1047. ⓪*j := 0; sp := 0;
  1048. ⓪*p := charToPointPos (hdl, x, row);
  1049. ⓪*dRev := currElemPtr^.effects;
  1050. ⓪*REPEAT
  1051. ⓪,redrawStr^[j] := currElemPtr^.ch;
  1052. ⓪,IF (redrawStr^[j] < minADE)
  1053. ⓪/OR (redrawStr^[j] > maxADE)
  1054. ⓪,THEN
  1055. ⓪.redrawStr^[j] := ' ';
  1056. ⓪,END;
  1057. ⓪*
  1058. ⓪,IF redrawStr^[j] = ' ' THEN INC (sp) ELSE sp := 0 END;
  1059. ⓪,collectSpaces := (sp > 2);
  1060. ⓪-
  1061. ⓪,INC (currElemPtr, SIZE (currElemPtr^)); INC (x); INC (j);
  1062. ⓪*UNTIL (x > r) OR (dRev # currElemPtr^.effects) OR collectSpaces;
  1063. ⓪*
  1064. ⓪*IF NOT collectSpaces THEN sp := 0 END;
  1065. ⓪*redrawStr^[j - sp] := 0C;
  1066. ⓪*IF redrawStr^[0] # 0C THEN
  1067. ⓪*
  1068. ⓪,p.y := p.y + topToBase;
  1069. ⓪,
  1070. ⓪,(*  Achtung: String hat 'MaxCard + 1' Elemente (REF nötig) *)
  1071. ⓪,grafText (device, p, redrawStr^, dRev);
  1072. ⓪*
  1073. ⓪*END;
  1074. ⓪*IF collectSpaces THEN
  1075. ⓪*
  1076. ⓪,DEC (x, sp); DEC (currElemPtr, SHORT (SIZE (currElemPtr^)) * sp);
  1077. ⓪,sp := 0;
  1078. ⓪,p := charToPointPos (hdl, x, row);
  1079. ⓪,REPEAT
  1080. ⓪.INC (currElemPtr, SIZE (currElemPtr^)) ; INC (x) ; INC (sp);
  1081. ⓪,UNTIL (x > r) OR (dRev # currElemPtr^.effects)
  1082. ⓪2OR (currElemPtr^.ch # ' ');
  1083. ⓪2
  1084. ⓪,IF inverse IN dRev THEN
  1085. ⓪.SetFillColor (device, fgCol);
  1086. ⓪.FillRectangle (device, Rect (p.x, p.y,
  1087. ⓪KINTEGER (sp) * charW, charH));
  1088. ⓪,END;
  1089. ⓪*
  1090. ⓪*END;
  1091. ⓪*
  1092. ⓪(UNTIL x > r;
  1093. ⓪(
  1094. ⓪&END;(*FOR*)
  1095. ⓪&
  1096. ⓪&DisableClipping (device);
  1097. ⓪#
  1098. ⓪$END;(*WITH*)
  1099. ⓪"
  1100. ⓪$restoreCurrHdl (oldHdl);
  1101. ⓪"END update;
  1102. ⓪ 
  1103. ⓪ PROCEDURE activated (wdw: WindowBase.Window; env: ADDRESS);
  1104. ⓪ 
  1105. ⓪"END activated;
  1106. ⓪ 
  1107. ⓪ PROCEDURE close (wdw: WindowBase.Window; env: ADDRESS);
  1108. ⓪ 
  1109. ⓪"VAR   hdl: ptrWindow;
  1110. ⓪ 
  1111. ⓪"BEGIN
  1112. ⓪$hdl := ptrWindow (env);
  1113. ⓪$
  1114. ⓪$hdl^.closed := TRUE;
  1115. ⓪"END close;
  1116. ⓪ 
  1117. ⓪ PROCEDURE checkSpec (    wdw   : WindowBase.Window;
  1118. ⓪9env   : ADDRESS;
  1119. ⓪5VAR spec  : WindowBase.WindowSpec;
  1120. ⓪9border: LongRect             );
  1121. ⓪"
  1122. ⓪"CONST charAlign       = 8L;
  1123. ⓪"
  1124. ⓪"VAR   hdl: ptrWindow;
  1125. ⓪(amt: LONGINT;
  1126. ⓪$
  1127. ⓪"BEGIN
  1128. ⓪$hdl := ptrWindow (env);
  1129. ⓪$
  1130. ⓪$WITH spec DO
  1131. ⓪$
  1132. ⓪&WITH hdl^ DO
  1133. ⓪(IF visible.w > LONG (INTEGER (columns)) * LONG (charW)
  1134. ⓪(THEN visible.w := LONG (INTEGER (columns)) * LONG (charW) END;
  1135. ⓪(IF visible.h > LONG (INTEGER (rows)) * LONG (charH)
  1136. ⓪(THEN visible.h := LONG (INTEGER (rows)) * LONG (charH) END;
  1137. ⓪&END;
  1138. ⓪&
  1139. ⓪&(*  Umrechnen in Weltkoor.
  1140. ⓪'*)
  1141. ⓪&INC (virtual.x, visible.x);
  1142. ⓪&INC (virtual.y, visible.y);
  1143. ⓪&
  1144. ⓪&border.w := border.x + border.w - 1L;
  1145. ⓪&border.h := border.y + border.h - 1L;
  1146. ⓪&IF virtual.x < border.x THEN virtual.x := border.x END;
  1147. ⓪&IF virtual.y < border.y THEN virtual.y := border.y END;
  1148. ⓪&IF virtual.x > border.w THEN virtual.x := border.w END;
  1149. ⓪&IF virtual.y > border.h THEN virtual.y := border.h END;
  1150. ⓪&(* 'visible' erst nach _korrigiertem_ 'virtual' bestimmen: 14.01.94 TT *)
  1151. ⓪&visible.w := virtual.x + visible.w - 1L;
  1152. ⓪&visible.h := virtual.y + visible.h - 1L;
  1153. ⓪&IF visible.w < border.x THEN visible.w := border.x END;
  1154. ⓪&IF visible.h < border.y THEN visible.h := border.y END;
  1155. ⓪&IF visible.w > border.w THEN visible.w := border.w END;
  1156. ⓪&IF visible.h > border.h THEN visible.h := border.h END;
  1157. ⓪&visible.w := visible.w - virtual.x + 1L;
  1158. ⓪&visible.h := visible.h - virtual.y + 1L;
  1159. ⓪&
  1160. ⓪&INC (virtual.x, charAlign - 1L); DEC (virtual.x, virtual.x MOD charAlign);
  1161. ⓪&
  1162. ⓪&DEC (virtual.x, visible.x);
  1163. ⓪&DEC (virtual.y, visible.y);
  1164. ⓪&
  1165. ⓪&WITH hdl^ DO
  1166. ⓪(amt := visible.x MOD LONG (charW);
  1167. ⓪(INC (virtual.x, amt); DEC (visible.x, amt);
  1168. ⓪(amt := visible.y MOD LONG (charH);
  1169. ⓪(INC (virtual.y, amt); DEC (visible.y, amt);
  1170. ⓪(
  1171. ⓪(DEC (visible.w, visible.w MOD LONG (charW));
  1172. ⓪(DEC (visible.h, visible.h MOD LONG (charH));
  1173. ⓪&END
  1174. ⓪$END;
  1175. ⓪"END checkSpec;
  1176. ⓪ 
  1177. ⓪ PROCEDURE scrollAmt (wdw    : WindowBase.Window;
  1178. ⓪5env    : ADDRESS;
  1179. ⓪5toDo   : WindowBase.WindowScrollMode): LONGINT;
  1180. ⓪2
  1181. ⓪"VAR   spec: WindowBase.WindowSpec; w: ptrWindow;
  1182. ⓪"
  1183. ⓪"BEGIN
  1184. ⓪$w:= env;
  1185. ⓪$WindowBase.GetWindowSpec (wdw, spec);
  1186. ⓪$CASE toDo OF
  1187. ⓪&WindowBase.pageLeftWdw,
  1188. ⓪&WindowBase.pageRightWdw  : RETURN spec.visible.w|
  1189. ⓪&WindowBase.pageUpWdw,
  1190. ⓪&WindowBase.pageDownWdw   : RETURN spec.visible.h|
  1191. ⓪&WindowBase.columnLeftWdw,
  1192. ⓪&WindowBase.columnRightWdw: RETURN LONG (w^.charW)|
  1193. ⓪&WindowBase.rowUpWdw,
  1194. ⓪&WindowBase.rowDownWdw    : RETURN LONG (w^.charH)|
  1195. ⓪$END;
  1196. ⓪"END scrollAmt;
  1197. ⓪ 
  1198. ⓪ 
  1199. ⓪ (*  misc.  *)
  1200. ⓪ 
  1201. ⓪ PROCEDURE takeCareOfForce (hdl: ptrWindow);
  1202. ⓪ 
  1203. ⓪"CONST   horPuffer       = 4;
  1204. ⓪*vertPuffer      = 1;
  1205. ⓪"
  1206. ⓪"PROCEDURE adjust (puffer        :INTEGER;
  1207. ⓪4minP,   maxP,
  1208. ⓪4smallP, highP,
  1209. ⓪4targetP       :CARDINAL) :INTEGER;
  1210. ⓪"
  1211. ⓪$VAR   (* $Reg*) result : INTEGER;
  1212. ⓪*min, max, small,
  1213. ⓪*high, target    : INTEGER;
  1214. ⓪*left, right     : BOOLEAN;
  1215. ⓪$
  1216. ⓪$BEGIN
  1217. ⓪&min := INTEGER (minP); max := INTEGER (maxP);
  1218. ⓪&small := INTEGER (smallP); high := INTEGER (highP);
  1219. ⓪&target := INTEGER (targetP);
  1220. ⓪&
  1221. ⓪&left := ((small + puffer) > target);
  1222. ⓪&right := ((high - puffer) < target);
  1223. ⓪&IF left = right THEN RETURN 0
  1224. ⓪&ELSIF left THEN result := target - small - 2 * puffer
  1225. ⓪&ELSE result:=target - high + 2 * puffer END;
  1226. ⓪&
  1227. ⓪&IF (small + result) < min THEN result := min - small END;
  1228. ⓪&IF (high + result) > max THEN result := max - high END;
  1229. ⓪&
  1230. ⓪&RETURN result;
  1231. ⓪$END adjust;
  1232. ⓪"
  1233. ⓪"VAR     right, bottom,
  1234. ⓪*left, top      : CARDINAL;
  1235. ⓪*rowAmt, colAmt : INTEGER;
  1236. ⓪*spec           : WindowBase.WindowSpec;
  1237. ⓪*(* $Reg*)changed: BOOLEAN;
  1238. ⓪"
  1239. ⓪"BEGIN
  1240. ⓪$IF isHidden (hdl) THEN RETURN END;
  1241. ⓪$
  1242. ⓪$WITH hdl^ DO
  1243. ⓪%IF force # noForce  THEN
  1244. ⓪$
  1245. ⓪&IF NOT isTop (hdl) THEN
  1246. ⓪(WindowBase.PutWindowOnTop (handle);
  1247. ⓪(FlushEvents;                    (* Gib AES Zeit für redraw message *)
  1248. ⓪&END;
  1249. ⓪&
  1250. ⓪&IF (force = forceCursor) OR (force = forceLine) THEN
  1251. ⓪*
  1252. ⓪(WindowBase.GetWindowSpec (handle, spec);
  1253. ⓪(left := CARDINAL (SHORT (spec.visible.x DIV LONG (charW)));
  1254. ⓪(top := CARDINAL (SHORT (spec.visible.y DIV LONG (charH)));
  1255. ⓪(right := left + CARDINAL (SHORT (spec.visible.w DIV LONG (charW))) - 1;
  1256. ⓪(bottom := top + CARDINAL (SHORT (spec.visible.h DIV LONG (charH))) - 1;
  1257. ⓪(
  1258. ⓪(IF force = forceCursor THEN
  1259. ⓪*colAmt := adjust (horPuffer, 0, columns - 1, left, right,
  1260. ⓪<cursX) * charW
  1261. ⓪(ELSE
  1262. ⓪*colAmt := 0
  1263. ⓪(END;
  1264. ⓪(rowAmt := adjust (vertPuffer, 0, rows - 1, top, bottom, cursY)
  1265. ⓪2* charH;
  1266. ⓪(
  1267. ⓪(IF (SHORT (spec.visible.x) + colAmt) < 0
  1268. ⓪(THEN
  1269. ⓪*changed := (spec.visible.w # 0L);
  1270. ⓪*spec.visible.x := 0L;
  1271. ⓪(ELSE
  1272. ⓪*changed := (colAmt # 0);
  1273. ⓪*INC (spec.visible.x, colAmt);
  1274. ⓪(END;
  1275. ⓪(IF (SHORT (spec.visible.y) + rowAmt) < 0 THEN
  1276. ⓪*changed := changed OR (spec.visible.y # 0L);
  1277. ⓪*spec.visible.y := 0L;
  1278. ⓪(ELSE
  1279. ⓪*changed := changed OR (rowAmt # 0);
  1280. ⓪*INC (spec.visible.y, rowAmt);
  1281. ⓪(END;
  1282. ⓪(IF changed THEN
  1283. ⓪*WindowBase.SetWindowSliderPos (handle,
  1284. ⓪Ispec.visible.x, spec.visible.y);
  1285. ⓪(END;
  1286. ⓪*
  1287. ⓪&END;
  1288. ⓪&
  1289. ⓪%END;
  1290. ⓪$END;
  1291. ⓪"END takeCareOfForce;
  1292. ⓪"
  1293. ⓪ PROCEDURE doWaitingRedraws (hdl: ptrWindow);
  1294. ⓪ 
  1295. ⓪"BEGIN
  1296. ⓪$WITH hdl^ DO WITH redrawArea DO
  1297. ⓪$
  1298. ⓪&IF w # 0 THEN
  1299. ⓪(WindowBase.UpdateWindow (handle, update, hdl,
  1300. ⓪ALRect (LONG (x) * LONG (charW),
  1301. ⓪HLONG (y) * LONG (charH),
  1302. ⓪HLONG (w) * LONG (charW),
  1303. ⓪HLONG (h) * LONG (charH)),
  1304. ⓪AWindowBase.noCopyWdw, 0L);
  1305. ⓪(w := 0;
  1306. ⓪&END;
  1307. ⓪&
  1308. ⓪$END END;
  1309. ⓪$takeCareOfForce (hdl);
  1310. ⓪"END doWaitingRedraws;
  1311. ⓪"
  1312. ⓪8(*  redraw pipe proc.s  *)
  1313. ⓪8(*  ==================  *)
  1314. ⓪ 
  1315. ⓪ (*  addRedrawArea -- Adds a new area, to the area(s), that have to be
  1316. ⓪!*                   redrawn. 'area' contains virtual char. coor.s.
  1317. ⓪!*                   May call the redraw proc.
  1318. ⓪!*)
  1319. ⓪ 
  1320. ⓪ PROCEDURE addRedrawArea (hdl: ptrWindow; area: Rectangle);
  1321. ⓪ 
  1322. ⓪"VAR   new: Rectangle;
  1323. ⓪"
  1324. ⓪"BEGIN
  1325. ⓪$WITH hdl^ DO
  1326. ⓪$
  1327. ⓪&IF redrawArea.w = 0 THEN redrawArea := area
  1328. ⓪&ELSE
  1329. ⓪&
  1330. ⓪(new := FrameRects (redrawArea, area);
  1331. ⓪(IF LONG (new.w) * LONG (new.h)
  1332. ⓪+> 2L * (LONG (area.w) * LONG (area.h)
  1333. ⓪3+ LONG (redrawArea.w) * LONG (redrawArea.h))
  1334. ⓪(THEN
  1335. ⓪*doWaitingRedraws (hdl); redrawArea := area
  1336. ⓪(ELSE
  1337. ⓪*redrawArea := new
  1338. ⓪(END;
  1339. ⓪(
  1340. ⓪&END;
  1341. ⓪&
  1342. ⓪$END;
  1343. ⓪"END addRedrawArea;
  1344. ⓪"
  1345. ⓪"
  1346. ⓪8(*  buffer writing proc.s  *)
  1347. ⓪8(*  =====================  *)
  1348. ⓪ 
  1349. ⓪ (*  out of write pipe  *)
  1350. ⓪ 
  1351. ⓪ (*  writeSpaceBlock - Der angegebene Bereich zwischen den beiden Zeichen
  1352. ⓪!*                    positionen wird mit spaces aufgefüllt. Cursorsicht-
  1353. ⓪!*                    barkeit und -position wird nicht beachtet.
  1354. ⓪!*                    'suppressRedraw = TRUE' bedeutet, daß der Bereich
  1355. ⓪!*                    zwar mit Leerzeichen aufgefüllt wird, aber nicht
  1356. ⓪!*                    in die noch neuzuzeichnenden Bereiche eingetragen
  1357. ⓪!*                    wird.
  1358. ⓪!*)
  1359. ⓪ 
  1360. ⓪ PROCEDURE writeSpaceBlock (hdl           : ptrWindow;
  1361. ⓪;left,
  1362. ⓪;top,
  1363. ⓪;right,
  1364. ⓪;bottom        : CARDINAL;
  1365. ⓪;suppressRedraw: BOOLEAN);
  1366. ⓪ 
  1367. ⓪"VAR     i      : bufRange;
  1368. ⓪*j, line: CARDINAL;
  1369. ⓪*elem   : bufferElem;
  1370. ⓪ 
  1371. ⓪"BEGIN
  1372. ⓪$elem.ch := ' ';
  1373. ⓪$elem.effects := effectSet{};
  1374. ⓪$IF hdl^.revMode THEN INCL (elem.effects, inverse) END;
  1375. ⓪$
  1376. ⓪$FOR line := top TO bottom DO
  1377. ⓪$
  1378. ⓪&i := textBufferIndex (hdl, left, line);
  1379. ⓪&FOR j := 1 TO right - left + 1 DO hdl^.buffer^[i] := elem; INC (i) END;
  1380. ⓪&
  1381. ⓪$END;
  1382. ⓪$
  1383. ⓪$IF NOT suppressRedraw
  1384. ⓪$THEN
  1385. ⓪&addRedrawArea (hdl, Rect (left, top, right - left + 1, bottom - top + 1));
  1386. ⓪$END;
  1387. ⓪"END writeSpaceBlock;
  1388. ⓪ 
  1389. ⓪ PROCEDURE scrollUp (hdl: ptrWindow);
  1390. ⓪ 
  1391. ⓪"BEGIN
  1392. ⓪$WITH hdl^ DO
  1393. ⓪$
  1394. ⓪&(*  clear top row, cause it becomes the new bottom row.
  1395. ⓪'*)
  1396. ⓪&writeSpaceBlock (hdl, 0, 0, columns - 1, 0, TRUE);
  1397. ⓪E
  1398. ⓪&(*  move waiting redraws
  1399. ⓪'*)
  1400. ⓪&WITH redrawArea DO
  1401. ⓪(IF y > 0 THEN DEC (y) ELSE DEC (h) END;
  1402. ⓪&END;
  1403. ⓪&
  1404. ⓪&IF textOrg >= ((rows - 1) * columns) THEN
  1405. ⓪(textOrg := 0;
  1406. ⓪&ELSE
  1407. ⓪(textOrg := textOrg + columns
  1408. ⓪&END;
  1409. ⓪&cursIndex := textBufferIndex (hdl, cursX, cursY);
  1410. ⓪&
  1411. ⓪&WindowBase.UpdateWindow (handle, update, hdl,
  1412. ⓪?LRect (0L, 0L,
  1413. ⓪FLONG (INTEGER (columns)) * LONG (charW),
  1414. ⓪FLONG (INTEGER (rows)) * LONG (charH)),
  1415. ⓪?WindowBase.copyVertWdw, LONG (-charH) );
  1416. ⓪E
  1417. ⓪$END;
  1418. ⓪"END scrollUp;
  1419. ⓪"
  1420. ⓪ PROCEDURE scrollDown (hdl: ptrWindow);
  1421. ⓪ 
  1422. ⓪"BEGIN
  1423. ⓪$WITH hdl^ DO
  1424. ⓪&
  1425. ⓪&(*  clear bottom row, cause it becomes the new top row.
  1426. ⓪'*)
  1427. ⓪&writeSpaceBlock (hdl, 0, rows - 1, columns - 1, rows - 1, TRUE);
  1428. ⓪ 
  1429. ⓪&(*  move waiting redraws
  1430. ⓪'*)
  1431. ⓪&WITH redrawArea DO
  1432. ⓪(INC (y);
  1433. ⓪(IF y + h > INTEGER (rows) - 1 THEN DEC (h) END;
  1434. ⓪&END;
  1435. ⓪&
  1436. ⓪&IF textOrg = 0 THEN
  1437. ⓪(textOrg := (rows - 1) * columns
  1438. ⓪&ELSE
  1439. ⓪(textOrg := textOrg - columns
  1440. ⓪&END;
  1441. ⓪&cursIndex := textBufferIndex (hdl, cursX, cursY);
  1442. ⓪&
  1443. ⓪&WindowBase.UpdateWindow (handle, update, hdl,
  1444. ⓪?LRect (0L, 0L,
  1445. ⓪FLONG (INTEGER (columns)) * LONG (charW),
  1446. ⓪FLONG (INTEGER (rows)) * LONG (charH)),
  1447. ⓪?WindowBase.copyVertWdw, LONG (charH) );
  1448. ⓪ 
  1449. ⓪$END;
  1450. ⓪"END scrollDown;
  1451. ⓪ 
  1452. ⓪ PROCEDURE cursorOff (hdl: ptrWindow);
  1453. ⓪ 
  1454. ⓪"BEGIN
  1455. ⓪$WITH hdl^ DO
  1456. ⓪&IF noCursHides = 0 THEN
  1457. ⓪&
  1458. ⓪(IF cursX < columns THEN
  1459. ⓪*WITH buffer^[cursIndex] DO effects := effects / effectSet{inverse} END;
  1460. ⓪*addRedrawArea (hdl, Rect (cursX, cursY, 1, 1));
  1461. ⓪(END;
  1462. ⓪(
  1463. ⓪&END;
  1464. ⓪&INC (noCursHides);
  1465. ⓪$END;
  1466. ⓪"END cursorOff;
  1467. ⓪ 
  1468. ⓪ PROCEDURE cursorOn (hdl: ptrWindow);
  1469. ⓪ 
  1470. ⓪"BEGIN
  1471. ⓪$WITH hdl^ DO
  1472. ⓪&IF noCursHides = 1 THEN
  1473. ⓪&
  1474. ⓪(IF cursX < columns THEN
  1475. ⓪*WITH buffer^[cursIndex] DO effects := effects + effectSet{inverse} END;
  1476. ⓪*addRedrawArea (hdl, Rect (cursX, cursY, 1, 1));
  1477. ⓪(END;
  1478. ⓪(
  1479. ⓪&END;
  1480. ⓪&DEC (noCursHides);
  1481. ⓪$END;
  1482. ⓪"END cursorOn;
  1483. ⓪ 
  1484. ⓪ PROCEDURE setCursor (hdl: ptrWindow; col, row: INTEGER);
  1485. ⓪ 
  1486. ⓪"BEGIN
  1487. ⓪$cursorOff (hdl);
  1488. ⓪$
  1489. ⓪$WITH hdl^ DO
  1490. ⓪$
  1491. ⓪&IF col > INTEGER (columns) THEN cursX := columns - 1
  1492. ⓪&ELSIF col < 0 THEN cursX := 0
  1493. ⓪&ELSE cursX := CARDINAL (col) END;
  1494. ⓪&
  1495. ⓪&IF row >= INTEGER (rows) THEN cursY := rows - 1
  1496. ⓪&ELSIF row < 0 THEN cursY := 0
  1497. ⓪&ELSE cursY := CARDINAL (row) END;
  1498. ⓪&
  1499. ⓪&cursIndex := textBufferIndex (hdl, cursX, cursY);
  1500. ⓪$
  1501. ⓪$END;
  1502. ⓪$
  1503. ⓪$cursorOn (hdl);
  1504. ⓪"END setCursor;
  1505. ⓪"
  1506. ⓪ PROCEDURE clearToEndOfLine (hdl: ptrWindow);
  1507. ⓪ 
  1508. ⓪"BEGIN
  1509. ⓪$WITH hdl^ DO
  1510. ⓪$
  1511. ⓪&IF cursX < columns
  1512. ⓪&THEN
  1513. ⓪(cursorOff (hdl);
  1514. ⓪(writeSpaceBlock(hdl, cursX, cursY, columns - 1, cursY, FALSE);
  1515. ⓪(cursorOn (hdl);
  1516. ⓪&END;
  1517. ⓪&
  1518. ⓪$END;
  1519. ⓪"END clearToEndOfLine;
  1520. ⓪ 
  1521. ⓪ PROCEDURE eraseBegOfLine (hdl: ptrWindow);
  1522. ⓪ 
  1523. ⓪"VAR (* $Reg*) oldCursX: CARDINAL;
  1524. ⓪"
  1525. ⓪"BEGIN
  1526. ⓪$cursorOff (hdl);
  1527. ⓪$
  1528. ⓪$WITH hdl^
  1529. ⓪$DO
  1530. ⓪&oldCursX := cursX;
  1531. ⓪&IF oldCursX = columns THEN DEC (oldCursX) END;
  1532. ⓪&writeSpaceBlock (hdl, 0, cursY, oldCursX, cursY, FALSE);
  1533. ⓪$END;
  1534. ⓪$
  1535. ⓪$cursorOn (hdl);
  1536. ⓪"END eraseBegOfLine;
  1537. ⓪ 
  1538. ⓪ PROCEDURE eraseToEndOfPage (hdl: ptrWindow);
  1539. ⓪ 
  1540. ⓪"BEGIN
  1541. ⓪$cursorOff (hdl);
  1542. ⓪$
  1543. ⓪$WITH hdl^ DO
  1544. ⓪&IF cursX < columns THEN
  1545. ⓪(writeSpaceBlock (hdl, cursX, cursY, columns - 1, cursY, FALSE)
  1546. ⓪&END;
  1547. ⓪&IF (cursY + 1) < rows THEN
  1548. ⓪(writeSpaceBlock (hdl, 0, cursY + 1, columns - 1, rows - 1, FALSE)
  1549. ⓪&END;
  1550. ⓪$END;
  1551. ⓪$
  1552. ⓪$cursorOn (hdl);
  1553. ⓪"END eraseToEndOfPage;
  1554. ⓪ 
  1555. ⓪ PROCEDURE eraseBegOfDisp (hdl: ptrWindow);
  1556. ⓪ 
  1557. ⓪"VAR (* $Reg*) oldCursX   : CARDINAL;
  1558. ⓪"
  1559. ⓪"BEGIN
  1560. ⓪$cursorOff (hdl);
  1561. ⓪$
  1562. ⓪$WITH hdl^ DO
  1563. ⓪$
  1564. ⓪&oldCursX := cursX;
  1565. ⓪&IF oldCursX = columns THEN DEC (oldCursX) END;
  1566. ⓪&writeSpaceBlock (hdl, 0, cursY, oldCursX, cursY, FALSE);
  1567. ⓪&IF cursY > 0 THEN
  1568. ⓪(writeSpaceBlock (hdl, 0, 0, columns - 1, cursY - 1, FALSE);
  1569. ⓪&END;
  1570. ⓪&
  1571. ⓪$END;
  1572. ⓪$
  1573. ⓪$cursorOn (hdl);
  1574. ⓪"END eraseBegOfDisp;
  1575. ⓪ 
  1576. ⓪ PROCEDURE eraseEntireLine (hdl: ptrWindow);
  1577. ⓪ 
  1578. ⓪"BEGIN
  1579. ⓪$cursorOff (hdl);
  1580. ⓪$
  1581. ⓪$WITH hdl^
  1582. ⓪$DO
  1583. ⓪&writeSpaceBlock (hdl, 0, cursY, columns - 1, cursY, FALSE);
  1584. ⓪&setCursor (hdl, 0, cursY);
  1585. ⓪$END;
  1586. ⓪$
  1587. ⓪$cursorOn (hdl);
  1588. ⓪"END eraseEntireLine;
  1589. ⓪ 
  1590. ⓪ PROCEDURE cursorHome (hdl: ptrWindow);
  1591. ⓪ 
  1592. ⓪"BEGIN
  1593. ⓪$setCursor (hdl, 0, 0);
  1594. ⓪"END cursorHome;
  1595. ⓪ 
  1596. ⓪ PROCEDURE clearScreen (hdl: ptrWindow);
  1597. ⓪ 
  1598. ⓪"BEGIN
  1599. ⓪$cursorHome (hdl);
  1600. ⓪$eraseToEndOfPage (hdl);
  1601. ⓪"END clearScreen;
  1602. ⓪ 
  1603. ⓪ PROCEDURE insertLine (hdl: ptrWindow);
  1604. ⓪ 
  1605. ⓪"VAR   f            : Rectangle;
  1606. ⓪1n,
  1607. ⓪((*$Reg*) max,
  1608. ⓪((*$Reg*) i,
  1609. ⓪((*$Reg*) j: CARDINAL;
  1610. ⓪"
  1611. ⓪"BEGIN
  1612. ⓪$cursorOff (hdl);
  1613. ⓪$
  1614. ⓪$WITH hdl^ DO
  1615. ⓪$
  1616. ⓪&(*  Bufferinhalt ab Cursor nach unten schieben.
  1617. ⓪'*)
  1618. ⓪'
  1619. ⓪&max := columns * rows - 1;
  1620. ⓪&IF textOrg = 0 THEN j := max ELSE j := textOrg - 1 END;
  1621. ⓪&IF j < columns THEN i := max - columns + j ELSE i := j - columns END;
  1622. ⓪&FOR n:= 1 TO (rows - 1 - cursY) * columns DO
  1623. ⓪(buffer^[j] := buffer^[i];
  1624. ⓪(IF i = 0 THEN i := max ELSE DEC (i) END;
  1625. ⓪(IF j = 0 THEN j := max ELSE DEC (j) END;
  1626. ⓪&END;
  1627. ⓪'
  1628. ⓪&(*  Zeile in der Curs. steht, löschen.
  1629. ⓪'*)
  1630. ⓪$
  1631. ⓪&FOR i := textBufferIndex (hdl, 0,cursY)
  1632. ⓪/TO textBufferIndex (hdl, columns - 1,cursY) DO
  1633. ⓪(WITH buffer^[i] DO
  1634. ⓪*ch := ' ';
  1635. ⓪*effects := effectSet{};
  1636. ⓪*IF hdl^.revMode THEN INCL (effects, inverse) END;
  1637. ⓪(END;
  1638. ⓪&END;
  1639. ⓪&setCursor (hdl, 0, hdl^.cursY);
  1640. ⓪&
  1641. ⓪&(*  Fensterinhalt restaurieren.
  1642. ⓪'*)
  1643. ⓪&f.x := 0; f.w := INTEGER (columns) * charW;
  1644. ⓪&f.y := INTEGER (cursY) * charH; f.h := INTEGER (rows) * charH - f.y;
  1645. ⓪&IF (f.y >= 0) AND (f.h > 0) THEN
  1646. ⓪(WindowBase.UpdateWindow (hdl^.handle, update, hdl,
  1647. ⓪ALRect (LONG (f.x), LONG (f.y),
  1648. ⓪HLONG (f.w), LONG (f.h)),
  1649. ⓪AWindowBase.copyVertWdw, charH);
  1650. ⓪&END;
  1651. ⓪(
  1652. ⓪$END;
  1653. ⓪$
  1654. ⓪$cursorOn (hdl);
  1655. ⓪"END insertLine;
  1656. ⓪ 
  1657. ⓪ PROCEDURE deleteLine (hdl: ptrWindow);
  1658. ⓪ 
  1659. ⓪"VAR   f            : Rectangle;
  1660. ⓪((*$Reg*) i, (*$Reg*) j: CARDINAL;
  1661. ⓪(n, (*$Reg*) max       : CARDINAL;
  1662. ⓪"
  1663. ⓪"BEGIN
  1664. ⓪$cursorOff (hdl);
  1665. ⓪$
  1666. ⓪$WITH hdl^ DO
  1667. ⓪$
  1668. ⓪&(*  Bufferinhalt ab Cursor nach oben schieben.
  1669. ⓪'*)
  1670. ⓪'
  1671. ⓪&max := columns * rows - 1;
  1672. ⓪&j := textBufferIndex (hdl, 0,cursY);
  1673. ⓪&i := j + columns;
  1674. ⓪&IF i > max THEN i := i - max - 1 END;
  1675. ⓪&FOR n:= 1 TO (rows - 1 - cursY) * columns DO
  1676. ⓪(buffer^[j]:=buffer^[i];
  1677. ⓪(IF i = max THEN i := 0 ELSE INC (i) END;
  1678. ⓪(IF j = max THEN j := 0 ELSE INC (j) END;
  1679. ⓪&END;
  1680. ⓪'
  1681. ⓪&(*  Letzte Zeile löschen.
  1682. ⓪'*)
  1683. ⓪$
  1684. ⓪&FOR i := textBufferIndex (hdl, 0,rows - 1) TO
  1685. ⓪/textBufferIndex (hdl, columns - 1,rows - 1) DO
  1686. ⓪(WITH buffer^[i] DO
  1687. ⓪*ch := ' ';
  1688. ⓪*effects := effectSet{};
  1689. ⓪*IF hdl^.revMode THEN INCL (effects, inverse) END;
  1690. ⓪(END;
  1691. ⓪&END;
  1692. ⓪&setCursor (hdl, 0, hdl^.cursY);
  1693. ⓪&
  1694. ⓪&(*  Fensterinhalt restaurieren.
  1695. ⓪'*)
  1696. ⓪&f.x := 0; f.w := INTEGER (columns) * charW;
  1697. ⓪&f.y := INTEGER (cursY) * charH; f.h := INTEGER (rows) * charH - f.y;
  1698. ⓪&IF (f.y >= 0) AND (f.h > 0) THEN
  1699. ⓪(WindowBase.UpdateWindow (hdl^.handle, update, hdl,
  1700. ⓪ALRect (LONG (f.x), LONG (f.y),
  1701. ⓪HLONG (f.w), LONG (f.h)),
  1702. ⓪AWindowBase.copyVertWdw, LONG (-charH));
  1703. ⓪&END;
  1704. ⓪$
  1705. ⓪$END;
  1706. ⓪$
  1707. ⓪$cursorOn (hdl);
  1708. ⓪"END deleteLine;
  1709. ⓪"
  1710. ⓪ PROCEDURE doBell;
  1711. ⓪ 
  1712. ⓪"(*$L-*)
  1713. ⓪"BEGIN
  1714. ⓪$ASSEMBLER
  1715. ⓪(MOVE.L  #$00020007,-(A7)
  1716. ⓪(MOVE.W  #$3,-(A7)
  1717. ⓪(TRAP    #13             ; BIOS (3) -- Bconout (2, CHR (7))
  1718. ⓪(ADDQ.W  #6,A7
  1719. ⓪$END;
  1720. ⓪"END doBell;
  1721. ⓪"(*$L=*)
  1722. ⓪ 
  1723. ⓪ PROCEDURE initEscAutomat (VAR escStatus: escStatusDesc);
  1724. ⓪ 
  1725. ⓪"BEGIN
  1726. ⓪$escStatus.state := normalEsc;
  1727. ⓪"END initEscAutomat;
  1728. ⓪ 
  1729. ⓪ (*  insertIntoBuffer -- Inserts a single character at the current cursor
  1730. ⓪!*                      position into the text buffer.
  1731. ⓪!*                      If neccesary, interpretation of control characters.
  1732. ⓪!*)
  1733. ⓪ 
  1734. ⓪ PROCEDURE insertIntoBuffer (hdl: ptrWindow; newCh: CHAR);
  1735. ⓪ 
  1736. ⓪"VAR   done      : BOOLEAN;
  1737. ⓪(newEffects: effectSet;
  1738. ⓪ 
  1739. ⓪"BEGIN
  1740. ⓪$WITH hdl^ DO
  1741. ⓪"
  1742. ⓪&(*  if neccasary, interpret the control characters.
  1743. ⓪'*)
  1744. ⓪'
  1745. ⓪&done := FALSE;
  1746. ⓪&IF (newCh < ' ') AND (ctrlMode = interpretCtrl)
  1747. ⓪&THEN
  1748. ⓪(CASE newCh OF
  1749. ⓪(
  1750. ⓪*bell: doBell; done := TRUE|
  1751. ⓪*
  1752. ⓪*bs  : setCursor (hdl, cursX - 1, cursY);
  1753. ⓪0done := TRUE|
  1754. ⓪0
  1755. ⓪*lf  : cursorOff (hdl);
  1756. ⓪0IF (cursY + 1) < rows THEN setCursor (hdl, cursX, cursY + 1)
  1757. ⓪0ELSE scrollUp (hdl) END;
  1758. ⓪0cursorOn (hdl);
  1759. ⓪0done := TRUE|
  1760. ⓪0
  1761. ⓪*cr  : IF cursX # 0 THEN setCursor (hdl, 0, cursY) END;
  1762. ⓪0done := TRUE|
  1763. ⓪*
  1764. ⓪(END;
  1765. ⓪&END;
  1766. ⓪&
  1767. ⓪&(*  if no interpretation, then insert character at cursor position and
  1768. ⓪'*  set cursor to new position (includes: insert area into "redraw pipe").
  1769. ⓪'*)
  1770. ⓪&
  1771. ⓪&IF NOT done THEN
  1772. ⓪(
  1773. ⓪(cursorOff (hdl);
  1774. ⓪(
  1775. ⓪(IF cursX >= columns THEN
  1776. ⓪*IF (cursY + 1) = rows THEN scrollUp (hdl) END;
  1777. ⓪*setCursor (hdl, 0, cursY + 1);
  1778. ⓪(END;
  1779. ⓪&
  1780. ⓪(newEffects := effectSet{};
  1781. ⓪(IF revMode THEN INCL (newEffects, inverse) END;
  1782. ⓪(WITH buffer^[cursIndex]
  1783. ⓪(DO
  1784. ⓪*ch := newCh;
  1785. ⓪*effects := newEffects;
  1786. ⓪(END;
  1787. ⓪(addRedrawArea (hdl, Rect (cursX, cursY, 1, 1));
  1788. ⓪(
  1789. ⓪(IF (wrapAround AND (cursX = columns - 1)) OR (cursX < columns - 1) THEN
  1790. ⓪*setCursor (hdl, cursX + 1, cursY);
  1791. ⓪(END;
  1792. ⓪(
  1793. ⓪(cursorOn (hdl);
  1794. ⓪$
  1795. ⓪&END;
  1796. ⓪$
  1797. ⓪$END;
  1798. ⓪"END insertIntoBuffer;
  1799. ⓪"
  1800. ⓪ (*  flushWritePipe -- Reads the write pipe of 'hdl' char by char and
  1801. ⓪!*                    and inserts that char into the esc Automat. De-
  1802. ⓪!*                    pending on the result of the automat, the text
  1803. ⓪!*                    buffer is changed and data is written into the
  1804. ⓪!*                    "redraw pipe".
  1805. ⓪!*)
  1806. ⓪!
  1807. ⓪ PROCEDURE flushWritePipe (hdl: ptrWindow);
  1808. ⓪ 
  1809. ⓪"VAR   ch       : CHAR;
  1810. ⓪(escResult: escResultDesc;
  1811. ⓪(flush    : BOOLEAN;
  1812. ⓪(
  1813. ⓪"BEGIN
  1814. ⓪$flush := FALSE;
  1815. ⓪$WITH hdl^ DO
  1816. ⓪&WHILE NOT pipeEmpty (writePipe) DO
  1817. ⓪$
  1818. ⓪(readFromPipe (writePipe, ch);
  1819. ⓪(escAutomat (escStatus, ch, escResult);
  1820. ⓪(
  1821. ⓪(CASE escResult.comand OF
  1822. ⓪(
  1823. ⓪*nothingEsc       : |
  1824. ⓪*normalCharEsc    : insertIntoBuffer (hdl, ch)|
  1825. ⓪*
  1826. ⓪*cursUpEsc        : setCursor (hdl, cursX, cursY - 1)|
  1827. ⓪*cursDownEsc      : setCursor (hdl, cursX, cursY + 1)|
  1828. ⓪*cursLeftEsc      : setCursor (hdl, cursX - 1, cursY)|
  1829. ⓪*cursRightEsc     : setCursor (hdl, cursX + 1, cursY)|
  1830. ⓪=
  1831. ⓪*clsEsc           : clearScreen (hdl)|
  1832. ⓪*homeEsc          : cursorHome (hdl)|
  1833. ⓪*eraseEOPEsc      : eraseToEndOfPage (hdl)|
  1834. ⓪*
  1835. ⓪*reverseLfEsc     : cursorOff (hdl);
  1836. ⓪=IF cursY > 0
  1837. ⓪=THEN setCursor (hdl, cursX, cursY - 1)
  1838. ⓪=ELSE scrollDown (hdl) END;
  1839. ⓪=cursorOn (hdl)|
  1840. ⓪=
  1841. ⓪*clrEOLEsc        : clearToEndOfLine (hdl)|
  1842. ⓪*insLnEsc         : insertLine (hdl)|
  1843. ⓪*delLnEsc         : deleteLine (hdl)|
  1844. ⓪*gotoXYEsc        : setCursor (hdl, escResult.x, escResult.y)|
  1845. ⓪*fgColEsc         : fgCol := escResult.fgCol|
  1846. ⓪*bgColEsc         : bgCol := escResult.bgCol|
  1847. ⓪*eraseBegDispEsc  : eraseBegOfDisp (hdl)|
  1848. ⓪*cursOnEsc        : IF noCursHides = 1 THEN cursorOn (hdl) END|
  1849. ⓪*cursOffEsc       : IF noCursHides = 0 THEN cursorOff (hdl) END|
  1850. ⓪*
  1851. ⓪*saveCursPosEsc   : cursXSave := cursX;
  1852. ⓪=cursYSave := cursY|
  1853. ⓪=
  1854. ⓪*restoreCursPosEsc: setCursor (hdl, cursXSave, cursYSave);
  1855. ⓪=cursXSave := 0; cursYSave := 0|
  1856. ⓪=
  1857. ⓪*eraseLnEsc       : eraseEntireLine (hdl)|
  1858. ⓪*eraseBegLnEsc    : eraseBegOfLine (hdl)|
  1859. ⓪*reverseOnEsc     : revMode := TRUE|
  1860. ⓪*reverseOffEsc    : revMode := FALSE|
  1861. ⓪*wrapOnEsc        : wrapAround := TRUE|
  1862. ⓪*wrapOffEsc       : wrapAround := FALSE|
  1863. ⓪*flushEsc         : flush := TRUE|
  1864. ⓪*enhanceOffEsc    : enhanced := FALSE; flush := TRUE|
  1865. ⓪*enhanceOnEsc     : enhanced := TRUE; flush := TRUE|
  1866. ⓪*
  1867. ⓪(END;
  1868. ⓪(
  1869. ⓪&END;
  1870. ⓪&IF NOT enhanced OR flush THEN doWaitingRedraws (hdl) END;
  1871. ⓪$END;
  1872. ⓪"END flushWritePipe;
  1873. ⓪"
  1874. ⓪ 
  1875. ⓪ (*  into write pipe  *)
  1876. ⓪ 
  1877. ⓪ (*  insertIntoWritePipe -- Appends a string to a windows write pipe and
  1878. ⓪!*                         checks for enhanced or flush esc sequences.
  1879. ⓪!*                         Calls write pipe flush proc.
  1880. ⓪!*)
  1881. ⓪ 
  1882. ⓪ PROCEDURE insertIntoWritePipe (hdl: Window; REF str: ARRAY OF CHAR);
  1883. ⓪ 
  1884. ⓪"VAR   (* $Reg*) i: CARDINAL;
  1885. ⓪(escResult : escResultDesc;
  1886. ⓪(
  1887. ⓪"BEGIN
  1888. ⓪$WITH hdl^ DO
  1889. ⓪$
  1890. ⓪&i := 0;
  1891. ⓪&WHILE (i <= HIGH (str)) AND (str[i] # 0C) DO
  1892. ⓪&
  1893. ⓪(IF pipeFull (writePipe) THEN flushWritePipe (hdl) END;
  1894. ⓪(writeIntoPipe (writePipe, str[i]);
  1895. ⓪(
  1896. ⓪(escAutomat (pipeEscStatus, str[i], escResult);
  1897. ⓪(IF (escResult.comand = flushEsc) OR (escResult.comand = enhanceOffEsc)
  1898. ⓪+OR (escResult.comand = enhanceOnEsc)
  1899. ⓪(THEN flushWritePipe (hdl) END;
  1900. ⓪(
  1901. ⓪(INC (i);
  1902. ⓪&END;
  1903. ⓪&IF NOT enhanced THEN flushWritePipe (hdl) END;
  1904. ⓪&
  1905. ⓪$END;
  1906. ⓪"END insertIntoWritePipe;
  1907. ⓪ 
  1908. ⓪ 
  1909. ⓪8(*  misc. help proc.s  *)
  1910. ⓪8(*  =================  *)
  1911. ⓪ 
  1912. ⓪ (*  internal... -- These proc.s are used to execute some esc sequences,
  1913. ⓪!*                 without using the 'writePipe', to avoid conflict with
  1914. ⓪!*                 user esc sequences.
  1915. ⓪!*                 They are for internal use only and flush all pipes.
  1916. ⓪!*)
  1917. ⓪ 
  1918. ⓪ PROCEDURE internalFlushPipe (hdl: ptrWindow);
  1919. ⓪ 
  1920. ⓪"BEGIN
  1921. ⓪$flushWritePipe (hdl);
  1922. ⓪$doWaitingRedraws (hdl);
  1923. ⓪"END internalFlushPipe;
  1924. ⓪ 
  1925. ⓪ PROCEDURE internalCursorOn (hdl: ptrWindow);
  1926. ⓪"VAR oldForce: ForceMode;
  1927. ⓪"BEGIN
  1928. ⓪$oldForce:= hdl^.force;
  1929. ⓪$hdl^.force:= forceCursor;
  1930. ⓪$flushWritePipe (hdl);
  1931. ⓪$cursorOn (hdl);
  1932. ⓪$doWaitingRedraws (hdl);
  1933. ⓪$hdl^.force:= oldForce
  1934. ⓪"END internalCursorOn;
  1935. ⓪"
  1936. ⓪ PROCEDURE internalCursorOff (hdl: ptrWindow);
  1937. ⓪ 
  1938. ⓪"BEGIN
  1939. ⓪$flushWritePipe (hdl);
  1940. ⓪$cursorOff (hdl);
  1941. ⓪$doWaitingRedraws (hdl);
  1942. ⓪"END internalCursorOff;
  1943. ⓪ 
  1944. ⓪ PROCEDURE myShow (hdl: Window);
  1945. ⓪"BEGIN
  1946. ⓪$IF notValid (hdl, TRUE) THEN RETURN END;
  1947. ⓪$IF isHidden (hdl) THEN
  1948. ⓪&internalFlushPipe (hdl);
  1949. ⓪&WindowBase.OpenWindow (hdl^.handle);
  1950. ⓪$END;
  1951. ⓪$FlushEvents;
  1952. ⓪"END myShow;
  1953. ⓪ 
  1954. ⓪8(*  exported proc.s  *)
  1955. ⓪8(*  ===============  *)
  1956. ⓪ 
  1957. ⓪ (*  managmant proc.s  (ignoring pipe and similiar objects) *)
  1958. ⓪ 
  1959. ⓪ PROCEDURE Open (VAR hdl            : Window;      newColumns, newRows: CARDINAL;
  1960. ⓪4qualities      : WQualitySet; mode               : ShowMode;
  1961. ⓪4newForce       : ForceMode;   wName     : ARRAY OF CHAR;
  1962. ⓪4colOrg, rowOrg : INTEGER;     wOrg, hOrg         : INTEGER;
  1963. ⓪0VAR success        : BOOLEAN);
  1964. ⓪ 
  1965. ⓪"VAR   a               : LONGCARD;
  1966. ⓪(maxPnt          : Point;
  1967. ⓪(elems           : WindowBase.WdwElemSet;
  1968. ⓪(spec            : WindowBase.WindowSpec;
  1969. ⓪(oldGem          : RECORD
  1970. ⓪<active : BOOLEAN;
  1971. ⓪<hdl    : GemHandle;
  1972. ⓪:END;
  1973. ⓪ 
  1974. ⓪"BEGIN
  1975. ⓪$oldGem.active := GemActive ();
  1976. ⓪$IF oldGem.active THEN oldGem.hdl := CurrGemHandle() END;
  1977. ⓪$
  1978. ⓪$IF Length (wName) > maxNameLen THEN wName[maxNameLen] := 0C END;
  1979. ⓪$
  1980. ⓪$IF windowRoot = noWindPtr THEN
  1981. ⓪&success := connectToGem ();
  1982. ⓪&IF ~ success THEN RETURN END;
  1983. ⓪$END;
  1984. ⓪$SetCurrGemHandle (gemHdl, success);
  1985. ⓪$
  1986. ⓪$SysAlloc (hdl, SIZE (hdl^));
  1987. ⓪$IF (hdl = NIL) OR ~ success THEN
  1988. ⓪&IF windowRoot = noWindPtr THEN deConnectFromGem END;
  1989. ⓪&success := FALSE;
  1990. ⓪&IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;
  1991. ⓪&RETURN
  1992. ⓪$END;
  1993. ⓪$SysAlloc (hdl^.redrawStr, newColumns + 1);
  1994. ⓪$IF hdl^.redrawStr = NIL THEN
  1995. ⓪&IF windowRoot = noWindPtr THEN deConnectFromGem END;
  1996. ⓪&success := FALSE;
  1997. ⓪&IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;
  1998. ⓪&DEALLOCATE (hdl, SIZE (hdl^));
  1999. ⓪&RETURN
  2000. ⓪$END;
  2001. ⓪$
  2002. ⓪$AESWindows.UpdateWindow (TRUE);
  2003. ⓪$setFont (StdFontHdl, StdFontHeight);
  2004. ⓪$getCharSizes (hdl);
  2005. ⓪$AESWindows.UpdateWindow (FALSE);
  2006. ⓪$WITH hdl^ DO
  2007. ⓪&fontHdl:= StdFontHdl;
  2008. ⓪&ctrlMode := interpretCtrl;
  2009. ⓪&echoMode := restrictedEcho;
  2010. ⓪&wrapAround := TRUE;
  2011. ⓪&initEscAutomat (escStatus);
  2012. ⓪&initEscAutomat (pipeEscStatus);
  2013. ⓪&closed := FALSE;
  2014. ⓪&bgCol := white;
  2015. ⓪&fgCol := black;
  2016. ⓪&revMode := FALSE;
  2017. ⓪&cursX := 0;
  2018. ⓪&cursY := 0;
  2019. ⓪&cursIndex := 0;
  2020. ⓪&noCursHides := 1;      (* Noch ist er aus *)
  2021. ⓪&textOrg := 0;
  2022. ⓪&columns := newColumns;
  2023. ⓪&rows := newRows;
  2024. ⓪&force := newForce;
  2025. ⓪&quality := qualities;
  2026. ⓪&enhanced := FALSE;
  2027. ⓪ 
  2028. ⓪&createPipe (writePipe, success);
  2029. ⓪&IF ~ success THEN
  2030. ⓪(DEALLOCATE( hdl^.redrawStr, 0L);  (* !MS *)
  2031. ⓪(DEALLOCATE (hdl, 0L);
  2032. ⓪(IF windowRoot = noWindPtr THEN deConnectFromGem END;
  2033. ⓪(IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;
  2034. ⓪(RETURN
  2035. ⓪&END;
  2036. ⓪ 
  2037. ⓪&redrawArea.w := 0;
  2038. ⓪ 
  2039. ⓪&a := LONG (rows) * LONG (columns);
  2040. ⓪&IF a <= LONG (bufMax) THEN
  2041. ⓪(SysAlloc (buffer, a * TSIZE (bufferElem))
  2042. ⓪&END;
  2043. ⓪&IF (a > LONG (bufMax)) OR (buffer = NIL) THEN
  2044. ⓪(deletePipe (writePipe);
  2045. ⓪(DEALLOCATE( hdl^.redrawStr, 0L);  (* !MS *)
  2046. ⓪(DEALLOCATE (hdl, 0L);
  2047. ⓪(IF windowRoot = noWindPtr THEN deConnectFromGem END;
  2048. ⓪(success := FALSE;
  2049. ⓪(IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;
  2050. ⓪(RETURN
  2051. ⓪&END;
  2052. ⓪&
  2053. ⓪&elems := WindowBase.WdwElemSet {};
  2054. ⓪&IF titled IN qualities THEN INCL (elems, WindowBase.titleElem) END;
  2055. ⓪&IF movable IN qualities THEN INCL (elems, WindowBase.moveElem) END;
  2056. ⓪&IF dynamic IN qualities THEN
  2057. ⓪(elems := elems + WindowBase.WdwElemSet {WindowBase.sizeElem,
  2058. ⓪PWindowBase.scrollElem}
  2059. ⓪&END;
  2060. ⓪&IF closable IN qualities THEN INCL (elems, WindowBase.closeElem) END;
  2061. ⓪&WindowBase.SysCreateWindow (handle, elems,
  2062. ⓪Bupdate, checkSpec, scrollAmt, activated, close,
  2063. ⓪Bhdl);
  2064. ⓪&
  2065. ⓪&IF WindowBase.WindowState (handle) # WindowBase.okWdw THEN
  2066. ⓪(WindowBase.ResetWindowState (handle);
  2067. ⓪(DEALLOCATE (buffer, 0L);
  2068. ⓪(deletePipe (writePipe);
  2069. ⓪(DEALLOCATE (hdl^.redrawStr, 0L);        (* !MS *)
  2070. ⓪(DEALLOCATE (hdl, 0L);
  2071. ⓪(IF windowRoot = noWindPtr THEN deConnectFromGem END;
  2072. ⓪(success := FALSE;
  2073. ⓪(IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;
  2074. ⓪(RETURN
  2075. ⓪&END;
  2076. ⓪&WindowBase.GetWindowSpec (handle, spec);
  2077. ⓪&spec.virtual.w := LONGINT (LONG (columns)) * LONG (charW);
  2078. ⓪&spec.virtual.h := LONGINT (LONG (rows)) * LONG (charH);
  2079. ⓪&WindowBase.SetWindowSpec (handle, spec);
  2080. ⓪&setPosAndSize (hdl, colOrg, rowOrg, wOrg, hOrg);
  2081. ⓪&
  2082. ⓪&IF titled IN quality THEN
  2083. ⓪(WindowBase.SetWindowString (handle, WindowBase.titleWdwStr, wName)
  2084. ⓪&END;
  2085. ⓪&
  2086. ⓪&next := windowRoot;        (* Einketten *)
  2087. ⓪&windowRoot := hdl;
  2088. ⓪&magic := windowMagic;
  2089. ⓪&level := modLevel;
  2090. ⓪&clearScreen (hdl);
  2091. ⓪&IF noHideWdw = mode THEN
  2092. ⓪(myShow (hdl);
  2093. ⓪(success := WindowBase.WindowState (handle) = WindowBase.okWdw;
  2094. ⓪(WindowBase.ResetWindowState (handle);
  2095. ⓪(IF NOT success THEN Close (hdl) END;
  2096. ⓪&END;  (* 'Show' macht 'FlushEvents'  *)
  2097. ⓪&(*  Muß hier noch ein evtl. gesetzter Enhanced-Status abgemeldet werden
  2098. ⓪'*  oder sendet das GEM einen 'NewTop'-Event, bei dem dies erledigt wird?
  2099. ⓪'*)
  2100. ⓪$
  2101. ⓪$END;(*WITH*)
  2102. ⓪$
  2103. ⓪$IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;
  2104. ⓪"END Open;
  2105. ⓪ 
  2106. ⓪ PROCEDURE SysOpen (VAR hdl           : Window;     columns, rows: CARDINAL;
  2107. ⓪7qualitys      : WQualitySet;mode         : ShowMode;
  2108. ⓪7force         : ForceMode;  wName    : ARRAY OF CHAR;
  2109. ⓪7colOrg, rowOrg: INTEGER;    wOrg, hOrg   : INTEGER;
  2110. ⓪3VAR success       : BOOLEAN);
  2111. ⓪"(*$L-*)
  2112. ⓪"BEGIN
  2113. ⓪$ASSEMBLER
  2114. ⓪(MOVE.L  -32(A3),-(A7)
  2115. ⓪(MOVE.L  -4(A3),-(A7)
  2116. ⓪(JSR     Open
  2117. ⓪(MOVE.L  (A7)+,A0
  2118. ⓪(MOVE.L  (A7)+,A1
  2119. ⓪(TST     (A0)
  2120. ⓪(BEQ     ende
  2121. ⓪(CLR.W   Window.level(A1)
  2122. ⓪&ende:
  2123. ⓪$END
  2124. ⓪"END SysOpen;
  2125. ⓪"(*$L=*)
  2126. ⓪ 
  2127. ⓪ 
  2128. ⓪ PROCEDURE ReSpecify (    hdl        : Window;
  2129. ⓪9newColumns,
  2130. ⓪9newRows    : CARDINAL;
  2131. ⓪9wName      : ARRAY OF CHAR;
  2132. ⓪5VAR success    : BOOLEAN);
  2133. ⓪"(*
  2134. ⓪#* TT: Wenn newColumns = 0, wird in "wName" ein Fontname und in "newRows"
  2135. ⓪#*     die gewünschte Größe in "Pts" erwartet. Ist "hdl" NIL, wird
  2136. ⓪#*     der Standard-Font damit definiert, sonst der für das Fenster.
  2137. ⓪#*     Der Standard-Font wird bei allen neu erzeugten Fenstern verwendet.
  2138. ⓪#*)
  2139. ⓪ 
  2140. ⓪"VAR     a       : LONGCARD;
  2141. ⓪*newAddr : ADDRESS;
  2142. ⓪*sizeChg : BOOLEAN;      (* Wurde Größe des Buffers verändert? *)
  2143. ⓪*spec    : WindowBase.WindowSpec;
  2144. ⓪*fontname: ARRAY [0..64] OF CHAR;
  2145. ⓪*fontnr  : CARDINAL;
  2146. ⓪*w, h, c : CARDINAL;
  2147. ⓪*ch      : CHAR;
  2148. ⓪*aespb   : GEMBase.AESPB;
  2149. ⓪*vdipb   : GEMBase.VDIPB;
  2150. ⓪*newFont : BOOLEAN;
  2151. ⓪*oldGem  : RECORD active: BOOLEAN; hdl: GemHandle; END;
  2152. ⓪ 
  2153. ⓪"BEGIN
  2154. ⓪$IF notValid (hdl, TRUE) & ((hdl#NIL) OR (newColumns#0)) THEN RETURN END;
  2155. ⓪$
  2156. ⓪$newFont:= FALSE;
  2157. ⓪$IF newColumns = 0 THEN
  2158. ⓪&(*
  2159. ⓪'* Font setzen
  2160. ⓪'*)
  2161. ⓪&IF hdl = NIL THEN
  2162. ⓪(oldGem.active := GemActive ();
  2163. ⓪(IF oldGem.active THEN oldGem.hdl := CurrGemHandle() END;
  2164. ⓪(IF windowRoot = noWindPtr THEN
  2165. ⓪*success := connectToGem ();
  2166. ⓪*IF ~success THEN RETURN END;
  2167. ⓪(END;
  2168. ⓪(SetCurrGemHandle (gemHdl, success);
  2169. ⓪&END;
  2170. ⓪&GEMBase.GetPBs (gemHdl, vdipb, aespb); (* für "GetFaceName" *)
  2171. ⓪&success:= FALSE;
  2172. ⓪&FOR fontnr:= 1 TO Fonts DO
  2173. ⓪(GetFaceName (device, fontnr, fontname);
  2174. ⓪(IF StrEqual (fontname, wName) THEN
  2175. ⓪*success:= TRUE;
  2176. ⓪*IF hdl = NIL THEN
  2177. ⓪,StdFontHdl:= vdipb.iooff^[0];
  2178. ⓪,SetTextFace (device, StdFontHdl);
  2179. ⓪,SetPtsTHeight (device, newRows, c, c, c, c); (* Größe setzen *)
  2180. ⓪,getCharSize (w, h, StdFontHeight, ch, ch);
  2181. ⓪,IF windowRoot = noWindPtr THEN deConnectFromGem END;
  2182. ⓪,IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;
  2183. ⓪,RETURN
  2184. ⓪*ELSE
  2185. ⓪,WITH hdl^ DO
  2186. ⓪.IF fontHdl # ORD (vdipb.iooff^[0]) THEN
  2187. ⓪0fontHdl:= vdipb.iooff^[0];
  2188. ⓪0newFont:= TRUE
  2189. ⓪.END;
  2190. ⓪.IF fontSize # newRows THEN
  2191. ⓪0fontSize:= newRows;
  2192. ⓪0newFont:= TRUE
  2193. ⓪.END
  2194. ⓪,END
  2195. ⓪*END
  2196. ⓪(END;
  2197. ⓪&END;
  2198. ⓪&IF ~newFont THEN
  2199. ⓪(IF hdl = NIL THEN
  2200. ⓪*IF windowRoot = noWindPtr THEN deConnectFromGem END;
  2201. ⓪*IF oldGem.active THEN SetCurrGemHandle (oldGem.hdl, voidO) END;
  2202. ⓪(END;
  2203. ⓪(RETURN
  2204. ⓪&END;
  2205. ⓪$END;
  2206. ⓪ 
  2207. ⓪$IF Length (wName) > maxNameLen THEN wName[maxNameLen] := 0C END;
  2208. ⓪ 
  2209. ⓪$WITH hdl^ DO
  2210. ⓪&sizeChg := (newColumns # columns) OR (newRows # rows);
  2211. ⓪&IF sizeChg THEN
  2212. ⓪(IF newFont THEN
  2213. ⓪*SetTextFace (device, fontHdl);
  2214. ⓪*SetPtsTHeight (device, newRows, c, c, c, c); (* Größe setzen *)
  2215. ⓪*getCharSizes (hdl);
  2216. ⓪(ELSE
  2217. ⓪*a := LONG (newRows) * LONG (newColumns);
  2218. ⓪*IF a <= LONG (bufMax) THEN SysAlloc (newAddr,a * TSIZE (bufferElem)) END;
  2219. ⓪*IF (a > LONG (bufMax)) OR (newAddr = NIL) THEN
  2220. ⓪,success := FALSE;
  2221. ⓪,RETURN
  2222. ⓪*END;
  2223. ⓪*DEALLOCATE (buffer, 0L);
  2224. ⓪*columns := newColumns;
  2225. ⓪*rows := newRows;
  2226. ⓪*buffer := newAddr;
  2227. ⓪*textOrg := 0;
  2228. ⓪*cursIndex := 0;
  2229. ⓪(END;
  2230. ⓪(
  2231. ⓪(WindowBase.GetWindowSpec (handle, spec);
  2232. ⓪(spec.virtual.w := LONGINT (LONG (columns)) * LONG (charW);
  2233. ⓪(spec.virtual.h := LONGINT (LONG (rows)) * LONG (charH);
  2234. ⓪(WindowBase.SetWindowSpec (handle, spec);
  2235. ⓪ 
  2236. ⓪(IF newFont THEN
  2237. ⓪*WindowBase.RedrawWindow (handle);
  2238. ⓪(ELSE
  2239. ⓪*clearScreen (hdl);
  2240. ⓪(END;
  2241. ⓪(FlushEvents;              (* Mögl. zu redraw geben *)
  2242. ⓪&END;
  2243. ⓪&
  2244. ⓪&IF ~newFont & (titled IN quality) THEN
  2245. ⓪(WindowBase.SetWindowString (handle, WindowBase.titleWdwStr, wName)
  2246. ⓪&END;
  2247. ⓪&
  2248. ⓪$END;(*WITH*)
  2249. ⓪$success:= TRUE
  2250. ⓪"END ReSpecify;
  2251. ⓪ 
  2252. ⓪ PROCEDURE Close (VAR hdl: Window);
  2253. ⓪ 
  2254. ⓪"PROCEDURE delete (VAR ptr: ptrWindow; toDelete: ptrWindow);
  2255. ⓪ 
  2256. ⓪$BEGIN
  2257. ⓪&IF ptr = NIL THEN HALT END;  (* Dürfte nie vorkommen!! *)
  2258. ⓪&IF ptr = toDelete THEN
  2259. ⓪(ptr := toDelete^.next;
  2260. ⓪(DEALLOCATE (toDelete, 0L);
  2261. ⓪&ELSE delete (ptr^.next, toDelete) END;
  2262. ⓪$END delete;
  2263. ⓪ 
  2264. ⓪"BEGIN
  2265. ⓪$IF notValid (hdl, FALSE) THEN RETURN END;
  2266. ⓪$
  2267. ⓪$WITH hdl^ DO
  2268. ⓪ (*
  2269. ⓪&IF NOT isHidden (hdl) THEN
  2270. ⓪((* evtl. 'ShrinkBox' *)
  2271. ⓪(WindowBase.CloseWindow (handle)
  2272. ⓪&END;
  2273. ⓪!*)
  2274. ⓪&WindowBase.DeleteWindow (handle);
  2275. ⓪&DEALLOCATE (buffer, 0L);
  2276. ⓪&DEALLOCATE (redrawStr, columns + 1);
  2277. ⓪&deletePipe (hdl^.writePipe);
  2278. ⓪&magic := 0L;
  2279. ⓪$END;
  2280. ⓪$
  2281. ⓪$delete (windowRoot, hdl);
  2282. ⓪$hdl := NIL; (* Ist wohl unnötig, da es DEALLOCATE macht. *)
  2283. ⓪"
  2284. ⓪$FlushEvents;
  2285. ⓪$
  2286. ⓪$IF windowRoot = noWindPtr THEN deConnectFromGem END;
  2287. ⓪"END Close;
  2288. ⓪ 
  2289. ⓪ PROCEDURE Hide (hdl: Window);
  2290. ⓪ 
  2291. ⓪"BEGIN
  2292. ⓪$IF notValid (hdl, TRUE) THEN RETURN END;
  2293. ⓪$IF ~ isHidden (hdl) THEN
  2294. ⓪$
  2295. ⓪&WindowBase.CloseWindow (hdl^.handle);
  2296. ⓪&WindowBase.ResetWindowState (hdl^.handle);
  2297. ⓪&FlushEvents;
  2298. ⓪&
  2299. ⓪$END;
  2300. ⓪"END Hide;
  2301. ⓪ 
  2302. ⓪ PROCEDURE Show (hdl: Window);
  2303. ⓪ 
  2304. ⓪"BEGIN
  2305. ⓪$myShow (hdl);
  2306. ⓪$WindowBase.ResetWindowState (hdl^.handle);
  2307. ⓪"END Show;
  2308. ⓪ 
  2309. ⓪ PROCEDURE GetPosAndSize (hdl: Window; VAR col, row, w, h: INTEGER);
  2310. ⓪ 
  2311. ⓪"VAR   frame: Rectangle;
  2312. ⓪ 
  2313. ⓪"BEGIN
  2314. ⓪$IF notValid (hdl, TRUE) THEN col := 0; row := 0 ; w := 0; h := 0; RETURN END;
  2315. ⓪$WITH hdl^ DO
  2316. ⓪&frame:= WindowBase.WindowWorkArea (handle);
  2317. ⓪&col:= (frame.x+INT(stdCharW) DIV 2) DIV INT(stdCharW);
  2318. ⓪&row:= (frame.y+INT(stdCharH) DIV 2) DIV INT(stdCharH);
  2319. ⓪&w:= (frame.w) DIV charW; h:= (frame.h) DIV charH;
  2320. ⓪$END
  2321. ⓪"END GetPosAndSize;
  2322. ⓪ 
  2323. ⓪ PROCEDURE SetPosAndSize (hdl: Window; col, row, w, h: INTEGER);
  2324. ⓪ 
  2325. ⓪"BEGIN
  2326. ⓪$IF notValid (hdl, TRUE) THEN RETURN END;
  2327. ⓪$
  2328. ⓪$setPosAndSize (hdl, col, row, w, h);
  2329. ⓪"END SetPosAndSize;
  2330. ⓪ 
  2331. ⓪ PROCEDURE IsTop (hdl: Window): BOOLEAN;
  2332. ⓪ 
  2333. ⓪"BEGIN
  2334. ⓪$IF notValid (hdl, TRUE) THEN RETURN FALSE END;
  2335. ⓪$
  2336. ⓪$RETURN isTop (hdl)
  2337. ⓪"END IsTop;
  2338. ⓪ 
  2339. ⓪ PROCEDURE PutOnTop (hdl: Window);
  2340. ⓪ 
  2341. ⓪"BEGIN
  2342. ⓪$IF notValid (hdl, TRUE) THEN RETURN END;
  2343. ⓪$
  2344. ⓪$WindowBase.PutWindowOnTop (hdl^.handle);
  2345. ⓪"END PutOnTop;
  2346. ⓪"
  2347. ⓪ PROCEDURE WasClosed (hdl: Window): BOOLEAN;
  2348. ⓪ 
  2349. ⓪"(*$L-*)
  2350. ⓪"BEGIN
  2351. ⓪$ASSEMBLER
  2352. ⓪(MOVE.L  -4(A3),-(A7)
  2353. ⓪(MOVE.W  #TRUE,(A3)+
  2354. ⓪(JSR     isValid
  2355. ⓪(TST.W   -(A3)
  2356. ⓪(BNE     valid
  2357. ⓪(ADDQ.L  #4,A7
  2358. ⓪(MOVE.W  #FALSE,(A3)+
  2359. ⓪(BRA     ende
  2360. ⓪ valid
  2361. ⓪(
  2362. ⓪(MOVE.L  (A7)+,A0
  2363. ⓪(MOVE.W  window.closed(A0),(A3)+
  2364. ⓪(MOVE.W  #FALSE,window.closed(A0)
  2365. ⓪ ende
  2366. ⓪$END;
  2367. ⓪"END WasClosed;
  2368. ⓪"(*$L=*)
  2369. ⓪ 
  2370. ⓪ 
  2371. ⓪ VAR     spot       : Point;
  2372. ⓪(validBut   : BOOLEAN;
  2373. ⓪(
  2374. ⓪ PROCEDURE butCatcher (clicks  : CARDINAL;
  2375. ⓪6loc     : Point;
  2376. ⓪6buts    : MButtonSet;
  2377. ⓪6specials: SpecialKeySet): BOOLEAN;
  2378. ⓪ 
  2379. ⓪"BEGIN
  2380. ⓪$spot := loc;
  2381. ⓪$validBut := TRUE;
  2382. ⓪$
  2383. ⓪$RETURN FALSE;
  2384. ⓪"END butCatcher;
  2385. ⓪ 
  2386. ⓪ PROCEDURE DetectChar (REF targets: ARRAY OF Window; noTrg: CARDINAL;
  2387. ⓪:mode   : DetectMode;
  2388. ⓪6VAR p  : Point;
  2389. ⓪6VAR hdl: Window;      VAR column,row  : CARDINAL;
  2390. ⓪6VAR box: Rectangle;   VAR result      : DetectResult);
  2391. ⓪4
  2392. ⓪"VAR   oldGem  : GemHandle;
  2393. ⓪(success,
  2394. ⓪(doInit  : BOOLEAN;
  2395. ⓪(i       : CARDINAL;
  2396. ⓪(wdw     : WindowBase.Window;
  2397. ⓪(wbRes   : WindowBase.DetectWdwResult;
  2398. ⓪(
  2399. ⓪(proc    : EventProc;
  2400. ⓪:
  2401. ⓪"BEGIN
  2402. ⓪$(*  Init. exit val.s, for possible RETURN.
  2403. ⓪%*)
  2404. ⓪$result := foundNothing;
  2405. ⓪$hdl := noWindPtr;
  2406. ⓪$IF mode = requestPnt THEN p := Pnt (0, 0) END;
  2407. ⓪$
  2408. ⓪$(*  Test target validity.
  2409. ⓪%*)
  2410. ⓪$IF (noTrg = 0) OR (noTrg > (HIGH (targets) + 1)) THEN noTrg := HIGH (targets)
  2411. ⓪$ELSE DEC (noTrg) END;
  2412. ⓪$FOR i := 0 TO noTrg DO IF ~ isMagicOrNIL (targets[i]) THEN RETURN END END;
  2413. ⓪$
  2414. ⓪$(*  Init. GEM or set 'TW's gem handle.
  2415. ⓪%*)
  2416. ⓪$doInit := (windowRoot = noWindPtr);
  2417. ⓪$IF doInit THEN IF ~ connectToGem () THEN RETURN END;
  2418. ⓪$ELSE saveCurrHdl (oldGem) END;
  2419. ⓪$
  2420. ⓪$(*  get pos. if required.
  2421. ⓪%*)
  2422. ⓪$IF mode = requestPnt THEN
  2423. ⓪&proc.event := mouseButton;
  2424. ⓪&proc.butHdler := butCatcher;
  2425. ⓪&REPEAT
  2426. ⓪(HandleEvents(1, MButtonSet{msBut1}, MButtonSet{msBut1},
  2427. ⓪5lookForEntry, Rect(0,0,0,0), lookForEntry, Rect(0,0,0,0),
  2428. ⓪50L,
  2429. ⓪5proc, 0);
  2430. ⓪&UNTIL validBut;
  2431. ⓪&p := spot;
  2432. ⓪$END;
  2433. ⓪ 
  2434. ⓪$i := 0;
  2435. ⓪$LOOP
  2436. ⓪$
  2437. ⓪&WindowBase.DetectWindow (targets[i]^.handle, 0, p, wdw, wbRes);
  2438. ⓪&
  2439. ⓪&IF wbRes = WindowBase.foundWdwDWR THEN
  2440. ⓪&
  2441. ⓪(result := foundWindow;
  2442. ⓪(hdl := targets[i];
  2443. ⓪(pointToCharPos (hdl, p, column, row, success);
  2444. ⓪(IF success THEN
  2445. ⓪*box := TransRect (Rect (0, 0, hdl^.charW, hdl^.charH),
  2446. ⓪<charToPointPos (hdl, column, row) );
  2447. ⓪*result := foundChar;
  2448. ⓪(END;
  2449. ⓪(
  2450. ⓪(EXIT
  2451. ⓪(
  2452. ⓪&ELSIF wbRes = WindowBase.unkownWdwDWR THEN result := foundWindow END;
  2453. ⓪&
  2454. ⓪&IF i >= noTrg THEN EXIT ELSE INC (i) END;
  2455. ⓪&
  2456. ⓪$END;
  2457. ⓪$
  2458. ⓪$IF doInit THEN deConnectFromGem ELSE restoreCurrHdl (oldGem) END;
  2459. ⓪"END DetectChar;
  2460. ⓪"
  2461. ⓪ 
  2462. ⓪ (*  write proc.s  (only writing to the pipe) *)
  2463. ⓪ 
  2464. ⓪ PROCEDURE Write (hdl: Window; ch: CHAR);
  2465. ⓪ 
  2466. ⓪"VAR   oldGem: GemHandle;
  2467. ⓪"
  2468. ⓪"BEGIN
  2469. ⓪$IF notValid (hdl, TRUE) OR (ch = 0C) THEN RETURN END;
  2470. ⓪$saveCurrHdl (oldGem);
  2471. ⓪$
  2472. ⓪$insertIntoWritePipe (hdl, ch);
  2473. ⓪$
  2474. ⓪$restoreCurrHdl (oldGem);
  2475. ⓪"END Write;
  2476. ⓪ 
  2477. ⓪ PROCEDURE WriteString (hdl: Window; REF str: ARRAY OF CHAR);
  2478. ⓪ 
  2479. ⓪"VAR   oldGem: GemHandle;
  2480. ⓪ 
  2481. ⓪"BEGIN
  2482. ⓪$IF notValid (hdl, TRUE) THEN RETURN END;
  2483. ⓪$saveCurrHdl (oldGem);
  2484. ⓪$
  2485. ⓪$insertIntoWritePipe (hdl, str);
  2486. ⓪$
  2487. ⓪$restoreCurrHdl (oldGem);
  2488. ⓪"END WriteString;
  2489. ⓪ 
  2490. ⓪ PROCEDURE WriteLn (hdl: Window);
  2491. ⓪ 
  2492. ⓪"BEGIN
  2493. ⓪$WriteString (hdl, twoChars{cr, lf});
  2494. ⓪"END WriteLn;
  2495. ⓪ 
  2496. ⓪ PROCEDURE GotoXY (hdl: Window; column, row: CARDINAL);
  2497. ⓪ 
  2498. ⓪"BEGIN
  2499. ⓪$WriteString (hdl, fourChars{esc, 'Y', CHR (ORD (space) + row),
  2500. ⓪@CHR (ORD (space) + column)});
  2501. ⓪"END GotoXY;
  2502. ⓪ 
  2503. ⓪ PROCEDURE WritePg (hdl: Window);
  2504. ⓪"
  2505. ⓪"BEGIN
  2506. ⓪$WriteString (hdl, twoChars{esc, 'E'});
  2507. ⓪"END WritePg;
  2508. ⓪ 
  2509. ⓪ PROCEDURE SetCtrlMode (hdl: Window; mode: CtrlMode);
  2510. ⓪ 
  2511. ⓪"BEGIN
  2512. ⓪$IF notValid (hdl, TRUE) THEN RETURN END;
  2513. ⓪$hdl^.ctrlMode := mode;
  2514. ⓪"END SetCtrlMode;
  2515. ⓪ 
  2516. ⓪ PROCEDURE SetEchoMode (hdl: Window; mode: EchoMode);
  2517. ⓪ 
  2518. ⓪"BEGIN
  2519. ⓪$IF notValid (hdl, TRUE) THEN RETURN END;
  2520. ⓪$hdl^.echoMode := mode;
  2521. ⓪"END SetEchoMode;
  2522. ⓪ 
  2523. ⓪ PROCEDURE EnhancedOutput (hdl: Window; start: BOOLEAN);
  2524. ⓪ 
  2525. ⓪"VAR   str: ARRAY[0..1] OF CHAR;
  2526. ⓪ 
  2527. ⓪"BEGIN
  2528. ⓪$str[0] := esc;
  2529. ⓪$IF start THEN str[1] := ctrlE ELSE str[1] := ctrlF END;
  2530. ⓪$WriteString (hdl, str);
  2531. ⓪"END EnhancedOutput;
  2532. ⓪ 
  2533. ⓪ PROCEDURE FlushPipe (hdl: Window);
  2534. ⓪ 
  2535. ⓪"BEGIN
  2536. ⓪$WriteString (hdl, twoChars{esc, ctrlP});
  2537. ⓪"END FlushPipe;
  2538. ⓪"
  2539. ⓪ 
  2540. ⓪ (*  read proc.s  (flushing the pipe, before action) *)
  2541. ⓪ 
  2542. ⓪ 
  2543. ⓪ VAR     keyBuffer       : GemChar;
  2544. ⓪(specialsBuffer  : SpecialKeySet;
  2545. ⓪(keyBufferEmpty  : BOOLEAN;
  2546. ⓪ 
  2547. ⓪ PROCEDURE keyProc (VAR ch: GemChar; VAR specials: SpecialKeySet): BOOLEAN;
  2548. ⓪ 
  2549. ⓪"(*$L-*)
  2550. ⓪"BEGIN
  2551. ⓪$ASSEMBLER
  2552. ⓪(MOVE.L  -(A3), A0
  2553. ⓪(MOVE.B  (A0), specialsBuffer
  2554. ⓪(MOVE.L  -(A3), A0
  2555. ⓪(MOVE.W  (A0), keyBuffer
  2556. ⓪(MOVE.W  #FALSE, (A3)+
  2557. ⓪(CLR     keyBufferEmpty
  2558. ⓪$END;
  2559. ⓪"END keyProc;
  2560. ⓪"(*$L=*)
  2561. ⓪ 
  2562. ⓪ PROCEDURE timeProc (): BOOLEAN;
  2563. ⓪ 
  2564. ⓪"(*$L-*)
  2565. ⓪"BEGIN
  2566. ⓪$ASSEMBLER
  2567. ⓪(MOVE.W  #FALSE,(A3)+
  2568. ⓪$END;
  2569. ⓪"END timeProc;
  2570. ⓪"(*$L=*)
  2571. ⓪ 
  2572. ⓪ PROCEDURE read (VAR ch: GemChar; VAR specials: SpecialKeySet): BOOLEAN;
  2573. ⓪ 
  2574. ⓪"VAR     procs: ARRAY[1..2] OF EventProc;
  2575. ⓪*gotit: BOOLEAN;
  2576. ⓪ 
  2577. ⓪"BEGIN
  2578. ⓪$IF keyBufferEmpty THEN
  2579. ⓪ 
  2580. ⓪&procs[1].event := keyboard;
  2581. ⓪&procs[1].keyHdler := keyProc;
  2582. ⓪&procs[2].event := timer;
  2583. ⓪&procs[2].timeHdler := timeProc;
  2584. ⓪&HandleEvents (0, MButtonSet{}, MButtonSet{},
  2585. ⓪4lookForEntry, Rect (0,0,0,0), lookForEntry, Rect (0,0,0,0),
  2586. ⓪40L,
  2587. ⓪4procs, 0);
  2588. ⓪4
  2589. ⓪$END;
  2590. ⓪$
  2591. ⓪$ch := keyBuffer;
  2592. ⓪$specials := specialsBuffer;
  2593. ⓪$gotit:= NOT keyBufferEmpty;
  2594. ⓪$keyBufferEmpty:= TRUE;
  2595. ⓪ 
  2596. ⓪$RETURN gotit
  2597. ⓪"END read;
  2598. ⓪ 
  2599. ⓪ PROCEDURE AbortRead (hdl: Window);
  2600. ⓪"BEGIN
  2601. ⓪$(*!!! muß noch impl. werden!!!*)
  2602. ⓪$(* dabei beachten, daß window auch geschlossen sein darf - dann
  2603. ⓪%*  keinen fehler melden!
  2604. ⓪%*)
  2605. ⓪"END AbortRead;
  2606. ⓪"
  2607. ⓪ 
  2608. ⓪ PROCEDURE Read (hdl: Window; VAR ch: CHAR);
  2609. ⓪"
  2610. ⓪"VAR   wait   : BOOLEAN;
  2611. ⓪(gCh    : GemChar;
  2612. ⓪(voidSp : SpecialKeySet;
  2613. ⓪(noHides: CARDINAL;
  2614. ⓪(oldGem : GemHandle;
  2615. ⓪"
  2616. ⓪"BEGIN
  2617. ⓪$IF notValid (hdl, TRUE) THEN RETURN END;
  2618. ⓪$saveCurrHdl (oldGem);
  2619. ⓪$
  2620. ⓪$WITH hdl^ DO
  2621. ⓪&wait := NOT read (gCh, voidSp);
  2622. ⓪&IF wait THEN                (* Evtl. Cursor an und auf Zeichen warten *)
  2623. ⓪(noHides := noCursHides;
  2624. ⓪(IF echoMode = noEcho THEN
  2625. ⓪*noHides := 0
  2626. ⓪(ELSE
  2627. ⓪*noCursHides := 1;
  2628. ⓪*internalCursorOn (hdl);         (*  does also a flush  *)
  2629. ⓪(END;
  2630. ⓪(REPEAT UNTIL read (gCh, voidSp);
  2631. ⓪(IF noHides # 0 THEN
  2632. ⓪*internalCursorOff (hdl);        (*  does also a flush  *)
  2633. ⓪*noCursHides := noHides;
  2634. ⓪(END;
  2635. ⓪&END;
  2636. ⓪&ch := gCh.ascii;
  2637. ⓪&CASE echoMode OF
  2638. ⓪(noEcho         : |
  2639. ⓪(restrictedEcho : IF ch >= ' ' THEN Write (hdl, ch) END|
  2640. ⓪(fullEcho       : Write (hdl, ch)|
  2641. ⓪&END;
  2642. ⓪&IF wait THEN internalFlushPipe (hdl) END;
  2643. ⓪$END;
  2644. ⓪$restoreCurrHdl (oldGem);
  2645. ⓪"END Read;
  2646. ⓪ 
  2647. ⓪ PROCEDURE Done (hdl: Window): BOOLEAN;
  2648. ⓪ 
  2649. ⓪"BEGIN
  2650. ⓪$RETURN hdl^.done
  2651. ⓪"END Done;
  2652. ⓪ 
  2653. ⓪ PROCEDURE moveX (no: INTEGER);
  2654. ⓪ 
  2655. ⓪"BEGIN
  2656. ⓪$flushWritePipe (globHdl);
  2657. ⓪$setCursor (globHdl, INTEGER (globHdl^.cursX) + no, globHdl^.cursY)
  2658. ⓪"END moveX;
  2659. ⓪ 
  2660. ⓪ PROCEDURE myWrite (c: CHAR);
  2661. ⓪ 
  2662. ⓪"BEGIN
  2663. ⓪$insertIntoWritePipe (globHdl, c);
  2664. ⓪"END myWrite;
  2665. ⓪ 
  2666. ⓪ VAR globLeadingBlanks: BOOLEAN;
  2667. ⓪ 
  2668. ⓪ PROCEDURE rdCmd (VAR c: StringEditor.Commands; VAR ch: CHAR);
  2669. ⓪"VAR k: Key; again, isSep: BOOLEAN;
  2670. ⓪"BEGIN
  2671. ⓪$internalFlushPipe (globHdl);
  2672. ⓪$again:= FALSE;
  2673. ⓪$REPEAT
  2674. ⓪&GetKey (k);
  2675. ⓪&ch:= k.ch;
  2676. ⓪&c:= StringEditor.StdCmd (k);
  2677. ⓪&IF globToken THEN
  2678. ⓪(isSep:= ch IN MOSConfig.Separators;
  2679. ⓪(IF globLeadingBlanks THEN
  2680. ⓪*IF isSep THEN
  2681. ⓪,IF ch >= ' ' THEN
  2682. ⓪.myWrite (ch)
  2683. ⓪,END;
  2684. ⓪,again:= TRUE;
  2685. ⓪*ELSE
  2686. ⓪,globLeadingBlanks:= FALSE
  2687. ⓪*END
  2688. ⓪(ELSIF isSep THEN
  2689. ⓪*IF ch >= ' ' THEN
  2690. ⓪,myWrite (ch)
  2691. ⓪*END;
  2692. ⓪*c:= StringEditor.enter
  2693. ⓪(END
  2694. ⓪&END
  2695. ⓪$UNTIL ~again;
  2696. ⓪$globHdl^.done:= (c # StringEditor.abort);
  2697. ⓪"END rdCmd;
  2698. ⓪ 
  2699. ⓪ PROCEDURE myWriteString (REF c: ARRAY OF CHAR);
  2700. ⓪"BEGIN
  2701. ⓪$insertIntoWritePipe (globHdl, c);
  2702. ⓪"END myWriteString;
  2703. ⓪ 
  2704. ⓪ PROCEDURE myEditLine( VAR dStr: ARRAY OF CHAR; mayCtrl, token: BOOLEAN);
  2705. ⓪"BEGIN
  2706. ⓪$globToken:= token;
  2707. ⓪$globLeadingBlanks:= TRUE;
  2708. ⓪$WriteString (globHdl, twoChars{esc, ctrlE}); (* enhanced output on *)
  2709. ⓪$StringEditor.Edit (dStr, mayCtrl, myWrite, myWriteString, moveX, rdCmd);
  2710. ⓪$WriteString (globHdl, twoChars{esc, ctrlF}); (* enhanced output off *)
  2711. ⓪"END myEditLine;
  2712. ⓪ 
  2713. ⓪ PROCEDURE EditLine (hdl: Window; VAR str: ARRAY OF CHAR);
  2714. ⓪ 
  2715. ⓪"VAR   success     : BOOLEAN;
  2716. ⓪(i           : CARDINAL;
  2717. ⓪(ch          : GemChar;
  2718. ⓪(oldEnh      : BOOLEAN;
  2719. ⓪(oldEscStatus: escStatusDesc;
  2720. ⓪(oldGem      : GemHandle;
  2721. ⓪"
  2722. ⓪"BEGIN
  2723. ⓪$IF notValid (hdl, TRUE) THEN RETURN END;
  2724. ⓪$saveCurrHdl (oldGem);
  2725. ⓪$
  2726. ⓪$WITH hdl^ DO
  2727. ⓪$
  2728. ⓪&internalFlushPipe (hdl);
  2729. ⓪&oldEnh := enhanced;
  2730. ⓪&oldEscStatus := escStatus;
  2731. ⓪&enhanced := FALSE;
  2732. ⓪&initEscAutomat (escStatus);
  2733. ⓪&internalCursorOn (hdl);
  2734. ⓪&
  2735. ⓪&globHdl:= hdl;
  2736. ⓪&myEditLine (str, ctrlMode = writeCtrl, FALSE);
  2737. ⓪"
  2738. ⓪&internalCursorOff (globHdl);
  2739. ⓪&escStatus := oldEscStatus;
  2740. ⓪&enhanced := oldEnh;
  2741. ⓪$
  2742. ⓪$END;
  2743. ⓪&
  2744. ⓪$restoreCurrHdl (oldGem);
  2745. ⓪"END EditLine;
  2746. ⓪ 
  2747. ⓪ PROCEDURE ReadLine (hdl: Window; VAR str: ARRAY OF CHAR);
  2748. ⓪ 
  2749. ⓪"BEGIN
  2750. ⓪$str[0]:= 0C;
  2751. ⓪$EditLine (hdl, str)
  2752. ⓪"END ReadLine;
  2753. ⓪ 
  2754. ⓪ PROCEDURE ReadString (hdl: Window; VAR str: ARRAY OF CHAR);
  2755. ⓪"(*$L-*)
  2756. ⓪"BEGIN
  2757. ⓪$ASSEMBLER
  2758. ⓪(JMP     ReadLine
  2759. ⓪$END
  2760. ⓪"END ReadString;
  2761. ⓪"(*$L=*)
  2762. ⓪ 
  2763. ⓪ PROCEDURE ReadToken (hdl: Window; VAR str: ARRAY OF CHAR);
  2764. ⓪ 
  2765. ⓪"VAR   success     : BOOLEAN;
  2766. ⓪(i           : CARDINAL;
  2767. ⓪(ch          : GemChar;
  2768. ⓪(oldEnh      : BOOLEAN;
  2769. ⓪(oldEscStatus: escStatusDesc;
  2770. ⓪(oldCtrlMode : CtrlMode;
  2771. ⓪(
  2772. ⓪(oldGem      : GemHandle;
  2773. ⓪"
  2774. ⓪"BEGIN
  2775. ⓪$IF notValid (hdl, TRUE) THEN RETURN END;
  2776. ⓪$saveCurrHdl (oldGem);
  2777. ⓪$
  2778. ⓪$WITH hdl^ DO
  2779. ⓪$
  2780. ⓪&internalFlushPipe (hdl);
  2781. ⓪&oldCtrlMode := ctrlMode;
  2782. ⓪&oldEnh := enhanced;
  2783. ⓪&oldEscStatus := escStatus;
  2784. ⓪&ctrlMode := interpretCtrl;
  2785. ⓪&enhanced := FALSE;
  2786. ⓪&initEscAutomat (escStatus);
  2787. ⓪&internalCursorOn (hdl);
  2788. ⓪&
  2789. ⓪&globHdl:= hdl;
  2790. ⓪&myEditLine (str, FALSE, TRUE);
  2791. ⓪&
  2792. ⓪&internalCursorOff (globHdl);
  2793. ⓪&escStatus := oldEscStatus;
  2794. ⓪&enhanced := oldEnh;
  2795. ⓪&ctrlMode := oldCtrlMode;
  2796. ⓪$
  2797. ⓪$END;
  2798. ⓪$
  2799. ⓪$restoreCurrHdl (oldGem);
  2800. ⓪"END ReadToken;
  2801. ⓪ 
  2802. ⓪ PROCEDURE UndoRead;
  2803. ⓪"BEGIN
  2804. ⓪$keyBufferEmpty:= FALSE
  2805. ⓪"END UndoRead;
  2806. ⓪ 
  2807. ⓪ 
  2808. ⓪ PROCEDURE GetPos (hdl: Window; VAR column, row: CARDINAL);
  2809. ⓪"
  2810. ⓪"BEGIN
  2811. ⓪$IF notValid (hdl, TRUE) THEN row := 0; column := 0; RETURN END;
  2812. ⓪$
  2813. ⓪$column := hdl^.cursX; row := hdl^.cursY;
  2814. ⓪"END GetPos;
  2815. ⓪ 
  2816. ⓪ PROCEDURE GetCtrlMode (hdl: Window; VAR mode: CtrlMode);
  2817. ⓪ 
  2818. ⓪"BEGIN
  2819. ⓪$IF notValid (hdl, TRUE) THEN mode := interpretCtrl; RETURN END;
  2820. ⓪$mode := hdl^.ctrlMode;
  2821. ⓪"END GetCtrlMode;
  2822. ⓪ 
  2823. ⓪ PROCEDURE GetEchoMode (hdl: Window; VAR mode: EchoMode);
  2824. ⓪ 
  2825. ⓪"BEGIN
  2826. ⓪$IF notValid (hdl, TRUE) THEN mode := restrictedEcho; RETURN END;
  2827. ⓪$mode := hdl^.echoMode;
  2828. ⓪"END GetEchoMode;
  2829. ⓪"
  2830. ⓪ PROCEDURE ReadTextBuffer (    hdl    : Window;
  2831. ⓪>col,
  2832. ⓪>row,
  2833. ⓪>amount : CARDINAL;
  2834. ⓪:VAR buffer : ARRAY OF CHAR;
  2835. ⓪:VAR nextCol, nextRow: CARDINAL);
  2836. ⓪ 
  2837. ⓪"VAR   effects    : effectSet;
  2838. ⓪(currElemPtr: ptrBufferElem;
  2839. ⓪(i, spaces,
  2840. ⓪(max        : CARDINAL;
  2841. ⓪ 
  2842. ⓪"PROCEDURE insSpaces;
  2843. ⓪$
  2844. ⓪$BEGIN
  2845. ⓪&WHILE spaces > 0 DO
  2846. ⓪(buffer[i] := ' ';
  2847. ⓪(INC (i);
  2848. ⓪(DEC (spaces);
  2849. ⓪&END;
  2850. ⓪$END insSpaces;
  2851. ⓪$
  2852. ⓪"PROCEDURE ins (ch: CHAR);
  2853. ⓪"
  2854. ⓪$BEGIN
  2855. ⓪&insSpaces;
  2856. ⓪&buffer[i] := ch;
  2857. ⓪&INC (i);
  2858. ⓪&DEC (max);
  2859. ⓪$END ins;
  2860. ⓪$
  2861. ⓪"BEGIN
  2862. ⓪$IF notValid (hdl, TRUE) THEN RETURN END;
  2863. ⓪$
  2864. ⓪$internalFlushPipe (hdl);
  2865. ⓪$IF (amount = 0) OR (amount > HIGH (buffer)) THEN
  2866. ⓪&amount := HIGH (buffer)
  2867. ⓪$END;
  2868. ⓪$max := HIGH (buffer) + 1;
  2869. ⓪$
  2870. ⓪$spaces := 0;
  2871. ⓪$i := 0;
  2872. ⓪$effects := effectSet{}; (* !!! Stimmt das? Wohl nicht, aber wie besser?  *)
  2873. ⓪$WHILE (row < hdl^.rows) AND (amount > 0) AND (max > 0) DO
  2874. ⓪&
  2875. ⓪&IF col = hdl^.columns THEN
  2876. ⓪(IF row + 1 < hdl^.rows THEN
  2877. ⓪*IF max < 2 THEN max := 0
  2878. ⓪*ELSE
  2879. ⓪,ins (cr);
  2880. ⓪,ins (lf);
  2881. ⓪,col := 0;
  2882. ⓪,INC (row);
  2883. ⓪*END;
  2884. ⓪(ELSE max := 0 END;
  2885. ⓪&END;
  2886. ⓪(
  2887. ⓪&currElemPtr := ADR (hdl^.buffer^[textBufferIndex (hdl, col, row)]);
  2888. ⓪&
  2889. ⓪&WHILE (col < hdl^.columns) AND (amount > 0) AND (max > 0) DO
  2890. ⓪(
  2891. ⓪(IF effects # currElemPtr^.effects THEN
  2892. ⓪(
  2893. ⓪*effects := currElemPtr^.effects;
  2894. ⓪*IF max < 3 THEN max := 0 ELSE
  2895. ⓪,ins (esc);
  2896. ⓪,IF inverse IN effects THEN ins ('p') ELSE ins ('q') END;
  2897. ⓪*END;
  2898. ⓪*
  2899. ⓪(END;
  2900. ⓪(
  2901. ⓪(IF max > 0 THEN
  2902. ⓪*IF currElemPtr^.ch = ' ' THEN INC (spaces); DEC (max);
  2903. ⓪*ELSE ins (currElemPtr^.ch) END;
  2904. ⓪(END;
  2905. ⓪(INC (currElemPtr, SIZE (currElemPtr^));
  2906. ⓪(INC (col);
  2907. ⓪(DEC (amount);
  2908. ⓪(
  2909. ⓪&END;
  2910. ⓪&
  2911. ⓪&IF (amount = 0) AND (col < hdl^.columns) THEN insSpaces
  2912. ⓪&ELSE
  2913. ⓪(INC (max, spaces);
  2914. ⓪(spaces := 0;
  2915. ⓪&END;
  2916. ⓪$
  2917. ⓪$END;
  2918. ⓪$
  2919. ⓪$IF i <= HIGH (buffer) THEN buffer[i] := 0C END;
  2920. ⓪$nextCol := col;
  2921. ⓪$nextRow := row;
  2922. ⓪"END ReadTextBuffer;
  2923. ⓪"
  2924. ⓪ 
  2925. ⓪ (*  window independent proc.s  *)
  2926. ⓪ 
  2927. ⓪ PROCEDURE KeyPressed (): BOOLEAN;
  2928. ⓪ 
  2929. ⓪ VAR     ch      : GemChar;
  2930. ⓪(gotone  : BOOLEAN;
  2931. ⓪(voidSp  : SpecialKeySet;
  2932. ⓪ 
  2933. ⓪"BEGIN
  2934. ⓪$gotone:= read (ch, voidSp); (*  NICHT: 'valid:=read (keyBuffer)' wegen VAR-Parm.  *)
  2935. ⓪$keyBufferEmpty:= NOT gotone;
  2936. ⓪$RETURN gotone
  2937. ⓪"END KeyPressed;
  2938. ⓪ 
  2939. ⓪ PROCEDURE CondRead (VAR ch: CHAR; VAR success: BOOLEAN);
  2940. ⓪"(*$L-*)
  2941. ⓪"BEGIN
  2942. ⓪$ASSEMBLER
  2943. ⓪(SUBQ.L  #2,A7
  2944. ⓪(MOVE.L  A7,(A3)+
  2945. ⓪(SUBQ.L  #2,A7
  2946. ⓪(MOVE.L  A7,(A3)+
  2947. ⓪(JSR     read
  2948. ⓪(ADDQ.L  #2,A7
  2949. ⓪(MOVE.W  (A7)+,D1
  2950. ⓪(MOVE    -(A3),D0
  2951. ⓪(MOVE.L  -(A3),A0
  2952. ⓪(MOVE    D0,(A0)
  2953. ⓪(MOVE.L  -(A3),A0
  2954. ⓪(BEQ     c
  2955. ⓪(MOVE.B  D1,(A0)
  2956. ⓪(RTS
  2957. ⓪&c CLR.B   (A0)
  2958. ⓪$END
  2959. ⓪"END CondRead;
  2960. ⓪"(*$L=*)
  2961. ⓪ 
  2962. ⓪ PROCEDURE BusyRead (VAR ch:CHAR);
  2963. ⓪"(*$L-*)
  2964. ⓪"BEGIN
  2965. ⓪$ASSEMBLER
  2966. ⓪(SUBQ.L  #2,A7
  2967. ⓪(MOVE.L  A7,(A3)+
  2968. ⓪(JSR     CondRead
  2969. ⓪(ADDQ.L  #2,A7
  2970. ⓪$END
  2971. ⓪"END BusyRead;
  2972. ⓪"(*$L=*)
  2973. ⓪ 
  2974. ⓪ PROCEDURE FlushKbd;
  2975. ⓪"(*$L-*)
  2976. ⓪"BEGIN
  2977. ⓪$ASSEMBLER
  2978. ⓪&c JSR     KeyPressed
  2979. ⓪(TST     -(A3)
  2980. ⓪(BEQ     ende
  2981. ⓪(SUBQ.L  #2,A7
  2982. ⓪(MOVE.L  A7,(A3)+
  2983. ⓪(SUBQ.L  #2,A7
  2984. ⓪(MOVE.L  A7,(A3)+
  2985. ⓪(JSR     read
  2986. ⓪(ADDQ.L  #4,A7
  2987. ⓪(SUBQ.L  #2,A3
  2988. ⓪(BRA     c
  2989. ⓪&ende
  2990. ⓪$END
  2991. ⓪"END FlushKbd;
  2992. ⓪"(*$L=*)
  2993. ⓪"
  2994. ⓪ PROCEDURE GetChar (VAR ch: CHAR);
  2995. ⓪"VAR   gCh   : GemChar;
  2996. ⓪(voidSp: SpecialKeySet;
  2997. ⓪"BEGIN
  2998. ⓪$REPEAT UNTIL read (gCh, voidSp);
  2999. ⓪$ch:= gCh.ascii;
  3000. ⓪"END GetChar;
  3001. ⓪ 
  3002. ⓪ PROCEDURE GetKey (VAR k: Key);
  3003. ⓪"VAR   gCh: GemChar;
  3004. ⓪(sks: SpecialKeySet;
  3005. ⓪"BEGIN
  3006. ⓪$REPEAT UNTIL read (gCh, sks);
  3007. ⓪$ASSEMBLER
  3008. ⓪(MOVE.L  k(A6),A0
  3009. ⓪(MOVE.W  gCh(A6),D1      ; |scan| asc|
  3010. ⓪(MOVE.B  sks(A6),D0
  3011. ⓪(LSR.B   #1,D0
  3012. ⓪(BCC     n
  3013. ⓪(BSET    #0,D0
  3014. ⓪%n: ANDI.B  #1111%,D0
  3015. ⓪(SWAP    D1
  3016. ⓪(CLR     D1
  3017. ⓪(ROL.L   #8,D1
  3018. ⓪(MOVE.L  D1,(A0)         ; | asc|   0|   0|scan|
  3019. ⓪(MOVE.B  D0,1(A0)
  3020. ⓪$END
  3021. ⓪"END GetKey;
  3022. ⓪ 
  3023. ⓪ PROCEDURE GetGemChar (VAR ch: GemChar; VAR specials: SpecialKeySet);
  3024. ⓪"BEGIN
  3025. ⓪$REPEAT UNTIL read (ch, specials);
  3026. ⓪"END GetGemChar;
  3027. ⓪ 
  3028. ⓪ 
  3029. ⓪8(*  misc. managment  *)
  3030. ⓪8(*  ===============  *)
  3031. ⓪ 
  3032. ⓪ PROCEDURE levelCounter (start, child: BOOLEAN; VAR id: INTEGER);
  3033. ⓪ 
  3034. ⓪"VAR     ptr     : ptrWindow;
  3035. ⓪*again   : BOOLEAN;
  3036. ⓪"
  3037. ⓪"BEGIN
  3038. ⓪$IF child THEN
  3039. ⓪$
  3040. ⓪&IF start THEN
  3041. ⓪(INC (modLevel)
  3042. ⓪&ELSE
  3043. ⓪&
  3044. ⓪(REPEAT
  3045. ⓪*again := FALSE;
  3046. ⓪*ptr := windowRoot;
  3047. ⓪*LOOP
  3048. ⓪*
  3049. ⓪,IF ptr = NIL THEN EXIT END;
  3050. ⓪,IF ptr^.level >= modLevel THEN
  3051. ⓪.Close (ptr);
  3052. ⓪.again := TRUE;
  3053. ⓪.EXIT;
  3054. ⓪,END;
  3055. ⓪,ptr := ptr^.next;
  3056. ⓪,
  3057. ⓪*END;(*LOOP*)
  3058. ⓪(UNTIL ~ again;
  3059. ⓪(
  3060. ⓪(DEC (modLevel);
  3061. ⓪(
  3062. ⓪&END;(*IF start ELSE*)
  3063. ⓪&
  3064. ⓪$END;
  3065. ⓪"END levelCounter;
  3066. ⓪ 
  3067. ⓪ PROCEDURE termProc;
  3068. ⓪ 
  3069. ⓪"BEGIN
  3070. ⓪ (*$? TestVersion:
  3071. ⓪"Terminal.WriteString ("'TextWindows' terminating."); Terminal.WriteLn;
  3072. ⓪!*)
  3073. ⓪$(* Zum Zeitpunkt des Aufrufs dieser Proc, ist modLevel=0 *)
  3074. ⓪$levelCounter (FALSE,TRUE, voidI);(* Alle Elem. bis incl. modLevel=0 abmelden *)
  3075. ⓪"END termProc;
  3076. ⓪ 
  3077. ⓪ PROCEDURE removalProc;
  3078. ⓪ 
  3079. ⓪"BEGIN
  3080. ⓪ (*$? TestVersion:
  3081. ⓪"Terminal.WriteString ("'TextWindows' removing."); Terminal.WriteLn;
  3082. ⓪!*)
  3083. ⓪$(* Zum Zeitpunkt des Aufrufs dieser Proc, ist modLevel=0 *)
  3084. ⓪$levelCounter (FALSE,TRUE, voidI);(* Alle Elem. bis incl. modLevel=0 abmelden *)
  3085. ⓪"END removalProc;
  3086. ⓪ 
  3087. ⓪ 
  3088. ⓪ VAR     envlpProcHdl    : EnvlpCarrier;
  3089. ⓪(termProcHdl     : TermCarrier;
  3090. ⓪(removalProcHdl  : RemovalCarrier;
  3091. ⓪(wsp             : MemArea;
  3092. ⓪(
  3093. ⓪(ok              : BOOLEAN;
  3094. ⓪(
  3095. ⓪ BEGIN
  3096. ⓪"windowRoot := noWindPtr;
  3097. ⓪"modLevel := 1;
  3098. ⓪"
  3099. ⓪"stdMFDB.start := NIL;
  3100. ⓪"
  3101. ⓪"keyBufferEmpty:= TRUE;
  3102. ⓪ 
  3103. ⓪"eventHandling := FALSE;
  3104. ⓪"
  3105. ⓪"installTimeProc (FlushEvents, 500);  (*  Alle 1/2 sec. 'FlushEvents'  *)
  3106. ⓪"
  3107. ⓪"SetEnvelope (envlpProcHdl, levelCounter, wsp);
  3108. ⓪"CatchProcessTerm (termProcHdl, termProc, wsp);
  3109. ⓪"CatchRemoval (removalProcHdl, removalProc, wsp);
  3110. ⓪ END TextWindows.
  3111. ⓪ ə
  3112. (* $FFEC5D1D$FFEBA329$0000871F$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFED5D35$FFF749DC$00000031$FFF749DC$00012F02$FFF749DC$0000C62F$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFE9E66C$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFF749DC$00005522$FFF749DC$FFF749DC$0000DC62$FFF749DC$FFF749DC$FFF749DC$FFF749DC$FFEC5D1D$FFF749DC$FFF749DCÇ$00007D20........T.......T.......T.......T.......T.......T.......T.......T.......T.......$00001C7B$00001C97$00007D67$00007D20$FFDF398E$00007BE8$FFDF398E$00007DC2$00007D20$00001CA9$00001BD9$FFDF398E$FFDF398E$00001CA9$00001C83$00001CA6ÉÇâ*)
  3113.