home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / GEP_ED / GEP_ED.M < prev   
Encoding:
Text File  |  1994-02-04  |  153.6 KB  |  3 lines
  1. ⓪ 
  2. ⓪ (*  Atari-Editor
  3. ⓪!*------------------------------------------------------------------------------
  4. ⓪!* Copyright 1986-1990 by Thomas Tempelmann
  5. ⓪!*------------------------------------------------------------------------------
  6. ⓪!* TT:  Thomas Tempelmann, Schusterwolfstr.13, 81241 München, Tel.089/8347394
  7. ⓪!* Hü:  Wilfried Hübner, Hohenzollernstr. 8B, D-1000 Berlin 39
  8. ⓪!* HSK: Hannes Krohn, Kreuzstr. 35, Karlsruhe
  9. ⓪!*------------------------------------------------------------------------------
  10. ⓪!* 0.0: H.-J. Himmeröder  :23.02.85: Grundversion
  11. ⓪!* 1.0: TT  :27.06.86: Übernahme des Gepard-Editors 2.p
  12. ⓪!* 1.1: TT  :27.07.86: Load/Save impl.
  13. ⓪!* 1.2: TT  :06.09.86: Cleantext schneller, Aufruf nach Load/Save
  14. ⓪!* 1.3: TT  :23.10.86: Infoblock in Kommentarzeile; Saveinfo nur,
  15. ⓪!*                     wenn er beim Laden schon da war.
  16. ⓪!* 1.4: TT  :25.10.86: Tabs werden richtig erkannt (-> "§")
  17. ⓪!* 1.5: TT  :27.10.86: Hoffentlich kein Addr-Err mehr bei save
  18. ⓪!* 1.6: TT  :02.03.87: Zeilennummern nun +1; Bei Frames wird
  19. ⓪!*                     'saveInfo' gerettet; C(op F(ile raus;
  20. ⓪!*                     HardCopy korrig.; Cursor wird bei Pos-
  21. ⓪!*                     übergabe in ArgV[2] positioniert.
  22. ⓪!* 1.7: TT  :03.03.87: Quit: X und C, TextPos vor CleanText gesetzt
  23. ⓪!* 1.8: TT  :04.03.87: CleanText jetzt endlich richtig; F7/F8.
  24. ⓪!* 1.9: TT  :09.05.87: Save erkennt Disk full
  25. ⓪!* 2.0: TT  :25.07.87: Umstellung als MOS-Modul
  26. ⓪!* 2.1: TT  :29.08.87: Nach Q, S, Return kein extra Zeichen am Textende
  27. ⓪!* 2.2: TT  :14.09.87: FileSearch immer
  28. ⓪!* 2.3: TT  :04.11.87: Code-Optimierungen
  29. ⓪!* 2.4: TT  :25.12.87: ArgV-Auswertung erneuert
  30. ⓪!* 2.5: TT  :25.01.88: In ArgV[3] wird die Spalte jetzt 0-based erwartet
  31. ⓪!* 2.6: TT  :11.04.88: Läuft auch in Farbe.
  32. ⓪!* 2.6: TT  :13.04.88: Farben werden gerettet.
  33. ⓪!* 2.7: TT  :15.04.88: VOR Scrn-Rückschaltung wird auf VBL gewartet.
  34. ⓪!* 2.8: TT  :18.04.88: Startup-Msg geändert, TextName wird auch bei QN gesetzt.
  35. ⓪!* 2.9: TT  :02.06.88: Cleantext erkennt overflow; SaveText löscht File, wenn
  36. ⓪!*                     Schreibfehler; Compiler wird mit F5 gestartet - Achtung:
  37. ⓪!*                     Wenn Fehler in Include-File, wird der Text nicht geladen
  38. ⓪!*                     DLEChar v. $E auf $10 korrigiert.
  39. ⓪!* 2.A: TT  :24.07.88: GotoLine hängt nicht, wenn Zeile = 0.
  40. ⓪!* 2.B: TT  :10.08.88: Ausgabe beschleunigt; Farb-Auswahl nun ok; InsKey/DelKey
  41. ⓪!*                     alternativ für Insert-/Delete-Modus; Tabs werden bei F3
  42. ⓪!*                     initialisiert.
  43. ⓪!*           16.08.88: Ctrl-left/right f. SOLn/EOLn
  44. ⓪!* 2.C       10.09.88: Farbausgabe: ClearEndOfLine korrigiert
  45. ⓪!* 2.C+ Hü  :16.04.89: FileSelectBox (readOnly) eingebaut. Textcursor kann mit
  46. ⓪!*                     Maus versetzt werden. Scrolling durch Mausbetätigung
  47. ⓪!*                     an den vertikalen Bildschirmrändern.
  48. ⓪!* 2.D  TT   19.04.89: FileSelect-Box auch bei Schreiboperationen; Pfadname
  49. ⓪!*                     in FS enthält auch Laufwerksbuchstabe; SaveText liefert
  50. ⓪!*                     FALSE bei Schreibfehler -> Text geht nicht mehr bei 'QU'
  51. ⓪!*                     verloren; CmdLineAway prüft auch Mausklick; '.TXT' wird
  52. ⓪!*                     nicht mehr automatisch angefügt; Tab-Weite kann in
  53. ⓪!*                     'ET' bestimmt werden; Quick-Save-Option; Backup-Name
  54. ⓪!*                     wird richtig gebildet; Ctrl-Z bei Save zw. Textende und
  55. ⓪!*                     Info-Line.
  56. ⓪!* 2.E  TT   23.04.89: GetPath fügt ggf. '\' an Pfad an, damit es keine Probleme
  57. ⓪!*                     mit altem Directories-Modul gibt; FileSelect zeigt Frage
  58. ⓪!*                     an; Mauskontrolle überarbeitet (WaitForKey); kein Absturz
  59. ⓪!*                     wenn 'Overflow' in GetFile; Nach L(ook kann mit J(ump -
  60. ⓪!*                     an Ursprungsstelle zurückgesprungen werden; Kein Hänger
  61. ⓪!*                     bei Delete über Textanfang/-ende; TabLeft jetzt mit
  62. ⓪!*                     Ctrl- oder Shift-Tab; ScrollUp/Down mit Ctrl-Up/Down;
  63. ⓪!*                     Hardcopy wieder drin.
  64. ⓪!*      TT   28.04.89: Bei F3 wird neue Frame-Nr wieder aktualisiert
  65. ⓪!* 2.F  TT   14.05.89: Wenn von niedriger auf mittl. Auflösung umgeschaltet
  66. ⓪!*                     werden muß, wird kein GEM (Maus, FileSelect) verwendet
  67. ⓪!*      TT   22.05.89: Kein Hänger, wenn Ctrl-Z erstes Zeichen im Text
  68. ⓪!* 2.G  TT   25.05.89: Ctrl-Z wird nicht am Textende erzeugt, wenn kein
  69. ⓪!*                      <Save Info-line>.
  70. ⓪!* 2.H  HSK  13.11.88: Mit F6 wird in .DEF-Files nach dem Identifier unter dem
  71. ⓪!*                     Cursor gesucht, das entsprechende .D-File geladen und
  72. ⓪!*                     der Cursor auf den Identifier positioniert.
  73. ⓪!*                     Mit 'FindWord' wird der vollst. Name gesucht, sonst nach
  74. ⓪!*                     dessen Anfang.
  75. ⓪!*      TT   09.07.89: Laden eines leeren Textes gibt keinen Absturz mehr.
  76. ⓪!*                     Leereingabe mit [ OK ] bei Fileselect sucht nicht mehr.
  77. ⓪!*                     Dateifehler als Text (bisher Nr).
  78. ⓪!* 2.I  TT   17.07.89: F6 geht auch bei M2LIB.DEF
  79. ⓪!* 2.J  TT   25.07.89: CallCompiler übergibt neue Options f. Compiler 3.6p
  80. ⓪!*      TT   06.08.89: Enter-Taste nun direction-unabhängig (immer runter);
  81. ⓪!*                     Compiler-Name nun 'MM2Comp'
  82. ⓪!* 2.H  TT   08.08.89: Datum der Source wird ggf. nach Comp-Aufruf neu gesetzt;
  83. ⓪!*                     Maus-Kontrolle geändert, damit bei FormAlert die Maus
  84. ⓪!*                     sichtbar ist.
  85. ⓪!*      TT   10.08.89: "Save editor info-line" defaultmäßig nun auf FALSE;
  86. ⓪!*                     'ß' wird auch als Alpha-Zeichen erkannt.
  87. ⓪!*      TT   15.08.89: Maus-Kontrolle nochmals geändert (TRUE bei ShowCursor)
  88. ⓪!*      TT   19.08.89: DefLibName importiert, wird nicht mehr gesucht
  89. ⓪!*      TT   20.08.89: Quit mit Make, Make-Exec
  90. ⓪!* 2.I  TT   13.09.89: F6 sollte nun auch mit LibFiles gehen
  91. ⓪!* 2.J  TT   14.12.89: Änderungen an Shortkeys
  92. ⓪!*      TT   11.01.90: F6 findet nun alle Items, auch Rec-Felder & Enum-Elems;
  93. ⓪!*                     Environment: X setzt Cursor immer an Textbeginn
  94. ⓪!*      TT   17.01.90: Compilername wird aus ShellMsg importiert
  95. ⓪!* 2.K  TT   13.03.90: Bei Enlarge-Fehler hoffentlich kein Bus-Error mehr
  96. ⓪!*      TT   09.05.90: F6 sucht bei Modulnamen nicht mehr weiter im gefundenen
  97. ⓪!*                     Source; CompV4-Anpassung; F6 benutzt 'ReplaceHome'. 
  98. ⓪!* 2.L  TT   15.07.90: Enlarge wird nun korrekt aufgerufen.
  99. ⓪!* 2.M  TT   20.08.90: Sollte nun bei Autoswitch-Overscan auf normal schalten;
  100. ⓪!*                     MoveText und Find/Replace schneller.
  101. ⓪!* 2.N  TT   15.09.90: Mögl. Buserrors bei FindDefFile abgefangen. F6 kommt
  102. ⓪!*                     wieder mit Records klar.
  103. ⓪!* 2.O  TT   18.09.90: Overscan-Switch korrigiert.
  104. ⓪!* 2.P  TT   09.10.90: Läuft auch mit TT
  105. ⓪!* 2.Q  TT   14.11.90: FileSelector wird versuchsweise auch bei Auflösungs-
  106. ⓪!*                     wechsel bei ST & TT verwendet (s. InitScreen).
  107. ⓪!* 2.R  TT   03.12.90: Return-Taste wieder Direction-abhängig (a.Adjust,Delete).
  108. ⓪!*      TT   11.12.90: Bei leerem Dateinamen beim Start kommt keine Fehlermeld.
  109. ⓪!*      TT   19.04.91: Erkennt auch einzelne LF als Zeilentrenner
  110. ⓪!* 2.S  TT   20.10.91: Bei DelMode mit Return-Taste und Direction=up kein
  111. ⓪!*                     Hänger mehr bei oberster Zeile.
  112. ⓪!*      TT   15.02.93: Der Puffer belegt nur noch 2/3 des freien MaxMem,
  113. ⓪!*                     mind. jedoch 32K. StopEditor: erst Screenmode zurück,
  114. ⓪!*                     dann ExitGem (damit Redraw bei MultiTOS klappt?).
  115. ⓪!*                     MenuBar(NIL) vor InitEditor.
  116. ⓪!* 2.T  TT   21.11.93: SetScreen-Aufruf ("Setrez") am Ende nur, wenn's auch am
  117. ⓪!*                     Anfang aufgerufen wurde (Vorschlag v. G.Castan wg. STE).
  118. ⓪!*                     MouseControl-Aufruf zu Beginn wg. MultiTOS.
  119. ⓪!*                     Tastenabfrage per MultiEvent.
  120. ⓪!* 2.T  TT   10.12.93: GetInfo: Falls kein DLE im 1. Byte des Textes, wird auch
  121. ⓪!*                     die Info am Ende verworfen (wg. D.Steins Editor)
  122. ⓪!*           11.01.94: Maus wird nur noch über GrafMouse ein-/ausgeschaltet.
  123. ⓪!*           17.01.94: Bei neuen Texten wird im tag "=" ptrEnd gespeichert. Dies
  124. ⓪!*                     wird von nun an als Kriterium benutzt, ob die Infoline
  125. ⓪!*                     gültig ist. Über tag[';'] wird Cursorpos. beim Speichern
  126. ⓪!*                     gemerkt und beim Laden sofort wieder angesprungen.
  127. ⓪!* 2.U  TT   06.02.94: Shift-/Ctrl-Cursor vertauscht.
  128. ⓪!*)
  129. ⓪ 
  130. ⓪ 
  131. ⓪ MODULE GEP_ED; (*$C-,R-,Q+,M-,G+ (Dezimale Char-Konst.) *)
  132. ⓪ 
  133. ⓪ (* ED1.ICL *)
  134. ⓪ FROM EasyGEM0 IMPORT ForceDeskRedraw;
  135. ⓪ FROM GrafBase IMPORT Point, Rectangle;
  136. ⓪ FROM GEMGlobals IMPORT TEffectSet, msbut1, MbuttonSet, TextEffect,
  137. ⓪0GemChar, FillType, SpecialKeySet;
  138. ⓪ FROM AESEvents IMPORT MultiEvent, lookForEntry, Event, EventSet, MessageBuffer;
  139. ⓪ FROM AESGraphics IMPORT MouseForm, GrafMouse;
  140. ⓪ FROM VDIInputs IMPORT GetMouseState;
  141. ⓪ FROM AESMenus IMPORT MenuBar;
  142. ⓪ FROM AESWindows IMPORT MouseControl, UpdateWindow;
  143. ⓪ FROM GEMEnv IMPORT RC, DeviceHandle, GemHandle, InitGem,
  144. ⓪(GEMVersion, ExitGem, CurrGemHandle;
  145. ⓪ FROM Strings IMPORT Empty, Append, Concat, Upper, Pos, Delete, Assign,
  146. ⓪(Compare, equal, Insert, PosLen, Length;
  147. ⓪ IMPORT Strings;
  148. ⓪ FROM StrConv IMPORT CardToStr, LHexToStr, StrToLCard, StrToCard, IntToStr;
  149. ⓪ FROM Storage IMPORT Enlarge, ALLOCATE, DEALLOCATE, Inconsistent,
  150. ⓪+MemAvail, MemSize, AllAvail;
  151. ⓪ FROM StorBase IMPORT FullStorBaseAccess;
  152. ⓪ FROM ArgCV IMPORT InitArgCV, PtrArgStr;
  153. ⓪ FROM PrgCtrl IMPORT TermProcess;
  154. ⓪ FROM PathEnv IMPORT FileSelectProc, SelectFile, NoSelect, ReplaceHome,
  155. ⓪+HomeReplaced, HomePath;
  156. ⓪ FROM PathCtrl IMPORT PathList, PathEntry;
  157. ⓪ FROM Paths IMPORT ListPos, SearchFile;
  158. ⓪ FROM ShellMsg IMPORT SrcPaths, TextName, ErrorMsg, TextCol, TextLine, ScanMode,
  159. ⓪(MainOutputPath, DefLibName, CodeName, CodeSize, Active, DefPaths,
  160. ⓪(StdPaths, ShellPath, CompilerArgs, CompilerParm, DefSfx;
  161. ⓪ FROM Files IMPORT File, Access, ReplaceMode, Open, Create, Close,
  162. ⓪(GetDateTime, SetDateTime, State, GetStateMsg, ResetState;
  163. ⓪ FROM Binary IMPORT ReadBytes, FileSize, WriteBytes, Seek, fromBegin;
  164. ⓪ FROM LibFiles IMPORT LibFile, OpenLib, CloseLib, LibQuery, LibEntry;
  165. ⓪ FROM FileNames IMPORT SplitName, SplitPath, ConcatPath;
  166. ⓪ IMPORT FileNames;
  167. ⓪ FROM Directory IMPORT DirEntry, DirQuery, MakeFullPath, GetDefaultPath,
  168. ⓪(FileAttrSet;
  169. ⓪ FROM Lists IMPORT NextEntry, ResetList, InitList, List;
  170. ⓪ FROM Clock IMPORT CurrentDate, CurrentTime, PackDate, PackTime,
  171. ⓪(Date, Time, UnpackDate, UnpackTime;
  172. ⓪ FROM SysInfo IMPORT Machine;
  173. ⓪ FROM TimeConvert IMPORT DateToText, TimeToText;
  174. ⓪ IMPORT Block;
  175. ⓪ FROM EasyExceptions IMPORT Call, Exception;
  176. ⓪ 
  177. ⓪ FROM Loader IMPORT DefaultStackSize, CallModule, LoaderResults;
  178. ⓪ 
  179. ⓪ CONST   mayCallCompiler = TRUE;  (* Bei FALSE auch Loader-IMPORT entfernen! *)
  180. ⓪ 
  181. ⓪ TYPE  ASCII = SET OF [0C..255C];
  182. ⓪ 
  183. ⓪ CONST   intVersion = 'V#0664';
  184. ⓪(Version = '2.U';
  185. ⓪ 
  186. ⓪(infoLen = 624;
  187. ⓪(
  188. ⓪(DLEoffset = $20;
  189. ⓪(DLEchar   = 16C;
  190. ⓪(
  191. ⓪(ToggleTabKey = 02C;
  192. ⓪(ETXKey       = 03C;
  193. ⓪(EnterKey     = 13C;
  194. ⓪(DELKey       = 05C;
  195. ⓪(BSKey        = 04C;
  196. ⓪(INSKey       = 01C;
  197. ⓪(LeftKey      = 06C;
  198. ⓪(RightKey     = 07C;
  199. ⓪(WordLeftKey  = 08C;
  200. ⓪(WordRightKey = 09C;
  201. ⓪(EoLnKey      = 18C;
  202. ⓪(SoLnKey      = 19C;
  203. ⓪(TabLeftKey   = 10C;
  204. ⓪(TabRightKey  = 11C;
  205. ⓪(UpKey        = 14C;
  206. ⓪(DownKey      = 15C;
  207. ⓪(PageUpKey    = 16C;
  208. ⓪(PageDownKey  = 17C;
  209. ⓪(ClrEoLnKey   = 20C;
  210. ⓪(ClrLnKey     = 21C;
  211. ⓪(FindDefKey   = 22C;
  212. ⓪(ESCKey       = 27C;
  213. ⓪(BreakKey     = 'B';
  214. ⓪(HelpKey      = 24C;
  215. ⓪(OpenFrameKey = 25C;
  216. ⓪(CloseFrameKey= 26C;
  217. ⓪(HomeKey      = 28C;
  218. ⓪(ScrlUpKey    = 29C;
  219. ⓪(ScrlDownKey  = 30C;
  220. ⓪(CompileKey   = 31C;
  221. ⓪ 
  222. ⓪(CRChar          = 13C;
  223. ⓪(LFChar          = 10C;
  224. ⓪(BSChar          = 08C;
  225. ⓪(ClrScrnChar     = 12C;
  226. ⓪(ClrEolnChar     = 01C;
  227. ⓪(ClrEoSChar      = 02C;
  228. ⓪(Cursoronchar    = 03C;
  229. ⓪(Cursoroffchar   = 04C;
  230. ⓪(Inverseonchar   = 05C;
  231. ⓪(Inverseoffchar  = 06C;
  232. ⓪(LeftChar        = 11C;
  233. ⓪(HomeChar        = 14C;
  234. ⓪(ClrLnChar       = 15C;
  235. ⓪(DownChar        = 17C;
  236. ⓪(UpChar          = 18C;
  237. ⓪ 
  238. ⓪ TYPE String = ARRAY [0..81] OF CHAR;
  239. ⓪%MaxStr = ARRAY [0..255] OF CHAR;
  240. ⓪ 
  241. ⓪ VAR fileName, errMsg, Path1, FName1,
  242. ⓪$oldString, newString                                           : String;
  243. ⓪$printLine (* Puffer für Ausgaberoutinen *)                     : MaxStr;
  244. ⓪$exitCode, LinesPerChar, PointsPerChar                          : INTEGER;
  245. ⓪$maxLine, maxCol, maxColM1, yx, dleWert, ptrXIns, nrOfTabs,
  246. ⓪$ptrY, ptrX, ptrLine, ptrCount, workCount, countDefault,dumCard,
  247. ⓪$fileD, fileT, filesInMem, sessions, oldShiftMode,
  248. ⓪$ErrorNr, CursorX, CursorY, cols, Lines, cmdMode                : CARDINAL;
  249. ⓪$bufferStart, bufferH, bufferL, bufferM, ptrStart, ptr, temp,
  250. ⓪$ptrEnd, delPtr, lastPtr, hilf, scrPtr, pFont8_8, pFont8_16,
  251. ⓪$oldSelect, pScreen, ShortKeyPtr, ColorReg                      : ADDRESS;
  252. ⓪$rptf , total, startupTime, keepTime, ErrorPos, flen, ErrLine   : LONGCARD;
  253. ⓪$direction, findCase, findSame, findWord, verify, endOfEd, color,
  254. ⓪$saved, cmdFlag, infinite, abort, accept, delFlag, insFlag,success,
  255. ⓪$forceTab, screenOK, fnOK, makeDLE, autoBack, autoIncVer, strOK,Ok1,
  256. ⓪$CursorState, tabMode, Inverse, Inserting, saveInfo, UseGem, rez_changed,
  257. ⓪$defFound, leaveDLEonWrite, restoreFileDT, modNameFound, isTT   : BOOLEAN;
  258. ⓪$oldconterm, ch                                                 : CHAR;
  259. ⓪$tabs: ARRAY [0..40] OF WORD;
  260. ⓪$oldColor: ARRAY [0..3] OF CARDINAL;
  261. ⓪$DefLibFile: LibFile;
  262. ⓪$f: File;
  263. ⓪$IOResult,Integ : INTEGER;
  264. ⓪$allowed  : ASCII;
  265. ⓪$infoBuffer : ARRAY [1..330] OF word;
  266. ⓪$fontbuffer : ARRAY [0..$7FF] OF WORD; (* 4 KB für akt. Font *)
  267. ⓪$dev        : DeviceHandle;
  268. ⓪$hdl        : GemHandle;
  269. ⓪$
  270. ⓪$(* folg. 5 Vars müssen hintereinander liegen! *)
  271. ⓪$ptrStack : ARRAY [0..15] OF ADDRESS; tags: ARRAY ['0'..'Z'] OF ADDRESS;
  272. ⓪$saveStack : ARRAY [0..15] OF ADDRESS; svs2: ARRAY ['0'..'Z'] OF ADDRESS;
  273. ⓪$svlptr: ADDRESS;
  274. ⓪ 
  275. ⓪ 
  276. ⓪ (* TABLE.B ErrorType: 'wwwcccpnpkrrcoooP'; *)
  277. ⓪ 
  278. ⓪ 
  279. ⓪ (* ED2.ICL *)
  280. ⓪ 
  281. ⓪ (*$l-*)
  282. ⓪ PROCEDURE DispChar;
  283. ⓪ BEGIN
  284. ⓪ ASSEMBLER
  285. ⓪ ;
  286. ⓪ ; *** Character auf Monitor-Screen darstellen ***
  287. ⓪ ; Char in D0.B
  288. ⓪ ; (D0/A0/A1)
  289. ⓪ ;
  290. ⓪*TST.W   color
  291. ⓪*BNE     disp8x8
  292. ⓪*
  293. ⓪*; Font-^ auf richtiges Zeichen bestimmen:
  294. ⓪*LEA     fontbuffer,A0
  295. ⓪*LSL     #4,D0         ; * 16
  296. ⓪*ADDA.W  D0,A0
  297. ⓪*; Screenoffset := CursorY * 80 * 16 + CursorX * 1
  298. ⓪*MOVE.W  CursorY,D0
  299. ⓪*; D0 * 1280
  300. ⓪*LSL.W   #8,D0
  301. ⓪*MOVE.L  D0,A1
  302. ⓪*LSL.W   #2,D0
  303. ⓪*ADD.W   A1,D0
  304. ⓪*ADD     CursorX,D0
  305. ⓪*MOVE.L  pScreen,A1
  306. ⓪*ADDA.W  D0,A1
  307. ⓪*
  308. ⓪*MOVE.B  (A0)+,(A1)
  309. ⓪*MOVE.B  (A0)+,0080(A1)
  310. ⓪*MOVE.B  (A0)+,0160(A1)
  311. ⓪*MOVE.B  (A0)+,0240(A1)
  312. ⓪*MOVE.B  (A0)+,0320(A1)
  313. ⓪*MOVE.B  (A0)+,0400(A1)
  314. ⓪*MOVE.B  (A0)+,0480(A1)
  315. ⓪*MOVE.B  (A0)+,0560(A1)
  316. ⓪*MOVE.B  (A0)+,0640(A1)
  317. ⓪*MOVE.B  (A0)+,0720(A1)
  318. ⓪*MOVE.B  (A0)+,0800(A1)
  319. ⓪*MOVE.B  (A0)+,0880(A1)
  320. ⓪*MOVE.B  (A0)+,0960(A1)
  321. ⓪*MOVE.B  (A0)+,1040(A1)
  322. ⓪*MOVE.B  (A0)+,1120(A1)
  323. ⓪*MOVE.B  (A0)+,1200(A1)
  324. ⓪*RTS
  325. ⓪ 
  326. ⓪ disp8x8   ; Font-^ auf richtiges Zeichen bestimmen:
  327. ⓪*MOVEM.W D4/D5,-(A7)
  328. ⓪*LEA     fontbuffer,A0
  329. ⓪*LSL     #3,D0         ; * 8
  330. ⓪*ADDA.W  D0,A0
  331. ⓪*; Screenoffset := CursorY * 80/160 * 8/16 + CursorX * 1/2
  332. ⓪*MOVE.W  CursorY,D0
  333. ⓪*; D0 * 1280
  334. ⓪*LSL.W   #8,D0
  335. ⓪*MOVE    D0,D4
  336. ⓪*LSL.W   #2,D0
  337. ⓪*ADD.W   D4,D0
  338. ⓪*MOVE    CursorX,D4
  339. ⓪*MOVE    D4,D5
  340. ⓪*ANDI    #$FFFE,D4
  341. ⓪*LSL     #1,D4
  342. ⓪*ADD     D4,D0
  343. ⓪*ANDI    #1,D5
  344. ⓪*ADD     D5,D0
  345. ⓪*MOVE.L  pScreen,A1
  346. ⓪*ADDA.W  D0,A1
  347. ⓪*MOVEM.W (A7)+,D4/D5
  348. ⓪*
  349. ⓪*; beide Planes müssen gesetzt werden
  350. ⓪*MOVE.B  (A0) ,(A1)
  351. ⓪*MOVE.B  (A0)+,0002(A1)
  352. ⓪*MOVE.B  (A0) ,0160(A1)
  353. ⓪*MOVE.B  (A0)+,0162(A1)
  354. ⓪*MOVE.B  (A0) ,0320(A1)
  355. ⓪*MOVE.B  (A0)+,0322(A1)
  356. ⓪*MOVE.B  (A0) ,0480(A1)
  357. ⓪*MOVE.B  (A0)+,0482(A1)
  358. ⓪*MOVE.B  (A0) ,0640(A1)
  359. ⓪*MOVE.B  (A0)+,0642(A1)
  360. ⓪*MOVE.B  (A0) ,0800(A1)
  361. ⓪*MOVE.B  (A0)+,0802(A1)
  362. ⓪*MOVE.B  (A0) ,0960(A1)
  363. ⓪*MOVE.B  (A0)+,0962(A1)
  364. ⓪*MOVE.B  (A0) ,1120(A1)
  365. ⓪*MOVE.B  (A0)+,1122(A1)
  366. ⓪ END
  367. ⓪ END DispChar;
  368. ⓪ 
  369. ⓪ (*$l-*)
  370. ⓪ PROCEDURE NextCharMono;
  371. ⓪ BEGIN
  372. ⓪ ASSEMBLER
  373. ⓪(; Font-^ auf richtiges Zeichen bestimmen:
  374. ⓪(LEA     fontbuffer,A0
  375. ⓪(LSL     #4,D0         ; * 16
  376. ⓪(ADDA.W  D0,A0
  377. ⓪(ADDQ.L  #1,A1
  378. ⓪(MOVE.B  (A0)+,(A1)
  379. ⓪(MOVE.B  (A0)+,0080(A1)
  380. ⓪(MOVE.B  (A0)+,0160(A1)
  381. ⓪(MOVE.B  (A0)+,0240(A1)
  382. ⓪(MOVE.B  (A0)+,0320(A1)
  383. ⓪(MOVE.B  (A0)+,0400(A1)
  384. ⓪(MOVE.B  (A0)+,0480(A1)
  385. ⓪(MOVE.B  (A0)+,0560(A1)
  386. ⓪(MOVE.B  (A0)+,0640(A1)
  387. ⓪(MOVE.B  (A0)+,0720(A1)
  388. ⓪(MOVE.B  (A0)+,0800(A1)
  389. ⓪(MOVE.B  (A0)+,0880(A1)
  390. ⓪(MOVE.B  (A0)+,0960(A1)
  391. ⓪(MOVE.B  (A0)+,1040(A1)
  392. ⓪(MOVE.B  (A0)+,1120(A1)
  393. ⓪(MOVE.B  (A0)+,1200(A1)
  394. ⓪ END
  395. ⓪ END NextCharMono;
  396. ⓪ 
  397. ⓪ (*$l-*)
  398. ⓪ PROCEDURE NextCharColor;
  399. ⓪ BEGIN
  400. ⓪ ASSEMBLER
  401. ⓪(; Font-^ auf richtiges Zeichen bestimmen:
  402. ⓪(LEA     fontbuffer,A0
  403. ⓪(LSL     #3,D0         ; * 8
  404. ⓪(ADDA.W  D0,A0
  405. ⓪(MOVE.W  A1,D0
  406. ⓪(BTST    #0,D0
  407. ⓪(BEQ     even
  408. ⓪(ADDQ.L  #3,A1
  409. ⓪(BRA     odd0
  410. ⓪ even    ADDQ.L  #1,A1
  411. ⓪ odd0    MOVE.B  (A0) ,(A1)
  412. ⓪(MOVE.B  (A0)+,0002(A1)
  413. ⓪(MOVE.B  (A0) ,0160(A1)
  414. ⓪(MOVE.B  (A0)+,0162(A1)
  415. ⓪(MOVE.B  (A0) ,0320(A1)
  416. ⓪(MOVE.B  (A0)+,0322(A1)
  417. ⓪(MOVE.B  (A0) ,0480(A1)
  418. ⓪(MOVE.B  (A0)+,0482(A1)
  419. ⓪(MOVE.B  (A0) ,0640(A1)
  420. ⓪(MOVE.B  (A0)+,0642(A1)
  421. ⓪(MOVE.B  (A0) ,0800(A1)
  422. ⓪(MOVE.B  (A0)+,0802(A1)
  423. ⓪(MOVE.B  (A0) ,0960(A1)
  424. ⓪(MOVE.B  (A0)+,0962(A1)
  425. ⓪(MOVE.B  (A0) ,1120(A1)
  426. ⓪(MOVE.B  (A0)+,1122(A1)
  427. ⓪ END
  428. ⓪ END NextCharColor;
  429. ⓪ 
  430. ⓪ 
  431. ⓪ (*$l-*)
  432. ⓪ PROCEDURE InvertChar;
  433. ⓪ BEGIN
  434. ⓪ ASSEMBLER
  435. ⓪ ;
  436. ⓪ ; *** Character auf Monitor-Screen invertieren ***
  437. ⓪ ; (D0/A0)
  438. ⓪ ;
  439. ⓪*TST.W   color
  440. ⓪*BNE     disp8x8
  441. ⓪ 
  442. ⓪*MOVE.W  CursorY,D0
  443. ⓪*LSL.W   #8,D0
  444. ⓪*MOVE.L  D0,A0
  445. ⓪*LSL.W   #2,D0
  446. ⓪*ADD.W   A0,D0
  447. ⓪*ADD     CursorX,D0
  448. ⓪*MOVE.L  pScreen,A0
  449. ⓪*ADDA.W  D0,A0
  450. ⓪*MOVEQ   #-1,D0
  451. ⓪*EOR.B   D0,(A0)
  452. ⓪*EOR.B   D0,0080(A0)
  453. ⓪*EOR.B   D0,0160(A0)
  454. ⓪*EOR.B   D0,0240(A0)
  455. ⓪*EOR.B   D0,0320(A0)
  456. ⓪*EOR.B   D0,0400(A0)
  457. ⓪*EOR.B   D0,0480(A0)
  458. ⓪*EOR.B   D0,0560(A0)
  459. ⓪*EOR.B   D0,0640(A0)
  460. ⓪*EOR.B   D0,0720(A0)
  461. ⓪*EOR.B   D0,0800(A0)
  462. ⓪*EOR.B   D0,0880(A0)
  463. ⓪*EOR.B   D0,0960(A0)
  464. ⓪*EOR.B   D0,1040(A0)
  465. ⓪*EOR.B   D0,1120(A0)
  466. ⓪*EOR.B   D0,1200(A0)
  467. ⓪*RTS
  468. ⓪ 
  469. ⓪ disp8x8   MOVEM.W D4/D5,-(A7)
  470. ⓪*; Screenoffset := CursorY * 80/160 * 8/16 + CursorX * 1/2
  471. ⓪*MOVE.W  CursorY,D0
  472. ⓪*; D0 * 1280
  473. ⓪*LSL.W   #8,D0
  474. ⓪*MOVE    D0,D4
  475. ⓪*LSL.W   #2,D0
  476. ⓪*ADD.W   D4,D0
  477. ⓪*MOVE    CursorX,D4
  478. ⓪*MOVE    D4,D5
  479. ⓪*ANDI    #$FFFE,D4
  480. ⓪*LSL     #1,D4
  481. ⓪*ADD     D4,D0
  482. ⓪*ANDI    #1,D5
  483. ⓪*ADD     D5,D0
  484. ⓪*MOVE.L  pScreen,A0
  485. ⓪*ADDA.W  D0,A0
  486. ⓪*MOVEM.W (A7)+,D4/D5
  487. ⓪*MOVEQ   #-1,D0
  488. ⓪*EOR.B   D0,(A0)
  489. ⓪*EOR.B   D0,0002(A0)
  490. ⓪*EOR.B   D0,0160(A0)
  491. ⓪*EOR.B   D0,0162(A0)
  492. ⓪*EOR.B   D0,0320(A0)
  493. ⓪*EOR.B   D0,0322(A0)
  494. ⓪*EOR.B   D0,0480(A0)
  495. ⓪*EOR.B   D0,0482(A0)
  496. ⓪*EOR.B   D0,0640(A0)
  497. ⓪*EOR.B   D0,0642(A0)
  498. ⓪*EOR.B   D0,0800(A0)
  499. ⓪*EOR.B   D0,0802(A0)
  500. ⓪*EOR.B   D0,0960(A0)
  501. ⓪*EOR.B   D0,0962(A0)
  502. ⓪*EOR.B   D0,1120(A0)
  503. ⓪*EOR.B   D0,1122(A0)
  504. ⓪ END
  505. ⓪ END InvertChar;
  506. ⓪ 
  507. ⓪ (*$l-*)
  508. ⓪ PROCEDURE ScrnCurOff;
  509. ⓪ BEGIN
  510. ⓪ ASSEMBLER
  511. ⓪(; CLR.L   CursorCnt
  512. ⓪(TST     CursorState
  513. ⓪(BEQ     CurOffE
  514. ⓪(JSR     InvertChar
  515. ⓪(CLR     CursorState
  516. ⓪ CurOffE
  517. ⓪ END;
  518. ⓪ END ScrnCurOff;
  519. ⓪ 
  520. ⓪ 
  521. ⓪ (*$L-*)
  522. ⓪ PROCEDURE BufferDisp;
  523. ⓪ BEGIN
  524. ⓪ ASSEMBLER
  525. ⓪(DBRA    D3,cont0
  526. ⓪(RTS
  527. ⓪ cont0   JSR     ScrnCurOff
  528. ⓪(CLR     D0
  529. ⓪(TST.W   color
  530. ⓪(BEQ     mono
  531. ⓪(BRA     col
  532. ⓪ 
  533. ⓪ mono2:  CLR     D0
  534. ⓪(MOVE.B  (A2)+,D0
  535. ⓪(JSR     NextCharMono
  536. ⓪(ADDQ.W  #1,CursorX
  537. ⓪(DBRA    D3,mono2
  538. ⓪(RTS
  539. ⓪ mono    MOVE.B  (A2)+,D0
  540. ⓪(JSR     DispChar
  541. ⓪(ADDQ.W  #1,CursorX
  542. ⓪(DBRA    D3,mono2
  543. ⓪(RTS
  544. ⓪ 
  545. ⓪ 
  546. ⓪ color2  CLR     D0
  547. ⓪(MOVE.B  (A2)+,D0
  548. ⓪(JSR     NextCharColor
  549. ⓪(ADDQ.W  #1,CursorX
  550. ⓪(DBRA    D3,color2
  551. ⓪(RTS
  552. ⓪ col     MOVE.B  (A2)+,D0
  553. ⓪(JSR     DispChar
  554. ⓪(ADDQ.W  #1,CursorX
  555. ⓪(DBRA    D3,color2
  556. ⓪ END
  557. ⓪ END BufferDisp;
  558. ⓪ 
  559. ⓪ (*$L-*)
  560. ⓪ PROCEDURE ClearEndOfLine;
  561. ⓪ BEGIN
  562. ⓪ ASSEMBLER
  563. ⓪(MOVE    CursorX,D0
  564. ⓪(BTST    #0,D0
  565. ⓪(BEQ     clreol
  566. ⓪(MOVEQ   #' ',D0
  567. ⓪(JSR     DispChar
  568. ⓪(ADDQ    #1,CursorX
  569. ⓪(BSR     clreol
  570. ⓪(SUBQ    #1,CursorX
  571. ⓪ ClEolE0 RTS
  572. ⓪ 
  573. ⓪ clreol  TST.W   color
  574. ⓪(BNE     disp8x8
  575. ⓪ 
  576. ⓪(MOVE    cols,D0         ; 80
  577. ⓪(SUB     CursorX,D0      ; ergibt gerade Anzahl zu löschender Bytes
  578. ⓪(BLS     ClEolE0
  579. ⓪(LSR     #1,D0           ; Anzahl Words
  580. ⓪(SUBQ    #1,D0
  581. ⓪(MOVE    D1,-(A7)
  582. ⓪(MOVE    D0,-(A7)
  583. ⓪(MOVE.W  CursorY,D0
  584. ⓪(LSL.W   #8,D0
  585. ⓪(MOVE.L  D0,A0
  586. ⓪(LSL.W   #2,D0
  587. ⓪(ADD.W   A0,D0
  588. ⓪(ADD     CursorX,D0      ; ist immer gerade X-Pos.
  589. ⓪(MOVE.L  pScreen,A0
  590. ⓪(ADDA.W  D0,A0
  591. ⓪(MOVE.L  A0,-(A7)
  592. ⓪(MOVE    #15,-(A7)       ; Loop-Counter
  593. ⓪ l1      MOVE    6(A7),D0
  594. ⓪(CLR     D1
  595. ⓪ l2      MOVE    D1,(A0)+        ; Eine Raster-Zeile löschen
  596. ⓪(DBRA    D0,l2
  597. ⓪(ADDI.L  #80,2(A7)
  598. ⓪(MOVE.L  2(A7),A0
  599. ⓪(SUBQ    #1,(A7)         ; alle 16 Raster-Zeilen löschen
  600. ⓪(BCC     l1
  601. ⓪(ADDQ.L  #8,A7
  602. ⓪(MOVE    (A7)+,D1
  603. ⓪ ClEolE1 RTS
  604. ⓪ 
  605. ⓪ disp8x8 MOVE    cols,D0         ; 80
  606. ⓪(SUB     CursorX,D0      ; ergibt gerade Anzahl zu löschender Words
  607. ⓪(BLS     ClEolE1
  608. ⓪(LSR     #1,D0           ; Anzahl Longs
  609. ⓪(SUBQ    #1,D0
  610. ⓪(MOVE    D4,-(A7)
  611. ⓪(MOVE    D0,-(A7)
  612. ⓪(; Screenoffset := CursorY * 160 * 8 + CursorX * 2
  613. ⓪(MOVE.W  CursorY,D0
  614. ⓪(; D0 * 1280
  615. ⓪(LSL.W   #8,D0
  616. ⓪(MOVE    D0,D4
  617. ⓪(LSL.W   #2,D0
  618. ⓪(ADD.W   D4,D0
  619. ⓪(MOVE    CursorX,D4      ; ist immer gerade X-Pos.
  620. ⓪(LSL     #1,D4
  621. ⓪(ADD     D4,D0
  622. ⓪(MOVE.L  pScreen,A0
  623. ⓪(ADDA.W  D0,A0
  624. ⓪(MOVE.L  A0,-(A7)
  625. ⓪(MOVE    #7,-(A7)        ; Loop-Counter
  626. ⓪ l3      MOVE    6(A7),D0
  627. ⓪(CLR     D4
  628. ⓪ l4      MOVE.L  D4,(A0)+        ; Eine Raster-Zeile löschen
  629. ⓪(DBRA    D0,l4
  630. ⓪(ADDI.L  #160,2(A7)
  631. ⓪(MOVE.L  2(A7),A0
  632. ⓪(SUBQ    #1,(A7)         ; alle 8 Raster-Zeilen löschen
  633. ⓪(BCC     l3
  634. ⓪(ADDQ.L  #8,A7
  635. ⓪(MOVE    (A7)+,D4
  636. ⓪ END;
  637. ⓪ END ClearEndOfLine;
  638. ⓪ 
  639. ⓪ (*$l-*)
  640. ⓪ PROCEDURE BufferWrite ( buf : ADDRESS; no : CARDINAL );
  641. ⓪ BEGIN
  642. ⓪ ASSEMBLER
  643. ⓪(MOVEM.L D0/D6/A0/A1/A2,-(A7)
  644. ⓪(JSR     ScrnCurOff
  645. ⓪(MOVE.W  -(A3),D6
  646. ⓪(MOVE.L  -(A3),A2
  647. ⓪(BRA.L   cont0
  648. ⓪ 
  649. ⓪ JScrnCurOff
  650. ⓪(JMP     ScrnCurOff
  651. ⓪ 
  652. ⓪ InverseOff
  653. ⓪(CLR     Inverse
  654. ⓪(RTS
  655. ⓪ 
  656. ⓪ InverseOn
  657. ⓪(MOVE    #1,Inverse
  658. ⓪ ClEolE0 RTS
  659. ⓪ 
  660. ⓪ ClearLine
  661. ⓪(MOVE    CursorX,-(A7)
  662. ⓪(CLR.W   CursorX
  663. ⓪(JSR     ClearEndOfLine
  664. ⓪(MOVE    (A7)+,CursorX
  665. ⓪(RTS
  666. ⓪ 
  667. ⓪ CursorHome
  668. ⓪(CLR.W   CursorX
  669. ⓪(CLR.W   CursorY
  670. ⓪(RTS
  671. ⓪ 
  672. ⓪ ClearEoL
  673. ⓪(JMP     ClearEndOfLine
  674. ⓪ 
  675. ⓪ ClearScrn
  676. ⓪(BSR     CursorHome
  677. ⓪ 
  678. ⓪ ClearEoS
  679. ⓪(JSR     ClearEndOfLine
  680. ⓪(MOVE    CursorX,-(A7)
  681. ⓪(MOVE    CursorY,-(A7)
  682. ⓪(CLR.W   CursorX
  683. ⓪ ClrEosL ADDQ.W  #1,CursorY
  684. ⓪(MOVE    CursorY,D0
  685. ⓪(CMP     Lines,D0
  686. ⓪(BCC     ClrEosE
  687. ⓪(JSR     ClearEndOfLine
  688. ⓪(BRA     ClrEosL
  689. ⓪ ClrEosE MOVE    (A7)+,CursorY
  690. ⓪(MOVE    (A7)+,CursorX
  691. ⓪ ScrnRTS RTS
  692. ⓪(
  693. ⓪ ScrollUp
  694. ⓪(MOVEM.L D1-D7/A2-A6,-(A7)
  695. ⓪(MOVE.L  pScreen,A0
  696. ⓪(MOVE.L  A0,A1
  697. ⓪(ADDA.W  #1280,A1
  698. ⓪(MOVE.W  #640-1,D0
  699. ⓪ ScrlUL1 MOVEM.L (A1)+,D1-D7/A2-A6
  700. ⓪(MOVEM.L D1-D7/A2-A6,(A0)
  701. ⓪(ADDA.W  #48,A0     ; = 12 * 4
  702. ⓪(DBRA    D0,ScrlUL1
  703. ⓪(MOVEM.L (A7)+,D1-D7/A2-A6
  704. ⓪(RTS
  705. ⓪(
  706. ⓪ ScrollDown
  707. ⓪(MOVEM.L D1-D7/A2-A6,-(A7)
  708. ⓪(MOVE.L  pScreen,A0
  709. ⓪(ADDA.W  #32000,A0
  710. ⓪(MOVE.L  A0,A1
  711. ⓪(SUBA.W  #1280,A1
  712. ⓪(MOVE.W  #640-1,D0
  713. ⓪ ScrlDL1 SUBA.W  #48,A1     ; = 12 * 4
  714. ⓪(MOVEM.L (A1),D1-D7/A2-A6
  715. ⓪(MOVEM.L D1-D7/A2-A6,-(A0)
  716. ⓪(DBRA    D0,ScrlDL1
  717. ⓪(MOVEM.L (A7)+,D1-D7/A2-A6
  718. ⓪(RTS
  719. ⓪(
  720. ⓪ ScrnCR  CLR.W   CursorX
  721. ⓪(
  722. ⓪ CursorDown
  723. ⓪(ADDQ.W  #1,CursorY
  724. ⓪(MOVE    CursorY,D0
  725. ⓪(CMP     Lines,D0
  726. ⓪(BCS     CurDE
  727. ⓪(MOVE.W  Lines,D0
  728. ⓪(SUBQ    #1,D0
  729. ⓪(MOVE    D0,CursorY
  730. ⓪(BSR     ScrollUp
  731. ⓪ CurDC   MOVE    CursorX,-(A7)
  732. ⓪(CLR.W   CursorX
  733. ⓪(JSR     ClearEndOfLine
  734. ⓪(MOVE    (A7)+,CursorX
  735. ⓪ CurDE   RTS
  736. ⓪(
  737. ⓪ CursorUp
  738. ⓪(SUBQ    #1,CursorY
  739. ⓪(BCC     CurDE
  740. ⓪(CLR     CursorY
  741. ⓪(BSR     ScrollDown
  742. ⓪(BRA     CurDC
  743. ⓪ (*
  744. ⓪ IncCursor
  745. ⓪(ADDQ.W  #1,CursorX
  746. ⓪ ChkCursor
  747. ⓪(MOVE    CursorX,D0
  748. ⓪(CMP     cols,D0
  749. ⓪(BCS     CurDE
  750. ⓪(CLR.W   CursorX
  751. ⓪(BRA     CursorDown
  752. ⓪ *)
  753. ⓪ DecCursor
  754. ⓪(SUBQ.W  #1,CursorX
  755. ⓪(BCC     ScrnRTS
  756. ⓪(MOVE    cols,CursorX
  757. ⓪(SUBQ.W  #1,CursorX
  758. ⓪(BRA     CursorUp
  759. ⓪ 
  760. ⓪ BackSpace
  761. ⓪(BSR     DecCursor
  762. ⓪(MOVEQ   #' ',D0
  763. ⓪(JMP     DispChar
  764. ⓪(
  765. ⓪ ScrnCurOn
  766. ⓪(; CLR.L   CursorCnt
  767. ⓪(; BSR     ChkCursor
  768. ⓪(TST     CursorState
  769. ⓪(BNE     CurOnE
  770. ⓪(JSR     InvertChar
  771. ⓪(MOVE    #1,CursorState
  772. ⓪ CurOnE  RTS
  773. ⓪ 
  774. ⓪ CtrlOut CMPI    #CRChar,D0
  775. ⓪(BEQ     ScrnCR
  776. ⓪(CMPI    #BSChar,D0
  777. ⓪(BEQ     BackSpace
  778. ⓪(CMPI    #LeftChar,D0
  779. ⓪(BEQ     DecCursor
  780. ⓪(CMPI    #UpChar,D0
  781. ⓪(BEQ     CursorUp
  782. ⓪(CMPI    #DownChar,D0
  783. ⓪(BEQ     CursorDown
  784. ⓪(CMPI    #HomeChar,D0
  785. ⓪(BEQ     CursorHome
  786. ⓪(CMPI    #ClrLnChar,D0
  787. ⓪(BEQ     ClearLine
  788. ⓪(CMPI    #ClrScrnChar,D0
  789. ⓪(BEQ     ClearScrn
  790. ⓪(CMPI    #ClrEolnChar,D0
  791. ⓪(BEQ     ClearEoL
  792. ⓪(CMPI    #ClrEoSChar,D0
  793. ⓪(BEQ     ClearEoS
  794. ⓪(CMPI    #Cursoronchar,D0
  795. ⓪(BEQ     ScrnCurOn
  796. ⓪(CMPI    #Cursoroffchar,D0
  797. ⓪(BEQ     JScrnCurOff
  798. ⓪(CMPI    #Inverseoffchar,D0
  799. ⓪(BEQ     InverseOff
  800. ⓪(CMPI    #Inverseonchar,D0
  801. ⓪(BEQ     InverseOn
  802. ⓪(RTS
  803. ⓪(
  804. ⓪ OutC0   TST     D0
  805. ⓪(BEQ     end0
  806. ⓪(BSR     CtrlOut
  807. ⓪(BRA     cont0
  808. ⓪ 
  809. ⓪ OutC1   JSR     InvertChar
  810. ⓪(BRA     OutC2
  811. ⓪ 
  812. ⓪ ScrnOut CLR     D0
  813. ⓪(MOVE.B  (A2)+,D0
  814. ⓪(CMPI    #' ',D0
  815. ⓪(BCS     OutC0
  816. ⓪(JSR     DispChar
  817. ⓪(TST     Inverse
  818. ⓪(BNE     OutC1
  819. ⓪ OutC2   ADDQ.W  #1,CursorX
  820. ⓪ cont0   DBRA    D6,ScrnOut
  821. ⓪ end0    MOVEM.L (A7)+,D0/D6/A0/A1/A2
  822. ⓪ END
  823. ⓪ END BufferWrite;
  824. ⓪ 
  825. ⓪ (* ED3.ICL *)
  826. ⓪ 
  827. ⓪ (*$L-*)
  828. ⓪ PROCEDURE Rename (oldName, newName: ADDRESS): INTEGER;
  829. ⓪"BEGIN
  830. ⓪$ASSEMBLER
  831. ⓪(MOVE.L  -(A3),-(A7)     ; newName
  832. ⓪(MOVE.L  -(A3),-(A7)     ; oldName
  833. ⓪(CLR     -(A7)
  834. ⓪(MOVE    #$56,-(A7)
  835. ⓪(TRAP    #1
  836. ⓪(ADDA.W  #12,A7
  837. ⓪(TST.L   D0
  838. ⓪(BMI     E
  839. ⓪(MOVEQ   #0,D0
  840. ⓪%E: MOVE    D0,(A3)+
  841. ⓪$END
  842. ⓪"END Rename;
  843. ⓪ 
  844. ⓪ (*$L-*)
  845. ⓪ PROCEDURE FDelete (name: ADDRESS): INTEGER;
  846. ⓪"BEGIN
  847. ⓪$ASSEMBLER
  848. ⓪(MOVE.L  -(A3),-(A7)
  849. ⓪(MOVE    #$41,-(A7)
  850. ⓪(TRAP    #1
  851. ⓪(ADDQ.L  #6,A7
  852. ⓪(TST.L   D0
  853. ⓪(BMI     E
  854. ⓪(MOVEQ   #0,D0
  855. ⓪%E: MOVE    D0,(A3)+
  856. ⓪$END
  857. ⓪"END FDelete;
  858. ⓪ 
  859. ⓪ (*$l+*)
  860. ⓪ PROCEDURE GotoXY ( x, y : cardinal );
  861. ⓪ BEGIN
  862. ⓪"CursorX := x;
  863. ⓪"CursorY := y
  864. ⓪ END GotoXY;
  865. ⓪ 
  866. ⓪ PROCEDURE Conout ( c: CHAR );
  867. ⓪"(*$L-*)
  868. ⓪"BEGIN
  869. ⓪$ASSEMBLER
  870. ⓪(SUBQ.L  #1,A3
  871. ⓪(MOVE.B  -(A3),D0
  872. ⓪(MOVE    D0,-(A7)
  873. ⓪(MOVE    #2,-(A7)
  874. ⓪(MOVE    #3,-(A7)
  875. ⓪(TRAP    #13
  876. ⓪(ADDQ.L  #6,A7
  877. ⓪$END
  878. ⓪"END Conout;
  879. ⓪"(*$L=*)
  880. ⓪ 
  881. ⓪ (*$l-*)
  882. ⓪ PROCEDURE Bell;
  883. ⓪ BEGIN
  884. ⓪"Conout ( 7C )
  885. ⓪ END Bell;
  886. ⓪ 
  887. ⓪ 
  888. ⓪ PROCEDURE Today (): CARDINAL;
  889. ⓪"BEGIN
  890. ⓪$RETURN PackDate (CurrentDate ())
  891. ⓪"END Today;
  892. ⓪ 
  893. ⓪ PROCEDURE DirTime (): CARDINAL;
  894. ⓪"BEGIN
  895. ⓪$RETURN PackTime (CurrentTime ())
  896. ⓪"END DirTime;
  897. ⓪ 
  898. ⓪ 
  899. ⓪ (*$l-*)
  900. ⓪ PROCEDURE GotoXYd1;             (* GoToXY Highbyte(d1)=Y, Lowbyte(d1)=X *)
  901. ⓪ BEGIN
  902. ⓪ ASSEMBLER ;rettet nur d1,a0
  903. ⓪(movem.l d1/a0,-(a7)
  904. ⓪(cmp.b   maxCol,d1
  905. ⓪(bls     nopa
  906. ⓪(move.b  maxCol,d1
  907. ⓪ nopa    move    d1,ptrY
  908. ⓪(move.b  d1,ptrX
  909. ⓪(clr     (a3)+
  910. ⓪(move.b  d1,-1(a3)
  911. ⓪(lsr     #8,d1
  912. ⓪(move    d1,(a3)+
  913. ⓪(jsr     GoToXY
  914. ⓪(movem.l (a7)+,d1/a0
  915. ⓪ END
  916. ⓪ END GotoXYd1;
  917. ⓪ 
  918. ⓪ (*$l-*)
  919. ⓪ PROCEDURE ChrOut;               (* Ausgabe eines Zeichens in d0 *)
  920. ⓪ BEGIN                           (* mit Aktualisierung der X,Y-Koordinaten *)
  921. ⓪ ASSEMBLER ;rettet alle Register
  922. ⓪(movem.l d0/d1/d2/d3/d4/d5/d6/a0/A1/A2,-(a7)
  923. ⓪(cmpi.b  #' ',d0
  924. ⓪(bcc     asciich
  925. ⓪(cmpi.b  #CRchar,d0
  926. ⓪(bne     ctrl1
  927. ⓪ newlin  addq.b  #1,ptrY
  928. ⓪(clr.b   ptrX
  929. ⓪(moveq   #0,d1
  930. ⓪(move.b  ptrY,d1
  931. ⓪(cmp.w   maxLine,d1
  932. ⓪(bls     doit
  933. ⓪(bra     lineup
  934. ⓪ ctrl1   cmpi.b  #LeftChar,d0
  935. ⓪(beq     ctrl11
  936. ⓪(cmpi.b  #BSchar,d0
  937. ⓪(bne     ctrl2
  938. ⓪ ctrl11  subq.b  #1,ptrX
  939. ⓪(bpl     doit
  940. ⓪(move.b  maxCol,ptrX
  941. ⓪ lineup  subq.b  #1,ptrY
  942. ⓪(bpl     doit
  943. ⓪(clr.b   ptrY
  944. ⓪(bra     doit
  945. ⓪ ctrl2   cmpi.b  #ClrScrnChar,d0
  946. ⓪(bne     doit
  947. ⓪(clr.b   ptrY
  948. ⓪(clr.b   ptrX
  949. ⓪(bra     doit
  950. ⓪ asciich move.b  ptrX,d1
  951. ⓪(cmp.b   maxCol,d1
  952. ⓪(bcc     newlin
  953. ⓪(addq.b  #1,d1
  954. ⓪(move.b  d1,ptrX
  955. ⓪ doit    lea     printLine,a0
  956. ⓪(move.b  d0,(a0)
  957. ⓪(move.l  a0,(a3)+
  958. ⓪(move    #1,(a3)+
  959. ⓪(jsr     BufferWrite
  960. ⓪(movem.l (a7)+,d0/d1/d2/d3/d4/d5/d6/a0/A1/A2
  961. ⓪ END
  962. ⓪ END ChrOut;
  963. ⓪ 
  964. ⓪ (*$l-*)
  965. ⓪ PROCEDURE Write(cr: CHAR);             (* dieses Write geht ⁿber ChrOut *)
  966. ⓪ BEGIN
  967. ⓪ ASSEMBLER
  968. ⓪(subq.l #1,a3
  969. ⓪(move.b -(a3),d0
  970. ⓪(jmp  ChrOut
  971. ⓪ END
  972. ⓪ END Write;
  973. ⓪ 
  974. ⓪ (*$l-*)
  975. ⓪ PROCEDURE WriteLn;                      (* damit x-y-Koord. bekannt *)
  976. ⓪ BEGIN
  977. ⓪"ASSEMBLER moveq #CRchar,d0 jmp ChrOut END
  978. ⓪ END WriteLn;
  979. ⓪ 
  980. ⓪ (*$l-*)
  981. ⓪ PROCEDURE ClrLn;                       (* damit x-y-Koord. bekannt *)
  982. ⓪ BEGIN
  983. ⓪ ASSEMBLER
  984. ⓪(moveq   #ClrEOLNchar,d0
  985. ⓪(jsr     ChrOut
  986. ⓪(jmp     WriteLn
  987. ⓪ END
  988. ⓪ END ClrLn;
  989. ⓪ 
  990. ⓪ (*$l-*)
  991. ⓪ PROCEDURE WriteString(REF s:ARRAY OF CHAR);
  992. ⓪ BEGIN
  993. ⓪ ASSEMBLER
  994. ⓪(ADDQ    #1,-2(A3)
  995. ⓪(jsr     BufferWrite
  996. ⓪(move    cursorX,d1
  997. ⓪(move.b  d1,ptrX
  998. ⓪(move    cursorY,d1
  999. ⓪(move.b  d1,ptrY
  1000. ⓪ END;
  1001. ⓪ END WriteString;
  1002. ⓪ 
  1003. ⓪ 
  1004. ⓪ (*$l+*)
  1005. ⓪ PROCEDURE WriteLCard(c:LONGCARD);
  1006. ⓪ BEGIN
  1007. ⓪"WriteString (CardToStr(c,0))
  1008. ⓪ END WriteLCard;
  1009. ⓪ 
  1010. ⓪ 
  1011. ⓪ (*$l+*)
  1012. ⓪ PROCEDURE PrintError ( errno : INTEGER );
  1013. ⓪ VAR s: String;
  1014. ⓪ BEGIN
  1015. ⓪"writestring('I/O error: ');
  1016. ⓪"GetStateMsg (errno, s);
  1017. ⓪"writestring(s);
  1018. ⓪"writeln;
  1019. ⓪ END PrintError;
  1020. ⓪ 
  1021. ⓪ VAR LastKey: GemChar;
  1022. ⓪$LastMeta: SpecialKeySet;
  1023. ⓪$buttons: mButtonSet;
  1024. ⓪$Mousepoint: Point;
  1025. ⓪$keyBuffered: BOOLEAN;
  1026. ⓪ 
  1027. ⓪ (*$L+*)
  1028. ⓪ PROCEDURE LookForKey;
  1029. ⓪"VAR events: EventSet; clicks: CARDINAL; key: GemChar; keystate: SpecialKeySet;
  1030. ⓪&mp: Point; msgbuf: MessageBuffer; buts: MButtonSet;
  1031. ⓪"BEGIN
  1032. ⓪$MultiEvent (EventSet {keyboard, timer},
  1033. ⓪00, MButtonSet {}, MButtonSet {},
  1034. ⓪0lookForEntry, Rectangle{0,0,0,0},
  1035. ⓪0lookForEntry, Rectangle{0,0,0,0},
  1036. ⓪0msgbuf, 0, mp, buts, keystate, key, clicks, events);
  1037. ⓪$IF ~keyBuffered & (keyboard IN events) THEN
  1038. ⓪&keyBuffered:= TRUE;
  1039. ⓪&LastKey:= key;
  1040. ⓪&LastMeta:= keystate
  1041. ⓪$END
  1042. ⓪"END LookForKey;
  1043. ⓪ 
  1044. ⓪ (*$L-*)
  1045. ⓪ PROCEDURE KeyPressed () : BOOLEAN;
  1046. ⓪ BEGIN
  1047. ⓪ ASSEMBLER
  1048. ⓪(JSR     LookForKey
  1049. ⓪(TST.L   ShortKeyPtr
  1050. ⓪(BNE     yes
  1051. ⓪((*
  1052. ⓪*MOVE    #2,-(A7)
  1053. ⓪*MOVE    #1,-(A7)
  1054. ⓪*TRAP    #13
  1055. ⓪*ADDQ.L  #4,A7
  1056. ⓪*TST.W   D0
  1057. ⓪(*)
  1058. ⓪(MOVE    keyBuffered,D0
  1059. ⓪ yes     SNE     D0
  1060. ⓪(AND     #1,D0
  1061. ⓪(MOVE    D0,(A3)+
  1062. ⓪ END
  1063. ⓪ END KeyPressed;
  1064. ⓪ 
  1065. ⓪ 
  1066. ⓪ (*$l-*)
  1067. ⓪ PROCEDURE GetKeyD0;
  1068. ⓪ BEGIN
  1069. ⓪ ASSEMBLER
  1070. ⓪(MOVEM.L D1/D2/A5/A6,-(A7)
  1071. ⓪ notValid
  1072. ⓪(TST.L   ShortKeyPtr
  1073. ⓪(BNE     GetShort
  1074. ⓪(
  1075. ⓪(moveq   #CursorOnChar,d0
  1076. ⓪(jsr     ChrOut
  1077. ⓪(
  1078. ⓪((*
  1079. ⓪*MOVE    #2,-(A7)
  1080. ⓪*MOVE    #2,-(A7)
  1081. ⓪*TRAP    #13             ; Get Key
  1082. ⓪*ADDQ.L  #4,A7
  1083. ⓪*MOVE.L  D0,-(A7)
  1084. ⓪*MOVE.B  (A7),D2         ; D2: shift status
  1085. ⓪*ANDI    #$F,D2          ;     nur shift, ctrl, alt drin lassen
  1086. ⓪*CLR.B   (A7)
  1087. ⓪(*)
  1088. ⓪&waitforkey:
  1089. ⓪(JSR     LookForKey
  1090. ⓪(TST     keyBuffered
  1091. ⓪(BEQ     waitforkey
  1092. ⓪(CLR     keyBuffered
  1093. ⓪(move.w  LastKey,D0
  1094. ⓪(andi    #$FF,D0         ; Char-Code
  1095. ⓪(swap    D0
  1096. ⓪(move.b  LastKey,D0      ; Scan-Code
  1097. ⓪(andi    #$FF,D0
  1098. ⓪(swap    D0
  1099. ⓪(MOVE.L  D0,-(A7)
  1100. ⓪(MOVE.B  LastMeta,D2     ; D2: shift status
  1101. ⓪(ANDI    #$F,D2          ;     nur shift, ctrl, alt drin lassen
  1102. ⓪(
  1103. ⓪(moveq   #CursorOffChar,d0
  1104. ⓪(jsr     ChrOut
  1105. ⓪(
  1106. ⓪(MOVE.L  (A7)+,D0
  1107. ⓪(
  1108. ⓪(TST     inserting
  1109. ⓪(BEQ     cont
  1110. ⓪(
  1111. ⓪(LEA     shortKeys(PC),A5
  1112. ⓪ srch2   MOVE.L  (A5)+,D1
  1113. ⓪(BEQ     cont
  1114. ⓪(CMP.L   D0,D1
  1115. ⓪(BNE     noctrl
  1116. ⓪(MOVE.L  A5,ShortKeyPtr
  1117. ⓪(BRA     GetShort
  1118. ⓪ noctrl  TST.B   (A5)+
  1119. ⓪(BNE     noctrl
  1120. ⓪(MOVE    A5,D1
  1121. ⓪(BTST    #0,D1
  1122. ⓪(BEQ     srch2
  1123. ⓪(ADDQ.L  #1,A5
  1124. ⓪(BRA     srch2
  1125. ⓪ 
  1126. ⓪ GetShort
  1127. ⓪(MOVE.L  ShortKeyPtr,A5
  1128. ⓪(CLR     D0
  1129. ⓪(MOVE.B  (A5)+,D0
  1130. ⓪(ADDQ.L  #1,ShortKeyPtr
  1131. ⓪(TST.B   (A5)
  1132. ⓪(BNE     ende
  1133. ⓪(CLR.L   ShortKeyPtr
  1134. ⓪(BRA     ende
  1135. ⓪ 
  1136. ⓪ cont    LEA     ctrlkeys(PC),A5
  1137. ⓪(LEA     keytabend(PC),A6
  1138. ⓪ srch    CMP.L   2(A5),D0
  1139. ⓪(BNE     noctrl2
  1140. ⓪ 
  1141. ⓪(MOVE    (A5),D0
  1142. ⓪(CMPI    #UpKey,D0
  1143. ⓪(BEQ     up2
  1144. ⓪(CMPI    #DownKey,D0
  1145. ⓪(BEQ     down2
  1146. ⓪(CMPI    #TabRightKey,D0
  1147. ⓪(BNE     ende
  1148. ⓪(TST.B   D2
  1149. ⓪(BEQ     ende
  1150. ⓪(MOVEQ   #TabLeftKey,D0
  1151. ⓪(BRA     ende
  1152. ⓪ up2     BTST    #2,D2           ; ctrl gedrückt?
  1153. ⓪(BEQ     ende
  1154. ⓪(MOVEQ   #ScrlDownKey,D0
  1155. ⓪(BRA     ende
  1156. ⓪ down2   BTST    #2,D2           ; ctrl gedrückt?
  1157. ⓪(BEQ     ende
  1158. ⓪(MOVEQ   #ScrlUpKey,D0
  1159. ⓪(BRA     ende
  1160. ⓪ 
  1161. ⓪ noctrl2 ADDQ.L  #6,A5
  1162. ⓪(CMPA.L  A6,A5
  1163. ⓪(BCS     srch
  1164. ⓪ 
  1165. ⓪(CMPI.L  #' ',D0
  1166. ⓪(BCS     notValid        ; Controlzeichen nicht direkt zugelassen
  1167. ⓪ 
  1168. ⓪ ende    MOVEM.L (A7)+,D1/D2/A5/A6
  1169. ⓪(RTS
  1170. ⓪(
  1171. ⓪ ctrlkeys
  1172. ⓪(DC.W  HelpKey        DC.L $620000L
  1173. ⓪(DC.W  ESCKey         DC.L $610000L  ; Undo
  1174. ⓪(DC.W  ETXkey         DC.L $3B0000L  ; F1
  1175. ⓪(DC.W  SoLnKey        DC.L $4B0034L  ; SHIFT cursor left
  1176. ⓪(DC.W  EoLnKey        DC.L $4D0036L  ; SHIFT cursor right
  1177. ⓪(DC.W  WordLeftKey    DC.L $730000L  ; CTRL cursor left
  1178. ⓪(DC.W  WordRightKey   DC.L $740000L  ; CTRL cursor right
  1179. ⓪(DC.W  SoLnKey        DC.L $430000L  ; F9
  1180. ⓪(DC.W  EoLnKey        DC.L $440000L  ; F10
  1181. ⓪(DC.W  ScrlUpKey      DC.L $410000L  ; F7
  1182. ⓪(DC.W  ScrlDownKey    DC.L $420000L  ; F8
  1183. ⓪(DC.W  ESCKey         DC.L $01001BL
  1184. ⓪(DC.W  ToggleTabKey   DC.L $3C0000L  ; F2
  1185. ⓪(DC.W  ETXKey         DC.L $72000DL  ; ENTER
  1186. ⓪(DC.W  EnterKey       DC.L $1C000DL  ; RETURN
  1187. ⓪(DC.W  DELKey         DC.L $53007FL
  1188. ⓪(DC.W  BSKey          DC.L $0E0008L
  1189. ⓪(DC.W  INSKey         DC.L $520000L
  1190. ⓪(DC.W  LeftKey        DC.L $4B0000L
  1191. ⓪(DC.W  RightKey       DC.L $4D0000L
  1192. ⓪(DC.W  UpKey          DC.L $480000L
  1193. ⓪(DC.W  DownKey        DC.L $500000L
  1194. ⓪(DC.W  PageUpKey      DC.L $480038L  ; SHIFT cursor up
  1195. ⓪(DC.W  PageDownKey    DC.L $500032L  ; SHIFT cursor down
  1196. ⓪(DC.W  TabLeftKey     DC.L $100011L  ; CTRL-Q
  1197. ⓪(DC.W  TabRightKey    DC.L $0F0009L  ; TAB
  1198. ⓪(DC.W  OpenFrameKey   DC.L $3D0000L  ; F3
  1199. ⓪(DC.W  CloseFrameKey  DC.L $3E0000L  ; F4
  1200. ⓪(DC.W  CompileKey     DC.L $3F0000L  ; F5
  1201. ⓪(DC.W  HomeKey        DC.L $470000L  ; Clr/Home
  1202. ⓪(DC.W  FindDefKey     DC.L $400000L  ; F6
  1203. ⓪ 
  1204. ⓪ keytabend
  1205. ⓪ 
  1206. ⓪ shortKeys
  1207. ⓪(DC.L  $300000L  ASC 'BEGIN' DC.B EnterKey ASC '  '
  1208. ⓪8DC.B EnterKey,LeftKey,LeftKey ASC 'END ;'
  1209. ⓪8DC.B EnterKey,ETXKey,LeftKey,LeftKey ACZ 'I' SYNC
  1210. ⓪(DC.L  $170000L  ACZ 'INTEGER' SYNC
  1211. ⓪(DC.L  $190000L  ACZ 'PROCEDURE ' SYNC
  1212. ⓪(DC.L  $180000L  ACZ 'BOOLEAN' SYNC
  1213. ⓪(DC.L  $110000L  ACZ 'WHILE ' SYNC
  1214. ⓪(DC.L  $120000L  DC.B LeftKey,LeftKey ASC 'END;' DC.B EnterKey,0 SYNC
  1215. ⓪(DC.L  $130000L  ASC 'REPEAT' DC.B EnterKey ACZ '  ' SYNC
  1216. ⓪8DC.B EnterKey,LeftKey,LeftKey ASC 'UNTIL ;'
  1217. ⓪8DC.B ETXKey, UpKey ACZ 'I' SYNC
  1218. ⓪(DC.L  $2E0000L  ACZ 'CARDINAL' SYNC
  1219. ⓪(DC.L  $2F0000L  ACZ 'WriteString (' SYNC
  1220. ⓪(DC.L  $310000L  ASC 'WriteLn;' DC.B EnterKey, 0 SYNC
  1221. ⓪(DC.L  $1E0000L  ASC 'ASSEMBLER' DC.B EnterKey,TabRightKey,0 SYNC
  1222. ⓪(DC.L  $1F0000L  ACZ 'String' SYNC
  1223. ⓪(DC.L  $200000L  ASC 'DO' DC.B EnterKey ASC '  '
  1224. ⓪8DC.B EnterKey,LeftKey,LeftKey ASC 'END;'
  1225. ⓪8DC.B ETXKey, UpKey ACZ 'I' SYNC
  1226. ⓪(DC.L  $210000L  ACZ 'FOR ' SYNC
  1227. ⓪(DC.L  $260000L  ACZ 'LONGCARD' SYNC
  1228. ⓪(DC.L  $250000L  ACZ 'LONGINT' SYNC
  1229. ⓪(DC.L  $2C0000L  ACZ 'ADDRESS' SYNC
  1230. ⓪(DC.L  $160000L  ACZ 'UNTIL ' SYNC
  1231. ⓪(DC.L  $140000L  ASC 'THEN' DC.B EnterKey ASC '  '
  1232. ⓪8DC.B EnterKey,LeftKey,LeftKey ASC 'END;'
  1233. ⓪8DC.B ETXKey, UpKey ACZ 'I' SYNC
  1234. ⓪(DC.L  $150000L  ACZ 'FROM SYSTEM IMPORT ' SYNC
  1235. ⓪(DC.L  $220000L  ASC 'FROM InOut IMPORT Write, WriteLn, WriteString, WriteInt, WriteCard;'
  1236. ⓪8DC.B EnterKey, 0 SYNC
  1237. ⓪(DC.L  0
  1238. ⓪ END
  1239. ⓪ END GetKeyD0;
  1240. ⓪ 
  1241. ⓪ PROCEDURE ClrKBDbuffer;
  1242. ⓪"BEGIN
  1243. ⓪$WHILE KeyPressed () DO GetKeyD0; ShortKeyPtr := NIL END
  1244. ⓪"END ClrKBDbuffer;
  1245. ⓪ 
  1246. ⓪ 
  1247. ⓪ (*$l-*)
  1248. ⓪ PROCEDURE ChrIn;                        (* d0=Zeichen von Tastatur *)
  1249. ⓪ BEGIN                                   (* ohne Echo *)
  1250. ⓪ ASSEMBLER
  1251. ⓪(clr     accept
  1252. ⓪(clr     abort
  1253. ⓪ liest   jsr     GetKeyD0
  1254. ⓪(cmpi    #ToggleTabKey,d0
  1255. ⓪(bne     ct10
  1256. ⓪(moveq   #0,d3
  1257. ⓪(move.b  ptrX,d3
  1258. ⓪(move    d3,d1
  1259. ⓪(lsr     #3,d1
  1260. ⓪(lea     tabs,A0
  1261. ⓪(bchg    d3,0(a0,d1.w)
  1262. ⓪(bne     decr
  1263. ⓪(addq    #1,nrOfTabs
  1264. ⓪(bra     tabcmd
  1265. ⓪ decr    subq    #1,nrOfTabs
  1266. ⓪ tabcmd  tst     tabMode
  1267. ⓪(beq     ctende          ;liest
  1268. ⓪(clr     cmdFlag
  1269. ⓪(;bra     liest
  1270. ⓪(bra     ctende
  1271. ⓪ ct10    cmpi    #ESCkey,d0
  1272. ⓪(bne     ct11
  1273. ⓪(move    #1,abort
  1274. ⓪(bra     ctende
  1275. ⓪ ct11    cmpi    #ETXkey,d0
  1276. ⓪(bne     ctende
  1277. ⓪(move    #1,accept
  1278. ⓪(;bra     ctende
  1279. ⓪ ctende
  1280. ⓪ END
  1281. ⓪ END ChrIn;
  1282. ⓪ 
  1283. ⓪ (*$l-*)
  1284. ⓪ PROCEDURE ReadCh;                       (* ch:=Zeichen vom KBD *)
  1285. ⓪ BEGIN
  1286. ⓪ ASSEMBLER
  1287. ⓪(jsr    ChrIn
  1288. ⓪(move.b d0,ch
  1289. ⓪ END
  1290. ⓪ END ReadCh;
  1291. ⓪ 
  1292. ⓪ (*$l-*)
  1293. ⓪ PROCEDURE ErrorWait;
  1294. ⓪ BEGIN
  1295. ⓪"ClrKBDbuffer;
  1296. ⓪"GetKeyD0
  1297. ⓪ END ErrorWait;
  1298. ⓪ 
  1299. ⓪ (*$l-*)
  1300. ⓪ PROCEDURE SuccessFull(id: CARDINAL):BOOLEAN;
  1301. ⓪ BEGIN
  1302. ⓪ ASSEMBLER
  1303. ⓪(tst     IOResult
  1304. ⓪(bpl     NoErr
  1305. ⓪(movem.l d0-d6/a0/A1/A2,-(a7)
  1306. ⓪(move    IOResult,-(a7)
  1307. ⓪(moveq   #CRchar,d0
  1308. ⓪(jsr     ChrOut
  1309. ⓪(moveq   #ClrEOLNchar,d0
  1310. ⓪(jsr     ChrOut
  1311. ⓪(moveq   #0,d0
  1312. ⓪(move    -(a3),d0
  1313. ⓪ (*
  1314. ⓪(move.l  d0,(a3)+
  1315. ⓪(lea     ErrorType,a0
  1316. ⓪(move.b  0(a0,d0.w),d0
  1317. ⓪(jsr     ChrOut
  1318. ⓪(jsr     WriteLCard
  1319. ⓪(moveq   #':',d0
  1320. ⓪(jsr     ChrOut
  1321. ⓪ *)
  1322. ⓪(move    (a7),(a3)+
  1323. ⓪(jsr     PrintError
  1324. ⓪(jsr     Bell
  1325. ⓪(jsr     ErrorWait
  1326. ⓪(move    (a7)+,IOResult
  1327. ⓪(movem.l (a7)+,d0-d6/a0/A1/A2
  1328. ⓪(clr     (a3)+
  1329. ⓪(rts
  1330. ⓪ NoErr   move    #1,-2(a3)
  1331. ⓪ END
  1332. ⓪ END SuccessFull;
  1333. ⓪ 
  1334. ⓪ (*$l-*)
  1335. ⓪ PROCEDURE Flip(VAR s1,s2:STRING);
  1336. ⓪ BEGIN                                   (* vertauscht s1 mit s2 *)
  1337. ⓪ ASSEMBLER
  1338. ⓪(move.l -(a3),a0
  1339. ⓪(move.l -(a3),A1
  1340. ⓪(moveq  #40,d1
  1341. ⓪ Flipx   move   (a0),d0
  1342. ⓪(move   (A1),(a0)+
  1343. ⓪(move   d0,(A1)+
  1344. ⓪(dbf    d1,Flipx
  1345. ⓪ END
  1346. ⓪ END Flip;
  1347. ⓪ 
  1348. ⓪ (*$l+*)
  1349. ⓪ PROCEDURE ReadString(VAR str: string);  (* mit Umcodierung *)
  1350. ⓪"VAR line:STRING;                      (* bei ESC bleibt str erhalten *)
  1351. ⓪ BEGIN
  1352. ⓪ ASSEMBLER
  1353. ⓪*moveq  #0,d1
  1354. ⓪ readstrw  jsr    ChrIn
  1355. ⓪*tst    abort
  1356. ⓪*bne    readabrt
  1357. ⓪*cmpi.b #' ',d0
  1358. ⓪*bcs    readctrl
  1359. ⓪ readnorm  move.b ptrX,d2
  1360. ⓪*cmp.b  maxColM1,d2
  1361. ⓪*bhi    readerr
  1362. ⓪*move.b d0,line(A6,d1.w)
  1363. ⓪*addq   #1,d1
  1364. ⓪*jsr    ChrOut
  1365. ⓪*bra    readstrw
  1366. ⓪ readctrl  cmpi   #EnterKey,d0
  1367. ⓪*beq    readcr
  1368. ⓪*cmpi   #leftKey,d0
  1369. ⓪*beq    readleft
  1370. ⓪*cmpi   #bsKey,d0
  1371. ⓪*beq    readleft
  1372. ⓪*cmpi   #delKey,d0
  1373. ⓪*beq    readleft
  1374. ⓪ readerr   bra    readstrw
  1375. ⓪ readleft  tst    d1
  1376. ⓪*ble    readerr
  1377. ⓪*subq   #1,d1
  1378. ⓪*moveq  #BSChar,d0
  1379. ⓪*jsr    ChrOut
  1380. ⓪*bra    readstrw
  1381. ⓪ readcr    clr.b  line(A6,d1.w) END; Flip(str,line); ASSEMBLER
  1382. ⓪ !readabrt jsr    WriteLn
  1383. ⓪ END
  1384. ⓪ END ReadString;
  1385. ⓪ 
  1386. ⓪ 
  1387. ⓪ (*$l-*)
  1388. ⓪ PROCEDURE Worthy: BOOLEAN;
  1389. ⓪ BEGIN
  1390. ⓪ ASSEMBLER
  1391. ⓪(moveq   #1,d1
  1392. ⓪(move.l  ptrEnd,d0
  1393. ⓪(sub.l   ptrStart,d0
  1394. ⓪(cmpi.l  #4,d0
  1395. ⓪(bhi     itisw
  1396. ⓪(moveq   #0,d1
  1397. ⓪ itisw   move    d1,(a3)+
  1398. ⓪ END
  1399. ⓪ END Worthy;
  1400. ⓪ 
  1401. ⓪ PROCEDURE NormTab;
  1402. ⓪"BEGIN
  1403. ⓪$ASSEMBLER
  1404. ⓪(DC.B $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F
  1405. ⓪(DC.B $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F
  1406. ⓪(DC.B $20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2A,$2B,$2C,$2D,$2E,$2F
  1407. ⓪(DC.B $30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3A,$3B,$3C,$3D,$3E,$3F
  1408. ⓪(DC.B $40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4A,$4B,$4C,$4D,$4E,$4F
  1409. ⓪(DC.B $50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5A,$5B,$5C,$5D,$5E,$5F
  1410. ⓪(DC.B $60,$61,$62,$63,$64,$65,$66,$67,$68,$69,$6A,$6B,$6C,$6D,$6E,$6F
  1411. ⓪(DC.B $70,$71,$72,$73,$74,$75,$76,$77,$78,$79,$7A,$7B,$7C,$7D,$7E,$7F
  1412. ⓪(DC.B $80,$81,$82,$83,$84,$85,$86,$87,$88,$89,$8A,$8B,$8C,$8D,$8E,$8F
  1413. ⓪(DC.B $90,$91,$92,$93,$94,$95,$96,$97,$98,$99,$9A,$9B,$9C,$9D,$9E,$9F
  1414. ⓪(DC.B $A0,$A1,$A2,$A3,$A4,$A5,$A6,$A7,$A8,$A9,$AA,$AB,$AC,$AD,$AE,$AF
  1415. ⓪(DC.B $B0,$B1,$B2,$B3,$B4,$B5,$B6,$B7,$B8,$B9,$BA,$BB,$BC,$BD,$BE,$BF
  1416. ⓪(DC.B $C0,$C1,$C2,$C3,$C4,$C5,$C6,$C7,$C8,$C9,$CA,$CB,$CC,$CD,$CE,$CF
  1417. ⓪(DC.B $D0,$D1,$D2,$D3,$D4,$D5,$D6,$D7,$D8,$D9,$DA,$DB,$DC,$DD,$DE,$DF
  1418. ⓪(DC.B $E0,$E1,$E2,$E3,$E4,$E5,$E6,$E7,$E8,$E9,$EA,$EB,$EC,$ED,$EE,$EF
  1419. ⓪(DC.B $F0,$F1,$F2,$F3,$F4,$F5,$F6,$F7,$F8,$F9,$FA,$FB,$FC,$FD,$FE,$FF
  1420. ⓪$END
  1421. ⓪"END NormTab;
  1422. ⓪ 
  1423. ⓪ PROCEDURE AlphaNumTab;
  1424. ⓪"BEGIN
  1425. ⓪$ASSEMBLER
  1426. ⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  1427. ⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  1428. ⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  1429. ⓪(DC.B 0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1
  1430. ⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1431. ⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0
  1432. ⓪(DC.B 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1433. ⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1
  1434. ⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1435. ⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  1436. ⓪(DC.B 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1
  1437. ⓪(DC.B 0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1
  1438. ⓪(DC.B 0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  1439. ⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  1440. ⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  1441. ⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  1442. ⓪$END
  1443. ⓪"END AlphaNumTab;
  1444. ⓪ 
  1445. ⓪ PROCEDURE ShiftTab;
  1446. ⓪"BEGIN
  1447. ⓪$ASSEMBLER
  1448. ⓪(DC.B $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F
  1449. ⓪(DC.B $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F
  1450. ⓪(DC.B ' ','!','"','#','$','%','&',$27,'(',')','*','+',',','-','.','/'
  1451. ⓪(DC.B '0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?'
  1452. ⓪(DC.B '@','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O'
  1453. ⓪(DC.B 'P','Q','R','S','T','U','V','W','X','Y','Z','[','\',']','^','_'
  1454. ⓪(DC.B '`','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O'
  1455. ⓪(DC.B 'P','Q','R','S','T','U','V','W','X','Y','Z','{','|','}','~',''
  1456. ⓪(DC.B 'Ç','Ü','É','A','Ä','À','Å','Ç','E','E','E','I','I','I','Ä','Å'
  1457. ⓪(DC.B 'É','Æ','Æ','O','Ö','O','U','U','ÿ','Ö','Ü','¢','£','¥','ß','ƒ'
  1458. ⓪(DC.B 'A','I','O','U','Ñ','Ñ','ª','º','¿','⌐','¬','½','¼','¡','«','»'
  1459. ⓪(DC.B 'Ã','Õ','Ø','Ø','Œ','Œ','À','Ã','Õ','¨','´','†','¶','©','®','™'
  1460. ⓪(DC.B 'IJ','IJ','א','ב','ג','ד','ה','ו','ז','ח','ט','י','כ','ל','מ','נ'
  1461. ⓪(DC.B 'ס','ע','פ','צ','ק','ר','ש','ת','ן','ך','ם','ף','ץ','§','∧','∞'
  1462. ⓪(DC.B 'α','β','Γ','π','Σ','σ','µ','τ','Φ','Θ','Ω','δ','∮','ϕ','∈','∩'
  1463. ⓪(DC.B '≡','±','≥','≤','⌠','⌡','÷','≈','°','∙','·','√','ⁿ','²','³','¯'
  1464. ⓪(;und gleich darauf noch die Lower-Table
  1465. ⓪(DC.B $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F
  1466. ⓪(DC.B $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F
  1467. ⓪(DC.B ' ','!','"','#','$','%','&',$27,'(',')','*','+',',','-','.','/'
  1468. ⓪(DC.B '0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?'
  1469. ⓪(DC.B '@','a','b','c','d','e','f','g','h','i','j','k','l','m','n','o'
  1470. ⓪(DC.B 'p','q','r','s','t','u','v','w','x','y','z','[','\',']','^','_'
  1471. ⓪(DC.B '`','a','b','c','d','e','f','g','h','i','j','k','l','m','n','o'
  1472. ⓪(DC.B 'p','q','r','s','t','u','v','w','x','y','z','{','|','}','~',''
  1473. ⓪(DC.B 'ç','ü','é','â','ä','à','å','ç','ê','ë','è','ï','î','ì','ä','å'
  1474. ⓪(DC.B 'é','æ','æ','ô','ö','ò','û','ù','ÿ','Ö','ü','¢','£','¥','ß','ƒ'
  1475. ⓪(DC.B 'á','í','ó','ú','ñ','ñ','ª','º','¿','⌐','¬','½','¼','¡','«','»'
  1476. ⓪(DC.B 'ã','õ','ø','ø','œ','œ','à','ã','õ','¨','´','†','¶','©','®','™'
  1477. ⓪(DC.B 'ij','ij','א','ב','ג','ד','ה','ו','ז','ח','ט','י','כ','ל','מ','נ'
  1478. ⓪(DC.B 'ס','ע','פ','צ','ק','ר','ש','ת','ן','ך','ם','ף','ץ','§','∧','∞'
  1479. ⓪(DC.B 'α','β','Γ','π','Σ','σ','µ','τ','Φ','Θ','Ω','δ','∮','ϕ','∈','∩'
  1480. ⓪(DC.B '≡','±','≥','≤','⌠','⌡','÷','≈','°','∙','·','√','ⁿ','²','³','¯'
  1481. ⓪$END
  1482. ⓪"END ShiftTab;
  1483. ⓪ 
  1484. ⓪ (*$l-*)
  1485. ⓪ PROCEDURE ShiftUp;                      (* kleine Buchstaben => große *)
  1486. ⓪ BEGIN
  1487. ⓪ ASSEMBLER ;operiert auf d0
  1488. ⓪(cmpi.b #'a',d0
  1489. ⓪(bcs    shftrts
  1490. ⓪(cmpi.b #'z',d0
  1491. ⓪(bls    shiftit
  1492. ⓪(cmpi.b #132,d0
  1493. ⓪(beq    ae
  1494. ⓪(cmpi.b #148,d0
  1495. ⓪(beq    oe
  1496. ⓪(cmpi.b #129,d0
  1497. ⓪(bne    shftrts
  1498. ⓪(moveq  #154,d0
  1499. ⓪(rts
  1500. ⓪ ae      moveq  #142,d0
  1501. ⓪(rts
  1502. ⓪ oe      moveq  #153,d0
  1503. ⓪(rts
  1504. ⓪ shiftit eori.b #$20,d0
  1505. ⓪ shftrts
  1506. ⓪ END
  1507. ⓪ END ShiftUp;
  1508. ⓪ 
  1509. ⓪ (*$l-*)
  1510. ⓪ PROCEDURE AlphaNum;             (* Test, ob d0 ein alphanum. Zeichen enth. *)
  1511. ⓪ BEGIN                           (* Ergebnis im Z-Flag:1=alphanum *)
  1512. ⓪ ASSEMBLER
  1513. ⓪)ANDI #255,D0
  1514. ⓪)MOVE.L A0,-(A7)
  1515. ⓪)LEA    AlphaNumTab,A0
  1516. ⓪)TST.B  0(A0,D0.W)
  1517. ⓪)MOVE.L (A7)+,A0
  1518. ⓪ END
  1519. ⓪ END AlphaNum;
  1520. ⓪ 
  1521. ⓪ (*$l-*)
  1522. ⓪ PROCEDURE ClearTabs;
  1523. ⓪"BEGIN
  1524. ⓪$ASSEMBLER
  1525. ⓪(lea     tabs,a0
  1526. ⓪(moveq   #0,d0
  1527. ⓪(move.b  maxCol,d0
  1528. ⓪(addq    #1,d0
  1529. ⓪(asr     #3,d0
  1530. ⓪(subq    #1,d0
  1531. ⓪ cllp    clr.b   (a0)+           ;tabs löschen
  1532. ⓪(dbf     d0,cllp
  1533. ⓪$END
  1534. ⓪"END ClearTabs;
  1535. ⓪ 
  1536. ⓪ (*$l+*)
  1537. ⓪ PROCEDURE StandardTabs (n: CARDINAL);
  1538. ⓪"TYPE ByteSet = SET OF [0..7];
  1539. ⓪"VAR p: POINTER TO ARRAY [0..80] OF ByteSet; i: CARDINAL;
  1540. ⓪"BEGIN  (* alle n Zeichen ein Tab *)
  1541. ⓪$ClearTabs;
  1542. ⓪$i:= 0;
  1543. ⓪$p:= ADR (tabs);
  1544. ⓪$nrOfTabs:= 0;
  1545. ⓪$WHILE i < cols DO
  1546. ⓪&INCL (p^[i DIV 8], i MOD 8);
  1547. ⓪&INC (nrOfTabs);
  1548. ⓪&INC (i, n)
  1549. ⓪$END;
  1550. ⓪"(*
  1551. ⓪'ASSEMBLER ;benutzt d0,a0
  1552. ⓪/moveq   #0,d0
  1553. ⓪/move.b  maxCol,d0
  1554. ⓪/addq    #1,d0
  1555. ⓪/asr     #3,d0
  1556. ⓪/move    d0,nrOfTabs
  1557. ⓪/lea     tabs,a0
  1558. ⓪/subq    #1,d0
  1559. ⓪'tblp    move.b  #$01,(a0)+
  1560. ⓪/dbf     d0,tblp
  1561. ⓪'END
  1562. ⓪"*)
  1563. ⓪"END StandardTabs;
  1564. ⓪ 
  1565. ⓪ (*$l-*)
  1566. ⓪ PROCEDURE CountTabs;
  1567. ⓪ BEGIN
  1568. ⓪ ASSEMBLER ;benutzt d0,a0
  1569. ⓪(moveq   #0,d2
  1570. ⓪(move.b  maxCol,d2
  1571. ⓪(move    d2,d1
  1572. ⓪(addq    #1,d2
  1573. ⓪(asr     #3,d2
  1574. ⓪(lea     tabs,a0
  1575. ⓪(subq    #1,d2
  1576. ⓪ tblp    move.b  (a0)+,d0
  1577. ⓪(moveq   #7,d3
  1578. ⓪ tbcnt   btst    #0,d0
  1579. ⓪(beq     notset
  1580. ⓪(addq    #1,d1
  1581. ⓪ notset  lsr     #1,d0
  1582. ⓪(dbf     d3,tbcnt
  1583. ⓪(dbf     d2,tblp
  1584. ⓪(move    d1,nrOfTabs
  1585. ⓪ END
  1586. ⓪ END CountTabs;
  1587. ⓪ 
  1588. ⓪ (*$l+*)
  1589. ⓪ PROCEDURE GetTabs(tabString:String);
  1590. ⓪"VAR step, i, n: CARDINAL;
  1591. ⓪"BEGIN  (* tabString umwandeln, 'T'=Tabulator, '.'=keiner *)
  1592. ⓪$i:= 0;
  1593. ⓪$n:= StrToCard (tabString, i, strok);
  1594. ⓪$IF (n > 0) AND (n<80) THEN
  1595. ⓪&StandardTabs (n)
  1596. ⓪$ELSE
  1597. ⓪&ASSEMBLER
  1598. ⓪(JSR     ClearTabs
  1599. ⓪(lea     tabString(A6),A0
  1600. ⓪(moveq   #0,d0
  1601. ⓪(moveq   #0,d1           ;d1=nrOfTabs
  1602. ⓪(lea     tabs,A1
  1603. ⓪(moveq   #0,d3           ;d3=Bit-Index
  1604. ⓪(tst.b   (a0)
  1605. ⓪(bne     gtloop
  1606. ⓪(move    #8,(A3)+
  1607. ⓪(jsr     StandardTabs
  1608. ⓪(bra     getex
  1609. ⓪ gtloop  move.b  (a0)+,d0
  1610. ⓪(beq     gete2
  1611. ⓪(jsr     ShiftUp
  1612. ⓪(move    d3,d4
  1613. ⓪(lsr     #3,d4
  1614. ⓪(bclr    d3,0(A1,d4.w)
  1615. ⓪(cmpi.b  #'T',d0
  1616. ⓪(bne     gtstor
  1617. ⓪(bset    d3,0(A1,d4.w)
  1618. ⓪(addq    #1,d1
  1619. ⓪ gtstor  addq    #1,d3
  1620. ⓪(bra     gtloop
  1621. ⓪ gete2   move    d1,nrOfTabs
  1622. ⓪ getex
  1623. ⓪&END
  1624. ⓪$END
  1625. ⓪"END GetTabs;
  1626. ⓪ 
  1627. ⓪ (*$l-*)
  1628. ⓪ PROCEDURE TabSet: BOOLEAN;              (* true, wenn an aktueller  *)
  1629. ⓪ BEGIN                                   (* Cursorposition ein Tab steht *)
  1630. ⓪ ASSEMBLER ;benutzt d0,d1,d2,A2
  1631. ⓪(tst     nrOfTabs
  1632. ⓪(beq     tabf
  1633. ⓪(moveq   #0,d1
  1634. ⓪(move.b  ptrX,d1
  1635. ⓪(cmp.b   maxColM1,d1
  1636. ⓪(bgt     tabf
  1637. ⓪(move    forceTab,d0
  1638. ⓪(lea     tabs,A2
  1639. ⓪(move    d1,d2
  1640. ⓪(lsr     #3,d2
  1641. ⓪(btst    d1,0(A2,d2.w)
  1642. ⓪(beq     notab
  1643. ⓪ tabf    moveq   #1,d0
  1644. ⓪ notab   move    d0,(a3)+
  1645. ⓪ END
  1646. ⓪ END TabSet;
  1647. ⓪ 
  1648. ⓪ (*$l-*)
  1649. ⓪ PROCEDURE TabsToStr():String;
  1650. ⓪ BEGIN
  1651. ⓪ ASSEMBLER
  1652. ⓪(lea     tabs,a0
  1653. ⓪(move.l  a3,A1
  1654. ⓪(lea     82(A3),A3
  1655. ⓪(moveq   #0,d0
  1656. ⓪(move.b  maxCol,d0
  1657. ⓪(addq    #1,d0
  1658. ⓪(asr     #3,d0
  1659. ⓪(subq    #1,d0
  1660. ⓪ lp1     moveq   #7,d1
  1661. ⓪(move.b  (a0)+,d2
  1662. ⓪ lp2     moveq   #'.',d3
  1663. ⓪(lsr.b   #1,d2
  1664. ⓪(bcc     push
  1665. ⓪(moveq   #'T',d3
  1666. ⓪ push    move.b  d3,(A1)+
  1667. ⓪(dbf     d1,lp2
  1668. ⓪(dbf     d0,lp1
  1669. ⓪(clr.b   (A1)+
  1670. ⓪ END
  1671. ⓪ END TabsToStr;
  1672. ⓪ 
  1673. ⓪ (*$l-*)
  1674. ⓪ PROCEDURE Yes: BOOLEAN;                 (* true, falls y,Y,j,J eingegeben *)
  1675. ⓪ BEGIN
  1676. ⓪ ASSEMBLER
  1677. ⓪(jsr   ErrorWait
  1678. ⓪(jsr   ShiftUp
  1679. ⓪(moveq #1,d1
  1680. ⓪(cmpi  #'J',d0
  1681. ⓪(beq   jaret
  1682. ⓪(cmpi  #'Y',d0
  1683. ⓪(beq   jaret
  1684. ⓪(moveq #0,d1
  1685. ⓪ jaret   move  d1,(a3)+
  1686. ⓪ END
  1687. ⓪ END Yes;
  1688. ⓪ 
  1689. ⓪ (*$l-*)
  1690. ⓪ PROCEDURE DirKey: BOOLEAN;              (* wertet Tasten zur Richtungs- *)
  1691. ⓪ BEGIN                                   (* umschaltung aus *)
  1692. ⓪ ASSEMBLER ;benutzt d0,d1,d2
  1693. ⓪(moveq  #0,d0
  1694. ⓪(move.b ch,d0
  1695. ⓪(move   direction,d1
  1696. ⓪(moveq  #0,d2
  1697. ⓪(cmpi.b #'<',d0
  1698. ⓪(beq    dleft
  1699. ⓪(cmpi.b #',',d0
  1700. ⓪(beq    dleft
  1701. ⓪(cmpi.b #'-',d0          ; '<' ',' '-' fⁿr links
  1702. ⓪(beq    dleft
  1703. ⓪(cmpi.b #'>',d0
  1704. ⓪(beq    dright
  1705. ⓪(cmpi.b #'.',d0
  1706. ⓪(beq    dright
  1707. ⓪(cmpi.b #'+',d0          ; '>' '.' '+' fⁿr rechts
  1708. ⓪(bne    dexit
  1709. ⓪ dright  tst    d1
  1710. ⓪(beq    dexit
  1711. ⓪(clr    d1
  1712. ⓪(bra    dstore
  1713. ⓪ dleft   tst    d1
  1714. ⓪(bne    dexit
  1715. ⓪(moveq  #1,d1
  1716. ⓪ dstore  move   d1,direction
  1717. ⓪(clr    cmdFlag
  1718. ⓪(moveq  #1,d2
  1719. ⓪ dexit   move   d2,(a3)+
  1720. ⓪ END
  1721. ⓪ END DirKey;
  1722. ⓪ 
  1723. ⓪ (*$l-*)
  1724. ⓪ PROCEDURE ReadUpCh;             (* liest einen Gro∞buchstaben vom KBD *)
  1725. ⓪ BEGIN
  1726. ⓪"ASSEMBLER jsr ChrIn jsr ShiftUp move.b d0,ch END
  1727. ⓪ END ReadUpCh;
  1728. ⓪ 
  1729. ⓪ (*$l-*)
  1730. ⓪ PROCEDURE Rptfx10:BOOLEAN;      (* berechnet Repeatfactor (rptf) *)
  1731. ⓪ BEGIN                           (* d2 enthΣlt 1, wenn Zahl gefunden *)
  1732. ⓪ ASSEMBLER ;benutzt d0,d1,d2,d3
  1733. ⓪(moveq  #0,d2
  1734. ⓪(moveq  #0,d3
  1735. ⓪(move.b ch,d3
  1736. ⓪(subi.b #'0',d3  ;Low-Bound abziehen
  1737. ⓪(bcs    rptfex
  1738. ⓪(cmpi.b #9,d3    ;>9?
  1739. ⓪(bhi    rptfex
  1740. ⓪(move.l rptf,d0  ;alten Repeatfactor mal 10 nehmen
  1741. ⓪(move.l d0,d1
  1742. ⓪(asl.l  #2,d1
  1743. ⓪(add.l  d1,d0
  1744. ⓪(asl.l  #1,d0
  1745. ⓪(add.l  d3,d0    ;neue Ziffer addieren
  1746. ⓪(move.l d0,rptf
  1747. ⓪(moveq  #1,d2    ;d2=1 => es wurde eine Zahl gefunden
  1748. ⓪ rptfex  move   d2,(a3)+
  1749. ⓪ END
  1750. ⓪ END Rptfx10;
  1751. ⓪ 
  1752. ⓪ (*$l-*)
  1753. ⓪ PROCEDURE RptfOK;               (* gültiger Repeatfactor ? *)
  1754. ⓪ BEGIN
  1755. ⓪ ASSEMBLER ;benutzt d0
  1756. ⓪(move.l rptf,d0
  1757. ⓪(bne    ok
  1758. ⓪(moveq  #1,d0    ;Default=1
  1759. ⓪ ok      move.l d0,rptf
  1760. ⓪ END
  1761. ⓪ END RptfOK;
  1762. ⓪ 
  1763. ⓪ (*$l-*)
  1764. ⓪ PROCEDURE Negate(VAR bool:BOOLEAN);
  1765. ⓪ BEGIN                           (* bool:=NOT bool *)
  1766. ⓪ ASSEMBLER move.l -(a3),a0 EORI #1,(a0) END
  1767. ⓪ END Negate;
  1768. ⓪ 
  1769. ⓪ (*$l-*)
  1770. ⓪ PROCEDURE Prepare;
  1771. ⓪ BEGIN
  1772. ⓪ ASSEMBLER
  1773. ⓪&(*
  1774. ⓪(pea     printLine
  1775. ⓪(;### move.l  (a7),(a3)+
  1776. ⓪(;### jsr     GetTime
  1777. ⓪(move.l  (a7)+,a0
  1778. ⓪(moveq   #0,d0
  1779. ⓪(move    (a0)+,d0
  1780. ⓪(mulu    #60,d0
  1781. ⓪(add     (a0)+,d0
  1782. ⓪(mulu    #15,d0
  1783. ⓪(asl.l   #2,d0
  1784. ⓪(moveq   #0,d1
  1785. ⓪(move    (a0)+,d1
  1786. ⓪(add.l   d1,d0
  1787. ⓪&*) nop
  1788. ⓪ END
  1789. ⓪ END Prepare;
  1790. ⓪ 
  1791. ⓪ (*$l-*)
  1792. ⓪ PROCEDURE Finish;
  1793. ⓪ BEGIN
  1794. ⓪ ASSEMBLER
  1795. ⓪&(*
  1796. ⓪(jsr     Prepare
  1797. ⓪(move.l  d0,d1
  1798. ⓪(sub.l   startupTime,d0
  1799. ⓪(bpl     ok
  1800. ⓪(add.l   #$15180,d0
  1801. ⓪ ok      move.l  d1,startupTime
  1802. ⓪(add.l   d0,total
  1803. ⓪(add.l   d0,keepTime
  1804. ⓪&*) nop
  1805. ⓪ END
  1806. ⓪ END Finish;
  1807. ⓪ 
  1808. ⓪ (*$l-*)
  1809. ⓪ PROCEDURE ResetTextOptions;
  1810. ⓪"BEGIN
  1811. ⓪$ASSEMBLER
  1812. ⓪(clr     cmdFlag
  1813. ⓪(moveq   #16-1+43-1,d0
  1814. ⓪(lea     ptrStack,a0
  1815. ⓪%lp clr.l   (a0)+  ;löscht auch tags
  1816. ⓪(dbf     d0,lp
  1817. ⓪(move.l  ptr,lastptr
  1818. ⓪(clr     ptrCount
  1819. ⓪(clr     fileD
  1820. ⓪(clr     fileT
  1821. ⓪(clr     restoreFileDT
  1822. ⓪(clr     direction
  1823. ⓪(clr     findSame
  1824. ⓪(clr     findWord
  1825. ⓪(clr     findCase
  1826. ⓪(clr     infinite
  1827. ⓪(clr     verify
  1828. ⓪(clr.l   rptf
  1829. ⓪(move    #1,saved
  1830. ⓪(clr     autoBack
  1831. ⓪(clr     autoIncVer
  1832. ⓪(move    #1,makeDLE
  1833. ⓪(clr     leaveDLEonWrite
  1834. ⓪(clr     saveinfo
  1835. ⓪(move    #8,(A3)+
  1836. ⓪(jsr     StandardTabs
  1837. ⓪$END
  1838. ⓪"END ResetTextOptions;
  1839. ⓪ 
  1840. ⓪ (*$l-*)
  1841. ⓪ PROCEDURE GoToPtr;              (* positioniert Cursor auf gespeicherte yx *)
  1842. ⓪ BEGIN
  1843. ⓪ ASSEMBLER
  1844. ⓪(move yx,d1
  1845. ⓪(jmp  GotoXYd1
  1846. ⓪ END
  1847. ⓪ END GoToPtr;
  1848. ⓪ 
  1849. ⓪ (*$l-*)
  1850. ⓪ PROCEDURE Home;         (* Cursor nach links oben, Statuszeile l÷schen *)
  1851. ⓪ BEGIN
  1852. ⓪ ASSEMBLER
  1853. ⓪(clr   d1
  1854. ⓪(jsr   GotoXYd1
  1855. ⓪(moveq #ClrEOLNchar,d0
  1856. ⓪(jmp   ChrOut
  1857. ⓪ END
  1858. ⓪ END Home;
  1859. ⓪ 
  1860. ⓪ (*$l-*)
  1861. ⓪ PROCEDURE ClrCmdLine;   (* Cursorposition retten, dann Home *)
  1862. ⓪ BEGIN
  1863. ⓪ ASSEMBLER
  1864. ⓪(clr    cmdFlag
  1865. ⓪(move   ptrY,d0
  1866. ⓪(move.b ptrX,d0
  1867. ⓪(move   d0,yx
  1868. ⓪(jmp    Home
  1869. ⓪ END
  1870. ⓪ END ClrCmdLine;
  1871. ⓪ 
  1872. ⓪ (*$l-*)
  1873. ⓪ PROCEDURE LineOut;      (* eine Zeile aus Speicher auf Bildschirm bringen *)
  1874. ⓪ BEGIN                   (* dabei auf Cursorposition achten *)
  1875. ⓪"ASSEMBLER   ;benutzt d0,d2,d3,d4,d5,d6,a0,A1,A2
  1876. ⓪,moveq   #0,d3        ;ZΣhler fⁿr PrintLine / highword=x-pos
  1877. ⓪,lea     printLine,A2
  1878. ⓪,moveq   #0,d5
  1879. ⓪,tst     insflag
  1880. ⓪,beq.l   LineOut1
  1881. ⓪,move.b  ptrX,d5
  1882. ⓪,bra.l   LineOut1
  1883. ⓪"
  1884. ⓪"lget      tst     insFlag
  1885. ⓪,bne     lgetnz       ;bei Insert den Cursor nicht verΣndern
  1886. ⓪,cmpa.l  ptr,a0
  1887. ⓪,bne     lgetnz
  1888. ⓪,move    ptrY,d0
  1889. ⓪,move.b  d5,d0
  1890. ⓪,move    d0,yx
  1891. ⓪"lgetnz    moveq   #0,d0
  1892. ⓪,move.b  (a0)+,d0
  1893. ⓪,bne     lendrts
  1894. ⓪,tst.b   (a0)
  1895. ⓪,beq     lendkorr
  1896. ⓪,subq.l  #1,a0
  1897. ⓪,
  1898. ⓪"lendkorr  move.b  d3,ptrX
  1899. ⓪ 
  1900. ⓪,; move.b  #ClrEOLNchar,0(A2,d3.w)
  1901. ⓪,; addq.b  #1,d3
  1902. ⓪,movem.l d1/a0,-(a7)
  1903. ⓪,jsr     BufferDisp    ;Ausgabe von PrintLine
  1904. ⓪,jsr     ClearEndOfLine
  1905. ⓪,movem.l (a7)+,d1/a0
  1906. ⓪,addq.l  #4,a7       ;verlasse LineOut
  1907. ⓪"
  1908. ⓪"lendrts   rts
  1909. ⓪"
  1910. ⓪"lput      cmpi.b #CRchar,d0
  1911. ⓪,beq    lendkorr
  1912. ⓪,tst    delFlag
  1913. ⓪,beq    lput1
  1914. ⓪,cmpa.l delPtr,a0
  1915. ⓪,bhi    lput1
  1916. ⓪,cmpa.l ptr,a0
  1917. ⓪,bls    lput1
  1918. ⓪,moveq  #' ',d0
  1919. ⓪"lput1     cmp.b  maxCol,d5
  1920. ⓪,bgt    lputbad
  1921. ⓪,move.b d0,0(A2,d3.w)
  1922. ⓪,addq.b #1,d3
  1923. ⓪,cmpi.b #$20,d0
  1924. ⓪,bcs    lputrts
  1925. ⓪"lputinc   addq.b #1,d5
  1926. ⓪"lputrts   rts
  1927. ⓪"lputbad   move.b #'!',-1(A2,d3.w)
  1928. ⓪,rts
  1929. ⓪"
  1930. ⓪"ldlecode  bsr    lget
  1931. ⓪,move.b d0,d4
  1932. ⓪,moveq  #' ',d0
  1933. ⓪,sub.b  d0,d4
  1934. ⓪,ble    LineOut1
  1935. ⓪"lspc      bsr    lput
  1936. ⓪,subq.b #1,d4
  1937. ⓪,bne    lspc
  1938. ⓪,
  1939. ⓪"LineOut1  bsr     lget
  1940. ⓪,cmpi.b  #DLEchar,d0
  1941. ⓪,beq     ldlecode
  1942. ⓪,bsr     lput
  1943. ⓪,bra     LineOut1
  1944. ⓪"END
  1945. ⓪ END LineOut;
  1946. ⓪ 
  1947. ⓪ (*$l-*)
  1948. ⓪ PROCEDURE LineSt;       (* positioniert a0 auf Zeilenanfang im Speicher *)
  1949. ⓪ BEGIN
  1950. ⓪ ASSEMBLER   ;benutzt d3,a0
  1951. ⓪ linecr1   move.b -(a0),d3
  1952. ⓪*beq    lineret1
  1953. ⓪*cmpi.b #CRchar,d3
  1954. ⓪*bne    linecr1
  1955. ⓪ lineret1  addq.l #1,a0
  1956. ⓪ END
  1957. ⓪ END LineSt;
  1958. ⓪ 
  1959. ⓪ (*$l-*)
  1960. ⓪ PROCEDURE LastCR;       (* positioniert a0 auf vorhergehendes CR *)
  1961. ⓪((* liefert NE, wenn End of text *)
  1962. ⓪ BEGIN
  1963. ⓪ ASSEMBLER
  1964. ⓪ LastCR1   tst.b  -1(a0)
  1965. ⓪*beq    lastret1
  1966. ⓪*cmpi.b #CRchar,-(a0)
  1967. ⓪*bne    LastCR1
  1968. ⓪*rts
  1969. ⓪ lastret1  cmpi.b #1,-1(a0)       ; ergibt immer NE
  1970. ⓪ END
  1971. ⓪ END LastCR;
  1972. ⓪ 
  1973. ⓪ (*$l-*)
  1974. ⓪ PROCEDURE NextCR;       (* positioniert a0 auf nächstes CR+1 *)
  1975. ⓪((* liefert NE, wenn End of text *)
  1976. ⓪ BEGIN
  1977. ⓪ ASSEMBLER
  1978. ⓪ luup       cmpa.l ptrEnd,A0
  1979. ⓪+bcc    error2
  1980. ⓪+tst.b  (a0)
  1981. ⓪+beq    error2
  1982. ⓪+cmpi.b #CRchar,(a0)+
  1983. ⓪+bne    luup
  1984. ⓪+rts
  1985. ⓪ error2     move.l ptrEnd,a0
  1986. ⓪+subq.l #2,a0
  1987. ⓪ error      cmpa.l a7,a0     ; liefert NE
  1988. ⓪ END
  1989. ⓪ END NextCR;
  1990. ⓪ 
  1991. ⓪ 
  1992. ⓪ VAR lineNo: LONGCARD;
  1993. ⓪ 
  1994. ⓪ (*$l-*)
  1995. ⓪ PROCEDURE CountCR: LONGCARD;    (* zählt Zeilen=CR's *)
  1996. ⓪ BEGIN
  1997. ⓪ ASSEMBLER ;benutzt d0,d1,d2,a0
  1998. ⓪(clr.l  lineNo
  1999. ⓪(move.l ptrStart,a0
  2000. ⓪(move.l ptr,A1
  2001. ⓪(moveq  #1,d0
  2002. ⓪(moveq  #CRchar,d2
  2003. ⓪ lbl     cmpa.l a0,A1
  2004. ⓪(bne    lbl2
  2005. ⓪(move.l d0,lineNo
  2006. ⓪ lbl2    move.b (a0)+,d3
  2007. ⓪(beq    cntend
  2008. ⓪(cmp.b  d2,d3
  2009. ⓪(bne    lbl
  2010. ⓪(addq.l #1,d0
  2011. ⓪(bra    lbl
  2012. ⓪ cntend  move.l d0,(a3)+
  2013. ⓪ END
  2014. ⓪ END CountCR;
  2015. ⓪ 
  2016. ⓪ (*$l+*)
  2017. ⓪ PROCEDURE conc((*$? CompilerVersion > 3: REF*) a,b:Strings.String): Strings.String;
  2018. ⓪"VAR s: Strings.String;
  2019. ⓪"BEGIN
  2020. ⓪$Concat (a,b,s,strok);
  2021. ⓪$RETURN s
  2022. ⓪"END conc;
  2023. ⓪ 
  2024. ⓪ FORWARD PutCmd(REF k: ARRAY OF CHAR); (* String in Statuszeile drucken *)
  2025. ⓪ 
  2026. ⓪ (*$l-*)
  2027. ⓪ PROCEDURE Info;         (* durch '?' ausgelöst *)
  2028. ⓪ BEGIN
  2029. ⓪"PutCmd(
  2030. ⓪"conc(conc(conc(conc('used:',           CardToStr(ptrEnd-ptrStart-4L,6)),
  2031. ⓪1conc(' bytes; free:',   CardToStr(bufferH-ptrEnd,7))),
  2032. ⓪,conc(conc(' bytes;',         CardToStr(filesInMem,2)),
  2033. ⓪1conc(' frames;',        CardToStr(CountCR(),5)))),
  2034. ⓪,conc(' lines; cursor:', CardToStr(lineNo,5))));
  2035. ⓪"ErrorWait
  2036. ⓪ END Info;
  2037. ⓪ 
  2038. ⓪ (*$l-*)
  2039. ⓪ PROCEDURE FindCursor;           (* bringt Cursor in richtige x-Position *)
  2040. ⓪ BEGIN                           (* d1 mu∞ yx-Koordinaten enthalten *)
  2041. ⓪ ASSEMBLER                         (* a0 mu∞ auf Zeilenanfang zeigen *)
  2042. ⓪(moveq  #0,d3
  2043. ⓪(move.b (a0),d4
  2044. ⓪(beq    ma1z
  2045. ⓪(cmpi.b #DLEchar,d4
  2046. ⓪(bne    fc1
  2047. ⓪(addq.l #1,a0
  2048. ⓪(move.b (a0)+,d3
  2049. ⓪(subi.b #DLEoffset,d3    ;d3=Space-Count
  2050. ⓪ fc1     cmp.b  d3,d1
  2051. ⓪(bls    ma0z
  2052. ⓪(move.b (a0),d4
  2053. ⓪(beq    ma1z
  2054. ⓪(cmpi.b #CRchar,d4
  2055. ⓪(beq    ma0z
  2056. ⓪(addq.l #1,a0
  2057. ⓪(cmpi.b #$20,d4
  2058. ⓪(bcs    fc1
  2059. ⓪(addq.b #1,d3
  2060. ⓪(bra    fc1
  2061. ⓪ ma1z    subq.l #1,a0
  2062. ⓪(cmpi.b #dlechar,-1(a0)
  2063. ⓪(bne    ma0z
  2064. ⓪(subq.l #1,a0
  2065. ⓪ ma0z    move.l a0,ptr
  2066. ⓪(move.b d3,d1
  2067. ⓪(jmp    GotoXYd1
  2068. ⓪ END
  2069. ⓪ END FindCursor;
  2070. ⓪ 
  2071. ⓪ (*$l-*)
  2072. ⓪ PROCEDURE ScreenOut;    (* Bildschirm neu schreiben *)
  2073. ⓪ BEGIN                   (* am Textende letzte Zeile in die letzte  *)
  2074. ⓪ ASSEMBLER                 (* Bildschirmzeile drucken *)
  2075. ⓪(move   #1,screenOK
  2076. ⓪(move.l ptr,a0
  2077. ⓪(cmpi.b #DLEchar,(a0)
  2078. ⓪(bne    nodle
  2079. ⓪(addq.l #1,a0
  2080. ⓪ nodle   cmpi.b #DLEchar,-1(a0)
  2081. ⓪(bne    nodleo
  2082. ⓪(addq.l #1,a0
  2083. ⓪ nodleo  move.l a0,ptr
  2084. ⓪(move.l a0,scrPtr
  2085. ⓪(move   ptrLine,d1
  2086. ⓪ pcr     cmp    maxLine,d1       ;bis in letzte Bildschirmzeile vorpirschen
  2087. ⓪(bge    zcr
  2088. ⓪(jsr    NextCR
  2089. ⓪(addq   #1,d1
  2090. ⓪(bra    pcr
  2091. ⓪ zcr     subq   #1,d1
  2092. ⓪(beq    korr
  2093. ⓪(jsr    LastCR           ;wieder zurück, damit Bildschirm immer voll
  2094. ⓪(bra    zcr
  2095. ⓪ korr    jsr    LineSt
  2096. ⓪(move   #$174F,yx
  2097. ⓪(jsr    GotoXYd1         ; D1 ist 0!
  2098. ⓪(move   maxLine,d1
  2099. ⓪ scrn1   jsr    WriteLn
  2100. ⓪(jsr    LineOut
  2101. ⓪(subq   #1,d1
  2102. ⓪(bne    scrn1
  2103. ⓪(moveq  #0,d0
  2104. ⓪(move.b yx,d0
  2105. ⓪(move   d0,ptrLine
  2106. ⓪(jmp    GoToPtr
  2107. ⓪ END
  2108. ⓪ END ScreenOut;
  2109. ⓪ 
  2110. ⓪ (*$l-*)
  2111. ⓪ PROCEDURE CenterScreen;         (* Bildschirm schreiben, Cursor in Mitte *)
  2112. ⓪ BEGIN
  2113. ⓪ ASSEMBLER
  2114. ⓪(move   maxLine,d0
  2115. ⓪(ASR    #1,d0
  2116. ⓪(move   d0,ptrLine
  2117. ⓪(jmp    ScreenOut
  2118. ⓪ END
  2119. ⓪ END CenterScreen;
  2120. ⓪ 
  2121. ⓪ (*$l+*)
  2122. ⓪ PROCEDURE jumpPtr (p: ADDRESS);
  2123. ⓪"BEGIN
  2124. ⓪$IF (ptrStart<p) & (p<ptrEnd) THEN
  2125. ⓪&scrPtr:= ptr;
  2126. ⓪&ptr:= p;
  2127. ⓪$END;
  2128. ⓪$CenterScreen
  2129. ⓪"END jumpPtr;
  2130. ⓪ 
  2131. ⓪ (*$l-*)
  2132. ⓪ PROCEDURE CondScreen(p:PROC);   (* nur wenn Text verändert wurde *)
  2133. ⓪ BEGIN                           (* p=ScreenOut oder CenterScreen *)
  2134. ⓪ ASSEMBLER
  2135. ⓪(move.l -(a3),A1
  2136. ⓪(tst    screenOK
  2137. ⓪(beq    doit
  2138. ⓪(move.l ptr,a0
  2139. ⓪(cmpi.b #DLEchar,(a0)
  2140. ⓪(bne    nodle
  2141. ⓪(addq.l #2,a0
  2142. ⓪(move.l a0,ptr
  2143. ⓪ nodle   cmpa.l scrPtr,a0
  2144. ⓪(beq    finis
  2145. ⓪ doit    jmp    (A1)
  2146. ⓪ finis   moveq  #0,d0
  2147. ⓪(move.b ptrY,d0
  2148. ⓪(move   d0,ptrLine
  2149. ⓪ END
  2150. ⓪ END CondScreen;
  2151. ⓪ 
  2152. ⓪ 
  2153. ⓪ (*$l-*)
  2154. ⓪ PROCEDURE ChkLastPtr;           (* zeigt lastPtr ausserhalb des Textes ? *)
  2155. ⓪ BEGIN
  2156. ⓪ ASSEMBLER ;benutzt a0,A1
  2157. ⓪(move.l lastPtr,a0
  2158. ⓪(move.l ptr,A1
  2159. ⓪(cmpa.l ptrStart,a0
  2160. ⓪(bcs    doit
  2161. ⓪(cmpa.l ptrEnd,a0
  2162. ⓪(bhi    doit
  2163. ⓪(move.l a0,A1
  2164. ⓪ doit    move.l A1,lastPtr
  2165. ⓪ END
  2166. ⓪ END ChkLastPtr;
  2167. ⓪ 
  2168. ⓪ (*$l-*)
  2169. ⓪ PROCEDURE PushPtr;
  2170. ⓪ BEGIN
  2171. ⓪ ASSEMBLER
  2172. ⓪(move.l  ptr,a0
  2173. ⓪(move    ptrCount,d0
  2174. ⓪(lea     ptrStack,A1
  2175. ⓪(move    d0,d1
  2176. ⓪(subq    #4,d1
  2177. ⓪(andi    #$3C,d1
  2178. ⓪(move.l  a0,d2
  2179. ⓪(sub.l   0(A1,d1.w),d2
  2180. ⓪(bge     noneg
  2181. ⓪(neg.l   d2
  2182. ⓪ noneg   cmpi.l  #8,d2
  2183. ⓪(bcs     nopush          ;nicht pushen, wenn gleich dem Letzten+-8
  2184. ⓪(move.l  a0,0(A1,d0.w)
  2185. ⓪(addq    #4,d0
  2186. ⓪(andi    #$3C,d0
  2187. ⓪ nopush  move    d0,ptrCount
  2188. ⓪ END
  2189. ⓪ END PushPtr;
  2190. ⓪ 
  2191. ⓪ (*$l-*)
  2192. ⓪ PROCEDURE ChkZap: CARDINAL;     (* fⁿr Zap. Prⁿft, ob mehr als 200 *)
  2193. ⓪ BEGIN                           (* Zeichen gel÷scht werden, und ob  *)
  2194. ⓪ ASSEMBLER ;benutzt d0,d1,d3,a0    (* Buffer ausreicht                  *)
  2195. ⓪(move.l ptr,a0
  2196. ⓪(move.l lastPtr,d0
  2197. ⓪(move.l d0,delPtr
  2198. ⓪(cmp.l  a0,d0
  2199. ⓪(bhi    zap1
  2200. ⓪(exg    d0,a0
  2201. ⓪(move.l d0,delPtr
  2202. ⓪(move.l a0,ptr
  2203. ⓪ zap1    sub.l  a0,d0
  2204. ⓪(move.l bufferH,d1
  2205. ⓪(sub.l  ptrEnd,d1
  2206. ⓪(moveq  #2,d3
  2207. ⓪(cmp.l  d1,d0
  2208. ⓪(bhi    zap3
  2209. ⓪(subq   #1,d3
  2210. ⓪(cmp.l  #200,d0
  2211. ⓪(bhi    zap3
  2212. ⓪(subq   #1,d3
  2213. ⓪ zap3    move   d3,(a3)+
  2214. ⓪ END
  2215. ⓪ END ChkZap;
  2216. ⓪ 
  2217. ⓪ (*$l-*)
  2218. ⓪ PROCEDURE PutDir;
  2219. ⓪ BEGIN
  2220. ⓪ ASSEMBLER
  2221. ⓪(moveq  #'>',d0
  2222. ⓪(tst    direction
  2223. ⓪(beq    pcdir
  2224. ⓪(moveq  #'<',d0
  2225. ⓪ pcdir   jmp    ChrOut
  2226. ⓪ END
  2227. ⓪ END PutDir;
  2228. ⓪ 
  2229. ⓪ (*$l+*)
  2230. ⓪ PROCEDURE PutFrm;
  2231. ⓪ BEGIN
  2232. ⓪"WriteLCard (filesInMem);
  2233. ⓪"Write (' ');
  2234. ⓪ END PutFrm;
  2235. ⓪ 
  2236. ⓪ (*$l-*)
  2237. ⓪ PROCEDURE PutCmd(REF k: ARRAY OF CHAR); (* String in Statuszeile drucken *)
  2238. ⓪ BEGIN                                   (* ohne Cursorpos. zu verlieren *)
  2239. ⓪ ASSEMBLER
  2240. ⓪(clr    cmdFlag
  2241. ⓪(move   ptrY,d1
  2242. ⓪(move.b ptrX,d1
  2243. ⓪(move   d1,-(a7)
  2244. ⓪(jsr    Home
  2245. ⓪(moveq  #InverseOnChar,d0
  2246. ⓪(jsr    ChrOut
  2247. ⓪(jsr    PutDir
  2248. ⓪(TST.W  tabmode
  2249. ⓪(BNE    noFrm
  2250. ⓪(jsr    PutFrm
  2251. ⓪ noFrm   jsr    WriteString
  2252. ⓪ fillup  move   cols,d1
  2253. ⓪(cmp    CursorX,d1
  2254. ⓪(bls    filled
  2255. ⓪(moveq  #' ',d0
  2256. ⓪(jsr    chrout
  2257. ⓪(bra    fillup
  2258. ⓪ filled  moveq  #InverseOffChar,d0
  2259. ⓪(jsr    ChrOut
  2260. ⓪(move   (a7)+,d1
  2261. ⓪(jmp    GotoXYd1
  2262. ⓪ END
  2263. ⓪ END PutCmd;
  2264. ⓪ 
  2265. ⓪ (*$l+*)
  2266. ⓪ PROCEDURE PutCmdOrTab(k: MAXSTR);
  2267. ⓪ BEGIN
  2268. ⓪"IF tabMode THEN
  2269. ⓪$Assign (TabsToStr(), k, strok);
  2270. ⓪$Delete (k,0,1,STROK)
  2271. ⓪"END;
  2272. ⓪"PutCmd(k)
  2273. ⓪ END PutCmdOrTab;
  2274. ⓪ 
  2275. ⓪ (*$l+*)
  2276. ⓪ PROCEDURE CmdLineAway (checkMouse: BOOLEAN): BOOLEAN;
  2277. ⓪"(* Statuszeile evtl. erneuern ? *)
  2278. ⓪"VAR c: CARDINAL;
  2279. ⓪&buttons: mButtonSet;
  2280. ⓪&Mousepoint: Point;
  2281. ⓪"BEGIN
  2282. ⓪$IF cmdFlag THEN RETURN
  2283. ⓪&FALSE
  2284. ⓪$ELSE
  2285. ⓪&c:= countDefault;
  2286. ⓪&LOOP
  2287. ⓪(IF KeyPressed () THEN RETURN FALSE END;
  2288. ⓪(GetMouseState(dev,MousePoint, buttons); (*hält Ablauf nicht an *)
  2289. ⓪(IF checkMouse AND (msbut1 IN buttons) THEN RETURN FALSE END;
  2290. ⓪(IF c = 0 THEN RETURN TRUE END;
  2291. ⓪(DEC (c)
  2292. ⓪&END
  2293. ⓪$END;
  2294. ⓪$(*
  2295. ⓪(ASSEMBLER
  2296. ⓪0moveq  #0,d0
  2297. ⓪0tst    cmdFlag
  2298. ⓪0bne    clart
  2299. ⓪0move   countDefault,d1
  2300. ⓪(wait    move   d1,-(a7)
  2301. ⓪0jsr    KeyPressed
  2302. ⓪0move   (a7)+,d1
  2303. ⓪0moveq  #0,d0
  2304. ⓪0tst    -(a3)
  2305. ⓪0dbne   d1,wait
  2306. ⓪0bne    clart
  2307. ⓪0moveq  #1,d0
  2308. ⓪(clart   move   d0,(a3)+
  2309. ⓪(END
  2310. ⓪$*)
  2311. ⓪"END CmdLineAway;
  2312. ⓪ 
  2313. ⓪ (*$l-*)
  2314. ⓪ PROCEDURE InsCmd;
  2315. ⓪ BEGIN
  2316. ⓪"PutCmdOrTab('Insert: /F1/ or /Enter/ accepts, /ESC/ ignores')
  2317. ⓪ END InsCmd;
  2318. ⓪ 
  2319. ⓪ (*$l-*)
  2320. ⓪ PROCEDURE Overflow;
  2321. ⓪ BEGIN
  2322. ⓪"ASSEMBLER move.l A2,-(a7) END;
  2323. ⓪"PutCmd('Buffer overflow');Bell;ErrorWait;
  2324. ⓪"ASSEMBLER move.l (a7)+,A2 END
  2325. ⓪ END Overflow;
  2326. ⓪ 
  2327. ⓪ (*$l-*)
  2328. ⓪ PROCEDURE Available(bytes:INTEGER):BOOLEAN;
  2329. ⓪ BEGIN           (* Test, ob noch <bytes> Zeichen eingefⁿgt werden k÷nnen *)
  2330. ⓪ ASSEMBLER    ;benutzt d1,d2
  2331. ⓪+moveq  #0,d2
  2332. ⓪+move   -(a3),d1
  2333. ⓪+ext.l  d1
  2334. ⓪+add.l  bufferH,d1
  2335. ⓪+sub.l  bufferL,d1
  2336. ⓪+add.l  ptrEnd,d1
  2337. ⓪+cmp.l  bufferH,d1
  2338. ⓪+bpl    keinplatz
  2339. ⓪+cmp.l  bufferL,d1
  2340. ⓪+bpl    keinplatz
  2341. ⓪+moveq  #1,d2
  2342. ⓪ keinplatz  move   d2,(a3)+
  2343. ⓪ END
  2344. ⓪ END Available;
  2345. ⓪ 
  2346. ⓪ (*$l-*)
  2347. ⓪ PROCEDURE MoveTags(ad:ADDRESS; cnt:LONGINT);
  2348. ⓪ BEGIN           (* verschiebt die Tags, nachdem der Text verschoben wurde *)
  2349. ⓪ ASSEMBLER ;benutzt d0,d1,a0,A1,A2
  2350. ⓪(move.l -(a3),d0
  2351. ⓪(move.l -(a3),a0
  2352. ⓪(moveq  #58,d1
  2353. ⓪(lea    ptrStack,A1      ;tags inbegriffen
  2354. ⓪(tst.l  d0
  2355. ⓪(beq    adjrts
  2356. ⓪(bpl    adjtag
  2357. ⓪(adda.l d0,a0
  2358. ⓪ adjtag  move.l (A1)+,A2
  2359. ⓪(cmpa.l A2,a0
  2360. ⓪(bhi    noadj
  2361. ⓪(adda.l d0,A2
  2362. ⓪(cmpa.l A2,a0
  2363. ⓪(bls    adjt1
  2364. ⓪(move.l #0,A2
  2365. ⓪ adjt1   move.l A2,-4(A1)
  2366. ⓪ noadj   dbf    d1,adjtag
  2367. ⓪(move.l lastPtr,A2
  2368. ⓪(cmpa.l A2,a0
  2369. ⓪(bhi    adjt2
  2370. ⓪(adda.l d0,A2
  2371. ⓪(cmpa.l A2,a0
  2372. ⓪(bls    adjt2
  2373. ⓪(move.l a0,A2
  2374. ⓪ adjt2   move.l A2,lastPtr
  2375. ⓪ ;'ptr' darf hier nicht verschoben werden, weil das ggf. schon woanders passiert.
  2376. ⓪ adjrts
  2377. ⓪ END
  2378. ⓪ END MoveTags;
  2379. ⓪ 
  2380. ⓪ (*$l-*)
  2381. ⓪ PROCEDURE saveTags;
  2382. ⓪ BEGIN
  2383. ⓪ ASSEMBLER
  2384. ⓪(moveq  #58,d1
  2385. ⓪(lea    saveStack,A0
  2386. ⓪(lea    ptrStack,A1
  2387. ⓪ adjtag  move.l (A1)+,(A0)+
  2388. ⓪(dbf    d1,adjtag
  2389. ⓪(move.l lastPtr,(A0)+
  2390. ⓪ END
  2391. ⓪ END saveTags;
  2392. ⓪ 
  2393. ⓪ (*$l-*)
  2394. ⓪ PROCEDURE restoreTags;
  2395. ⓪ BEGIN
  2396. ⓪ ASSEMBLER
  2397. ⓪(moveq  #58,d1
  2398. ⓪(lea    saveStack,A0
  2399. ⓪(lea    ptrStack,A1
  2400. ⓪ adjtag  move.l (A0)+,(A1)+
  2401. ⓪(dbf    d1,adjtag
  2402. ⓪(move.l (A0)+,lastPtr
  2403. ⓪ END
  2404. ⓪ END restoreTags;
  2405. ⓪ 
  2406. ⓪ (*$l-*)
  2407. ⓪ PROCEDURE MoveText(ad:ADDRESS; displace:LONGINT);
  2408. ⓪ BEGIN           (* verschiebt Text im Speicher ab Adresse ad um displace *)
  2409. ⓪ ASSEMBLER ;benutzt d0,d1,a0,A1,A2
  2410. ⓪(move.l -4(a3),d0   ;displace
  2411. ⓪(move.l -8(a3),A1   ;ad          ! Parameter bleiben auf Stack !
  2412. ⓪(move.l ptrEnd,a0
  2413. ⓪(tst.l  d0
  2414. ⓪(beq    movrts
  2415. ⓪(clr    saved
  2416. ⓪(clr    restoreFileDT
  2417. ⓪(clr    screenOK
  2418. ⓪(
  2419. ⓪(lea    0(A1,d0.l),A2
  2420. ⓪(add.l  d0,ptrEnd
  2421. ⓪(; A1: source-Start, A2: dest-Start
  2422. ⓪(MOVE.L  D2,-(A7)
  2423. ⓪(MOVE.L  A1,(A3)+
  2424. ⓪(SUBA.L  A1,A0           ;Länge = ptrEnd - start
  2425. ⓪(ADDQ.L  #1,A0
  2426. ⓪(MOVE.L  A0,(A3)+
  2427. ⓪(MOVE.L  A2,(A3)+
  2428. ⓪(JSR     Block.Copy
  2429. ⓪(MOVE.L  (A7)+,D2
  2430. ⓪ movrts  jmp    MoveTags
  2431. ⓪ END
  2432. ⓪ END MoveText;
  2433. ⓪ 
  2434. ⓪ (*$l-*)
  2435. ⓪ PROCEDURE BufferToText(copyDLE: BOOLEAN);
  2436. ⓪ BEGIN                   (* kopiert den Buffer-Inhalt an die Textstelle *)
  2437. ⓪ ASSEMBLER
  2438. ⓪*move.l bufferH,d4
  2439. ⓪*sub.l  bufferL,d4
  2440. ⓪*bgt    bok1
  2441. ⓪*beq    bleer1
  2442. ⓪ bleer     move.l bufferH,bufferL END;
  2443. ⓪*PutCmd('Buffer bad'); ASSEMBLER
  2444. ⓪*jsr    Bell
  2445. ⓪*jsr    ErrorWait
  2446. ⓪ bleer1    bra    bnix
  2447. ⓪ bok1      clr    (a3)+
  2448. ⓪*jsr    Available
  2449. ⓪*tst    -(a3)
  2450. ⓪*beq    bleer
  2451. ⓪*move.l bufferH,d3
  2452. ⓪*sub.l  bufferL,d3
  2453. ⓪*ble    bnix
  2454. ⓪*move.l d3,-(a7)
  2455. ⓪*move.l ptr,(a3)+
  2456. ⓪*move.l d3,(a3)+
  2457. ⓪*jsr    MoveText
  2458. ⓪*move.l ptr,A1
  2459. ⓪*move.l bufferH,a0
  2460. ⓪*move.l (a7)+,d3
  2461. ⓪ rein      move.b -(a0),(A1)+
  2462. ⓪*subq.l #1,d3
  2463. ⓪*bgt    rein
  2464. ⓪*move.l ptr,a0
  2465. ⓪*move.l A1,ptr
  2466. ⓪*tst    -2(a3)         ;copyIt?   bei Insert keinen DLE kopieren
  2467. ⓪*beq    bnix
  2468. ⓪*jsr    LineSt
  2469. ⓪*cmpi.b #DLEchar,(a0)
  2470. ⓪*bne    bnix
  2471. ⓪*cmpi.b #DLEchar,-2(A1)
  2472. ⓪*bne    bnix
  2473. ⓪*move.b 1(a0),-1(A1)
  2474. ⓪ bnix      subq.l #2,a3
  2475. ⓪ END
  2476. ⓪ END BufferToText;
  2477. ⓪ 
  2478. ⓪ (*$l-*)
  2479. ⓪ PROCEDURE DelInBuffer;          (* bei Delete: falls ESC gedrⁿckt wurde *)
  2480. ⓪ BEGIN
  2481. ⓪ ASSEMBLER ;benutzt d1,a0,A2
  2482. ⓪(move.l ptr,d1
  2483. ⓪(move.l delPtr,a0
  2484. ⓪(cmp.l  a0,d1
  2485. ⓪(bcc    lolehi
  2486. ⓪(exg    a0,d1
  2487. ⓪ lolehi  move.l bufferH,A2
  2488. ⓪(cmp.l  a0,d1
  2489. ⓪(beq    dnixin
  2490. ⓪ abinb   move.b (a0)+,-(A2)
  2491. ⓪(cmp.l  a0,d1
  2492. ⓪(bhi    abinb
  2493. ⓪ dnixin  move.l A2,bufferL
  2494. ⓪ END
  2495. ⓪ END DelInBuffer;
  2496. ⓪ 
  2497. ⓪ (*$l-*)
  2498. ⓪ PROCEDURE AbInBuffer;           (* delPtr-ptr in Buffer, dann l÷schen *)
  2499. ⓪ BEGIN                           (* egal ob delPtr>ptr oder delPtr<ptr *)
  2500. ⓪ ASSEMBLER ;benutzt d0,a0,A1
  2501. ⓪(jsr    DelInBuffer      ;in A2 steht noch bufferL
  2502. ⓪(move.l ptr,a0
  2503. ⓪(move.l delPtr,A1
  2504. ⓪(move.l A1,d0
  2505. ⓪(sub.l  a0,d0
  2506. ⓪(bmi    aib1
  2507. ⓪(exg    A1,a0
  2508. ⓪(neg.l  d0               ;a0 ist h÷here Adresse
  2509. ⓪ aib1    cmpi.b #DLEchar,-2(a0)  ;letzter mitgel÷schter DLE-Code
  2510. ⓪(bne    aib2
  2511. ⓪(cmpi.b #DLEchar,-2(A1)  ;DLE vor gel. Bereich
  2512. ⓪(bne    aib2
  2513. ⓪(move.b -1(a0),-1(A1)    ;DLE-Code kopieren
  2514. ⓪ aib2    move.l a0,(a3)+
  2515. ⓪(move.l d0,(a3)+
  2516. ⓪(jmp    MoveText
  2517. ⓪ END
  2518. ⓪ END AbInBuffer;
  2519. ⓪ 
  2520. ⓪ (* ED4.ICL *)
  2521. ⓪ 
  2522. ⓪ (*$l-*)
  2523. ⓪ PROCEDURE IncrementVersion (): Strings.String;
  2524. ⓪ BEGIN
  2525. ⓪ ASSEMBLER
  2526. ⓪(clr.b   (a3)
  2527. ⓪(lea     80(A3),A3
  2528. ⓪(move.l  ptrStart,a0
  2529. ⓪ fndlp   move.b  (a0)+,d0
  2530. ⓪(beq     xit
  2531. ⓪(cmpi.b  #'V',d0
  2532. ⓪(beq     fndV
  2533. ⓪(cmpi.b  #DLEchar,d0
  2534. ⓪(bne     fndlp
  2535. ⓪(addq.l  #1,a0
  2536. ⓪(bra     fndlp
  2537. ⓪ fndV    cmpi.b  #'#',(a0)+
  2538. ⓪(bne     fndlp
  2539. ⓪(move.l  a0,A1
  2540. ⓪ fnddig  move.b  (a0)+,d0
  2541. ⓪(cmpi.b  #'0',d0
  2542. ⓪(bcs     incr
  2543. ⓪(cmpi.b  #'9',d0
  2544. ⓪(bls     fnddig
  2545. ⓪ incr    subq.l  #1,a0
  2546. ⓪(lea     -1(a0),A2
  2547. ⓪ incrlp  move.b  -(a0),d0
  2548. ⓪(cmpa.l  a0,A1
  2549. ⓪(bhi     wrt
  2550. ⓪(clr     saved
  2551. ⓪(clr     restoreFileDT
  2552. ⓪(addq.b  #1,d0
  2553. ⓪(cmpi.b  #'9',d0
  2554. ⓪(bls     incrxt
  2555. ⓪(move.b  #'0',(a0)
  2556. ⓪(bra     incrlp
  2557. ⓪ incrxt  move.b  d0,(a0)
  2558. ⓪ wrt     lea     -80(A3),A0
  2559. ⓪(move.b  #'V',(a0)+
  2560. ⓪(move.b  #'#',(a0)+
  2561. ⓪ wrtlp   move.b  (A1)+,(a0)+
  2562. ⓪(cmpa.l  A1,A2
  2563. ⓪(bcc     wrtlp
  2564. ⓪(clr.b   (a0)
  2565. ⓪ xit
  2566. ⓪ END
  2567. ⓪ END IncrementVersion;
  2568. ⓪ 
  2569. ⓪ (*$l-*)
  2570. ⓪ PROCEDURE Exchg(ch:CHAR): BOOLEAN;(* ein Zeichen an Textstelle schreiben *)
  2571. ⓪ BEGIN
  2572. ⓪ ASSEMBLER ;benutzt d0,a0
  2573. ⓪(move   -(a3),-(a7)
  2574. ⓪(move.l ptr,a0
  2575. ⓪(move.b (a0),d0
  2576. ⓪(beq    ins0
  2577. ⓪(cmpi.b #CRchar,d0
  2578. ⓪(bne    ok
  2579. ⓪ ins0    moveq  #0,d0
  2580. ⓪(move   #1,(a3)+
  2581. ⓪(jsr    Available
  2582. ⓪(tst    -(a3)
  2583. ⓪(beq    nonono
  2584. ⓪(move.l ptr,(a3)+
  2585. ⓪(move.l #1,(a3)+
  2586. ⓪(jsr    MoveText
  2587. ⓪ ok      moveq  #1,d0
  2588. ⓪(clr    saved
  2589. ⓪(clr     restoreFileDT
  2590. ⓪(move.l ptr,a0
  2591. ⓪(move.b (a7),(a0)+
  2592. ⓪(move.l a0,ptr
  2593. ⓪ nonono  move   d0,(a3)+
  2594. ⓪(addq.l #2,a7
  2595. ⓪ END
  2596. ⓪ END Exchg;
  2597. ⓪ 
  2598. ⓪ (*$l-*)
  2599. ⓪ PROCEDURE FillIn(ad:ADDRESS; VAR n:STRING); (* String an ad einspeichern *)
  2600. ⓪ BEGIN
  2601. ⓪ ASSEMBLER ;benutzt d0,a0,A1
  2602. ⓪(move.l -(a3),a0
  2603. ⓪(move.l -(a3),A1
  2604. ⓪(move.b (a0)+,d0
  2605. ⓪(beq    nofill
  2606. ⓪ lbl     move.b d0,(A1)+
  2607. ⓪(move.b (a0)+,d0
  2608. ⓪(bne    lbl
  2609. ⓪(clr    saved
  2610. ⓪(clr     restoreFileDT
  2611. ⓪(clr    screenOK
  2612. ⓪ nofill
  2613. ⓪ END
  2614. ⓪ END FillIn;
  2615. ⓪ 
  2616. ⓪ (*$l-*)
  2617. ⓪ PROCEDURE Search(): BOOLEAN;      (* findet Auftreten von oldString im Text *)
  2618. ⓪ BEGIN (* delPtr zeigt auf erstes Zeichen, ptr dahinter *)
  2619. ⓪ ASSEMBLER    ;benutzt d0-d7,a0-A6
  2620. ⓪+movem.l d3-d7,-(a7)  ;die movem müssen wg. D6 am Ende getrennt sein!
  2621. ⓪+movem.l A6/a3/a4,-(a7)
  2622. ⓪+link   A5,#0
  2623. ⓪+moveq  #0,d6         ;d6=BOOLEAN-Ergebnis
  2624. ⓪+lea    oldString,A1
  2625. ⓪+moveq  #0,d4
  2626. ⓪+move.b (A1)+,d4      ;d4=Length(oldString)
  2627. ⓪+beq.l  srchrts
  2628. ⓪+move.l ptr,a0        ;a0=Text-Pointer
  2629. ⓪+lea    getplus(pc),A6
  2630. ⓪+lea    getoldp(pc),a4
  2631. ⓪+tst    direction     ;true=rückwärts
  2632. ⓪+beq    dok
  2633. ⓪+lea    getmin(pc),A6
  2634. ⓪+lea    getoldm(pc),a4
  2635. ⓪+adda   d4,A1
  2636. ⓪ dok        moveq  #0,d0         ;obere Bytes von D0 löschen
  2637. ⓪+moveq  #0,d3         ;obere Bytes von D3 löschen
  2638. ⓪+; ** das 1. gesuchte Zeichen auf den Stack **
  2639. ⓪+lea    NormTab,a3
  2640. ⓪+lea    anum2(PC),a2
  2641. ⓪+jsr    (a4)          ;erstes suchzeichen nach D3/D7
  2642. ⓪+move.l a1,-(A7)
  2643. ⓪+move   d3,d7
  2644. ⓪+tst    findCase      ;Case-Sensitivity-Flag
  2645. ⓪+bne    csens
  2646. ⓪+lea    ShiftTab,a3
  2647. ⓪+move.b 0(a3,d3.w),d7 ;upper case
  2648. ⓪+addi.w #256,d3
  2649. ⓪+move.b 0(a3,d3.w),d3 ;lower case
  2650. ⓪+andi   #255,D3
  2651. ⓪ csens      move.w d7,-(a7)
  2652. ⓪+move.b d3,(a7)
  2653. ⓪+tst    findWord
  2654. ⓪+bne    wsrch
  2655. ⓪+bra.w  srchneu
  2656. ⓪ 
  2657. ⓪ ; ***** Ende der Suchvorbereitung *****
  2658. ⓪ 
  2659. ⓪ getmin     move.b -(a0),d0
  2660. ⓪+beq.l  srchrts
  2661. ⓪+cmpi.b #DLEchar,-1(a0)
  2662. ⓪+bne    getmin1
  2663. ⓪+subq.l #1,a0
  2664. ⓪+move.l a0,delPtr
  2665. ⓪+bra    getmin
  2666. ⓪ getmin1    rts
  2667. ⓪ 
  2668. ⓪ getplus    move.b (a0)+,d0
  2669. ⓪+beq.l  srchrts
  2670. ⓪+cmpi.b #DLEchar,d0
  2671. ⓪+bne    getplus1
  2672. ⓪+addq.l #1,a0
  2673. ⓪+move.l a0,delPtr
  2674. ⓪+bra    getplus
  2675. ⓪ getplus1   rts
  2676. ⓪ 
  2677. ⓪ getoldm    move.b -(A1),d3
  2678. ⓪+move.b 0(a3,d3.w),d3 ;upper case
  2679. ⓪+rts
  2680. ⓪ getoldp    move.b (A1)+,d3
  2681. ⓪+move.b 0(a3,d3.w),d3 ;upper case
  2682. ⓪+rts
  2683. ⓪ 
  2684. ⓪ ; * wortweise *
  2685. ⓪ 
  2686. ⓪ wsrch      move.l 2(a7),A1         ;A1=Zeiger in oldString
  2687. ⓪+move   d4,d5         ;Schleifenzähler
  2688. ⓪+move.b (a7),d3
  2689. ⓪+move.b 1(a7),d7
  2690. ⓪+tst    direction     ;true=rückwärts
  2691. ⓪+beq    forw3
  2692. ⓪ 
  2693. ⓪ back3      ; erstmal alle AlphaNums überspringen
  2694. ⓪+move.b -(a0),d0
  2695. ⓪+TST.B  0(A2,D0.W)    ;AlphaNum?
  2696. ⓪+beq    back3         ;ja
  2697. ⓪+bpl    back4
  2698. ⓪+tst.b  d0
  2699. ⓪+bne    back3         ;muß DLE gewesen sein - weiter
  2700. ⓪+bra.w  srchrts
  2701. ⓪ back4      ;dies zeichen kann noch übersprungen werden, weil es ja kein
  2702. ⓪+;alpha-zeichen ist, dahinter suchen wir wortanfang
  2703. ⓪+move.b -(a0),d0
  2704. ⓪+TST.B  0(A2,D0.W)    ;AlphaNum?
  2705. ⓪+beq    back5         ;ja
  2706. ⓪+bpl    back4
  2707. ⓪+tst.b  d0
  2708. ⓪+bne    back4         ;muß DLE gewesen sein - weiter
  2709. ⓪+bra.w  srchrts
  2710. ⓪ back5      ;wortanfang - stimmt 1. zeichen?
  2711. ⓪+cmp.b  d3,d0
  2712. ⓪+beq.w  found1
  2713. ⓪+cmp.b  d7,d0
  2714. ⓪+bne    back3         ;stimmt nicht - wieder zum wortende
  2715. ⓪+bra.w  found1
  2716. ⓪ 
  2717. ⓪ forw3      ; erstmal alle AlphaNums überspringen
  2718. ⓪+move.b (a0)+,d0
  2719. ⓪+TST.B  0(A2,D0.W)    ;AlphaNum?
  2720. ⓪+beq    forw3         ;ja - weitersuchen
  2721. ⓪+bpl    forw2         ;nein
  2722. ⓪+tst.b  d0
  2723. ⓪+beq.w  srchrts
  2724. ⓪+;muß DLE gewesen sein. Überspringen und weiter wie nicht-AlphaNum
  2725. ⓪+addq.l #1,a0
  2726. ⓪ forw2      ;dies zeichen kann noch übersprungen werden, weil es ja kein
  2727. ⓪+;alpha-zeichen ist, dahinter suchen wir wortanfang
  2728. ⓪+move.b (a0)+,d0
  2729. ⓪+TST.B  0(A2,D0.W)    ;AlphaNum?
  2730. ⓪+beq    forw5         ;ja -> wortanfang gefunden
  2731. ⓪+bpl    forw2         ;nein, weiter nach anfang suchen
  2732. ⓪+tst.b  d0
  2733. ⓪+beq.w  srchrts
  2734. ⓪+;muß DLE gewesen sein
  2735. ⓪+addq.l #1,a0
  2736. ⓪+bra    forw2
  2737. ⓪ forw5      ;wortanfang - stimmt 1. zeichen?
  2738. ⓪+cmp.b  d3,d0
  2739. ⓪+beq.w  found1
  2740. ⓪+cmp.b  d7,d0
  2741. ⓪+bne    forw3         ;stimmt nicht - wieder zum wortende
  2742. ⓪+bra.w  found1
  2743. ⓪ 
  2744. ⓪ ; * normal suchen *
  2745. ⓪ 
  2746. ⓪ srchneu    move.l 2(a7),A1         ;A1=Zeiger in oldString
  2747. ⓪+move   d4,d5         ;Schleifenzähler
  2748. ⓪+; ** das 1. Zeichen wird schneller gesucht **
  2749. ⓪+move.b (a7),d3
  2750. ⓪+move.b 1(a7),d7
  2751. ⓪+tst    direction     ;true=rückwärts
  2752. ⓪+beq    forw1
  2753. ⓪ back1      ; rückw. suchen
  2754. ⓪+move.b -(a0),d0
  2755. ⓪+beq.l  srchrts
  2756. ⓪+cmp.b  d3,d0
  2757. ⓪+beq    backfnd
  2758. ⓪+cmp.b  d7,d0
  2759. ⓪+bne    back1
  2760. ⓪ backfnd    cmpi.b #DLEchar,-1(a0)       ; ist ein DLE davor?
  2761. ⓪+beq    back1                 ; dann haben wir uns geirrt
  2762. ⓪+bra    found1
  2763. ⓪ forw1      ; vorw. suchen
  2764. ⓪+move.b (a0)+,d0
  2765. ⓪+beq.l  srchrts
  2766. ⓪+cmp.b  d3,d0
  2767. ⓪+beq    forwfnd
  2768. ⓪+cmp.b  d7,d0
  2769. ⓪+bne    forw1
  2770. ⓪ forwfnd    cmpi.b #DLEchar,-2(a0)       ; war ein DLE davor?
  2771. ⓪+beq    forw1                 ; dann haben wir uns geirrt
  2772. ⓪ 
  2773. ⓪ found1     ; gefunden
  2774. ⓪+move.l a0,delPtr
  2775. ⓪+subq   #1,d5
  2776. ⓪+beq    found2
  2777. ⓪ 
  2778. ⓪+; jetzt die restlichen Zeichen vergleichen
  2779. ⓪ srchmore   jsr    (A6)          ;getbyte
  2780. ⓪+move.b 0(a3,d0.w),d0 ;upper case
  2781. ⓪+jsr    (a4)          ;getold
  2782. ⓪+cmp.b  d0,d3
  2783. ⓪+bne    srchmism
  2784. ⓪+subq   #1,d5
  2785. ⓪+bne    srchmore
  2786. ⓪ 
  2787. ⓪ found2     move.l a0,A1
  2788. ⓪+tst    findWord
  2789. ⓪+beq    found3
  2790. ⓪+move.l delPtr,-(A7)
  2791. ⓪+jsr    (A6)          ;getbyte
  2792. ⓪+move.l (A7)+,delPtr
  2793. ⓪+TST.B  0(A2,D0.W)    ;AlphaNum?
  2794. ⓪+beq    wsrch         ;ja
  2795. ⓪ found3     moveq  #1,d6         ;Erfolg
  2796. ⓪+move.l A1,ptr
  2797. ⓪+tst    direction     ;true=rückwärts
  2798. ⓪+bne.w  srchrts
  2799. ⓪+subq.l #1,delPtr
  2800. ⓪+bra.w  srchrts
  2801. ⓪ 
  2802. ⓪ srchmism   move.l delPtr,a0
  2803. ⓪+tst    findWord
  2804. ⓪+bne    wsrch
  2805. ⓪+bra    srchneu
  2806. ⓪ 
  2807. ⓪ anum2   ; Alphanum-Tab, -1 bei Null und DLE
  2808. ⓪(DC.B -1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  2809. ⓪(DC.B -1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  2810. ⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  2811. ⓪(DC.B 0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1
  2812. ⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  2813. ⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0
  2814. ⓪(DC.B 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  2815. ⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1
  2816. ⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  2817. ⓪(DC.B 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  2818. ⓪(DC.B 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1
  2819. ⓪(DC.B 0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1
  2820. ⓪(DC.B 0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  2821. ⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  2822. ⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  2823. ⓪(DC.B 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  2824. ⓪ 
  2825. ⓪+; Suchende
  2826. ⓪ 
  2827. ⓪ srchrts    unlk   A5
  2828. ⓪+movem.l (a7)+,A6/a3/a4
  2829. ⓪+move   d6,(a3)+
  2830. ⓪+movem.l (a7)+,d3-d7
  2831. ⓪ END
  2832. ⓪ END Search;
  2833. ⓪ 
  2834. ⓪ (*$l+*)
  2835. ⓪ PROCEDURE ChkName(VAR n:STRING): BOOLEAN;
  2836. ⓪"VAR p,l:INTEGER;
  2837. ⓪ BEGIN           (* evtl. '.TXT' anhängen *)
  2838. ⓪"Upper(n);
  2839. ⓪"IF Empty (FileNames.FileName(n)) THEN
  2840. ⓪$n:=''; RETURN false
  2841. ⓪"ELSE
  2842. ⓪$(* dies muß raus, da sonst keine Dateien ohne Suffix geladen werden können:
  2843. ⓪&p := Pos('.',n,0);
  2844. ⓪&IF p<0 THEN
  2845. ⓪(Concat(n,'.TXT',n,strok)
  2846. ⓪&END
  2847. ⓪$*)
  2848. ⓪"END;
  2849. ⓪"RETURN true
  2850. ⓪ END ChkName;
  2851. ⓪ 
  2852. ⓪ 
  2853. ⓪ (*$l-*)
  2854. ⓪ PROCEDURE PutInfo;      (* den infoBlock zum Abspeichern fⁿllen *)
  2855. ⓪ BEGIN
  2856. ⓪ ASSEMBLER ;benutzt d0,d1,d2,a0,A1
  2857. ⓪(
  2858. ⓪(lea     infobuffer,A1
  2859. ⓪(move.l  #$0d0a282A,(A1)+
  2860. ⓪(MOVE.B  #' ',(A1)+
  2861. ⓪(bra     cont
  2862. ⓪(
  2863. ⓪ putlcard
  2864. ⓪(move.l  d2,(a3)+
  2865. ⓪(move    #9,(a3)+
  2866. ⓪(movem.l d0/d1/a0/A1,-(a7)
  2867. ⓪(jsr     lhextostr
  2868. ⓪(movem.l (a7)+,d0/d1/a0/A1
  2869. ⓪(lea     -80(a3),A2
  2870. ⓪(moveq   #8,d2
  2871. ⓪ putl1   move.b  (A2)+,(A1)+
  2872. ⓪(dbra    d2,putl1
  2873. ⓪(lea     -80(a3),a3
  2874. ⓪(rts
  2875. ⓪(
  2876. ⓪ putch   ori.b   #$80,d0
  2877. ⓪(move.b  d0,(A1)+
  2878. ⓪(rts
  2879. ⓪(
  2880. ⓪ cont    lea     tags,a0
  2881. ⓪(move.l  ptrStart,d1
  2882. ⓪(moveq   #41,d0
  2883. ⓪ coptag  move.l  (a0)+,d2
  2884. ⓪(sub.l   d1,d2
  2885. ⓪(bsr     putlcard
  2886. ⓪(dbf     d0,coptag
  2887. ⓪(
  2888. ⓪(move    findCase,d0
  2889. ⓪(bsr     putch
  2890. ⓪(
  2891. ⓪(move.l  lastPtr,d2
  2892. ⓪(sub.l   d1,d2
  2893. ⓪(bsr     putlcard
  2894. ⓪(
  2895. ⓪(movem.l d0/d1/a0/A1,-(a7)
  2896. ⓪(jsr     tabsToStr
  2897. ⓪(movem.l (a7)+,d0/d1/a0/A1
  2898. ⓪(lea     -82(a3),a0
  2899. ⓪(moveq   #79,d0
  2900. ⓪ coptab  move.b  (a0)+,(A1)+
  2901. ⓪(dbf     d0,coptab
  2902. ⓪(lea     -82(a3),a3
  2903. ⓪(
  2904. ⓪(lea     ptrStack,a0
  2905. ⓪(moveq   #15,d0
  2906. ⓪ ctag2   move.l  (a0)+,d2
  2907. ⓪(sub.l   d1,d2
  2908. ⓪(bsr     putlcard
  2909. ⓪(dbf     d0,ctag2
  2910. ⓪(
  2911. ⓪(move    ptrCount,d0
  2912. ⓪(bsr     putch
  2913. ⓪(move    autoBack,d0
  2914. ⓪(bsr     putch
  2915. ⓪(move    autoIncVer,d0
  2916. ⓪(move    leaveDLEonWrite,D1
  2917. ⓪(LSL     #1,D1
  2918. ⓪(OR      D1,D0
  2919. ⓪(bsr     putch
  2920. ⓪(MOVE.L  #$2A290D0A,(A1)+
  2921. ⓪(moveq   #20,d0
  2922. ⓪ clrl    move.b  #'.',(A1)+
  2923. ⓪(dbra    d0,clrl
  2924. ⓪ END
  2925. ⓪ END PutInfo;
  2926. ⓪ 
  2927. ⓪ 
  2928. ⓪ (*$l-*)
  2929. ⓪ PROCEDURE CleanText;
  2930. ⓪ BEGIN
  2931. ⓪ ASSEMBLER
  2932. ⓪(JSR     savetags
  2933. ⓪(TST     makeDLE
  2934. ⓪(BEQ.L   rmdo
  2935. ⓪ 
  2936. ⓪(; neuer Text, DLE einfügen
  2937. ⓪ 
  2938. ⓪(; zuerst die Verschiebungen berechnen
  2939. ⓪ spdo    MOVE.L  ptrStart,A1
  2940. ⓪(MOVE.L  A1,A2
  2941. ⓪(MOVE.L  ptrEnd,D2
  2942. ⓪(SUB.L   A1,D2
  2943. ⓪(MOVEQ   #0,D3
  2944. ⓪ 
  2945. ⓪ spdln   MOVEQ   #2,D1
  2946. ⓪ 
  2947. ⓪ spdcnt  CMPI.B  #' ',(A1)
  2948. ⓪(BNE     spdmo
  2949. ⓪(ADDQ.L  #1,A1
  2950. ⓪(SUBQ.L  #1,D1
  2951. ⓪(ADDQ.L  #1,A2
  2952. ⓪(SUBQ.L  #1,D2
  2953. ⓪(BRA     spdcnt
  2954. ⓪ 
  2955. ⓪ spdmo   CMPI.B  #DLEchar,(A1)
  2956. ⓪(BNE     spdmo1
  2957. ⓪ 
  2958. ⓪(SUBQ.L  #2,D2
  2959. ⓪(SUBQ.L  #2,D1
  2960. ⓪(MOVEQ   #0,D3
  2961. ⓪(ADDQ.L  #2,A1
  2962. ⓪(ADDQ.L  #2,A2
  2963. ⓪ 
  2964. ⓪ spdmo1  CMPA.L  bufferL,A2
  2965. ⓪(BLS     spdmo2
  2966. ⓪(JSR     overflow
  2967. ⓪(JMP     restoretags
  2968. ⓪ spdmo2  MOVE.L  A2,(A3)+
  2969. ⓪(ADD.L   D1,D3
  2970. ⓪(MOVE.L  D3,(A3)+
  2971. ⓪(ADDA.L  D3,A2
  2972. ⓪(MOVEM.L D1/D2/A1/A2,-(A7)
  2973. ⓪(JSR     MoveTags
  2974. ⓪(MOVEM.L (A7)+,D1/D2/A1/A2
  2975. ⓪(MOVEQ   #0,D3
  2976. ⓪ spnex   SUBQ.L  #1,D2
  2977. ⓪(ADDQ.L  #1,A2
  2978. ⓪(MOVE.B  (A1)+,D0
  2979. ⓪(CMPI.B  #$0D,D0
  2980. ⓪(BEQ     spdlx
  2981. ⓪(CMPI.B  #$0A,D0
  2982. ⓪(BEQ     spd00
  2983. ⓪(CMPI.B  #' ',D0
  2984. ⓪(BNE     sptr
  2985. ⓪(SUBQ.L  #1,D3
  2986. ⓪(BRA     spcr
  2987. ⓪ sptr    MOVEQ   #0,D3
  2988. ⓪ spcr    TST.L   D2
  2989. ⓪(BPL     spnex
  2990. ⓪(
  2991. ⓪(BRA     spcdo   ; Fertig
  2992. ⓪(
  2993. ⓪ spdlx   CMPI.B  #$0A,(A1)
  2994. ⓪(BNE     spd00
  2995. ⓪(
  2996. ⓪(SUBQ.L  #1,D2
  2997. ⓪(ADDQ.L  #1,A2
  2998. ⓪(ADDQ.L  #1,A1
  2999. ⓪(SUBQ.L  #1,D3
  3000. ⓪ spd00   TST.L   D2
  3001. ⓪(BPL     spdln
  3002. ⓪ 
  3003. ⓪(; jetzt den Text hochkopieren
  3004. ⓪ spcdo   MOVE.L  ptrEnd,A0
  3005. ⓪(MOVE.L  BufferL,A1
  3006. ⓪(SUBQ.L  #2,A1
  3007. ⓪(MOVE.L  A0,D0
  3008. ⓪(SUB.L   ptrStart,D0
  3009. ⓪(MOVE.L  D0,D2
  3010. ⓪(MOVE.L  A1,A2
  3011. ⓪(SUBA.L  D0,A2
  3012. ⓪(ADDQ.L  #1,A0
  3013. ⓪(ADDQ.L  #1,A1
  3014. ⓪(SWAP    D0
  3015. ⓪ spcdom1 SWAP    D0
  3016. ⓪ spcdomv MOVE.B  -(A0),-(A1)
  3017. ⓪(DBF     D0,spcdomv
  3018. ⓪(SWAP    D0
  3019. ⓪(DBF     D0,spcdom1
  3020. ⓪(
  3021. ⓪(; zuletzt Zurückkopieren mit Korrektur der Codes
  3022. ⓪(; D2: Anzahl Source-Bytes
  3023. ⓪(; A0: Pufferbeginn (dest)
  3024. ⓪(; A1: Textbeginn (source)
  3025. ⓪(MOVEQ   #0,D3
  3026. ⓪ spcdln  MOVEQ   #DLEoffset,D1
  3027. ⓪(TST.W   D3
  3028. ⓪(BEQ     spcdcnt
  3029. ⓪(LEA     -1(A0,D3.W),A0
  3030. ⓪(MOVE.B  #$0D,(A0)+
  3031. ⓪(MOVEQ   #0,D3
  3032. ⓪ spcdcnt CMPI.B  #' ',(A1)
  3033. ⓪(BNE     spcdmo
  3034. ⓪(ADDQ.L  #1,A1
  3035. ⓪(ADDQ.B  #1,D1
  3036. ⓪(SUBQ.L  #1,D2
  3037. ⓪(BRA     spcdcnt
  3038. ⓪ spcdmo  CMPI.B  #DLEchar,(A1)
  3039. ⓪(BNE     spcdle
  3040. ⓪(SUBQ.L  #2,D2
  3041. ⓪(MOVEQ   #0,D3
  3042. ⓪(ADDQ.L  #1,A1
  3043. ⓪(MOVE.B  (A1)+,D0
  3044. ⓪(SUBI.B  #DLEoffset,D0
  3045. ⓪(BLE     spcdle
  3046. ⓪(ADD.B   D0,D1
  3047. ⓪ spcdle  MOVE.B  #DLEchar,(A0)+
  3048. ⓪(MOVE.B  D1,(A0)+
  3049. ⓪ spcnex  SUBQ.L  #1,D2
  3050. ⓪(MOVE.B  (A1)+,D0
  3051. ⓪(BEQ     spccr
  3052. ⓪(CMPI.B  #$0A,D0
  3053. ⓪(BEQ     iscr
  3054. ⓪(CMPI.B  #$0D,D0
  3055. ⓪(BNE     notCR
  3056. ⓪(CMPI.B  #$0A,(A1)
  3057. ⓪(BNE     isCR
  3058. ⓪(SUBQ.L  #1,D2
  3059. ⓪(ADDQ.L  #1,A1
  3060. ⓪ isCR    MOVEQ   #$0D,D0
  3061. ⓪ notCR   CMPI.B  #$09,D0
  3062. ⓪(BNE     notTAB
  3063. ⓪(MOVEQ   #'§',D0
  3064. ⓪ notTAB  MOVE.B  D0,(A0)+
  3065. ⓪(CMPI.B  #$0D,D0
  3066. ⓪(BEQ     spcdlx
  3067. ⓪(CMPI.B  #' ',D0
  3068. ⓪(BNE     spctr
  3069. ⓪(SUBQ.W  #1,D3
  3070. ⓪(BRA     spccr
  3071. ⓪ spctr   MOVEQ   #0,D3
  3072. ⓪ spccr   TST.L   D2
  3073. ⓪(BGE     spcnex
  3074. ⓪(TST.W   D3
  3075. ⓪(BEQ     spce0
  3076. ⓪(LEA     0(A0,D3.W),A0
  3077. ⓪(BRA     spce0
  3078. ⓪ spcdx   TST.W   D3
  3079. ⓪(BEQ     spce0
  3080. ⓪(LEA     -1(A0,D3.W),A0
  3081. ⓪(MOVE.B  #$0D,(A0)+
  3082. ⓪(MOVEQ   #0,D3
  3083. ⓪ spce0   CLR.B   (A0)+
  3084. ⓪(CLR.B   (A0)+
  3085. ⓪(MOVE.L  A0,ptrEnd
  3086. ⓪(CLR.B   (A0)+
  3087. ⓪(CLR.B   (A0)+
  3088. ⓪(CLR.B   (A0)+
  3089. ⓪(CLR.B   (A0)+
  3090. ⓪(RTS
  3091. ⓪ spcdlx  TST.L   D2
  3092. ⓪(BGE     spcdln
  3093. ⓪(BRA     spcdx
  3094. ⓪ 
  3095. ⓪(; text speichern: DLE löschen
  3096. ⓪ rmdo    MOVE.L  ptrStart,A1
  3097. ⓪(MOVE.L  A1,A2
  3098. ⓪(MOVE.L  ptrEnd,D2
  3099. ⓪(SUB.L   A1,D2
  3100. ⓪(MOVEQ   #1,D3
  3101. ⓪ rldln   ADDQ.L  #1,A2
  3102. ⓪(MOVE.B  (A1)+,D0
  3103. ⓪(CMPI.B  #DLEchar,D0
  3104. ⓪(BNE     rldld
  3105. ⓪(ADDQ.L  #1,A2
  3106. ⓪(SUBQ.L  #1,D2
  3107. ⓪(MOVEQ   #0,D0
  3108. ⓪(MOVE.B  (A1)+,D0
  3109. ⓪(SUBI.B  #DLEoffset,D0
  3110. ⓪(BPL     ok
  3111. ⓪(MOVEQ   #0,D0
  3112. ⓪ ok      SUBQ.L  #1,D0
  3113. ⓪(SUB.L   D3,D0
  3114. ⓪(CMPA.L  bufferL,A2
  3115. ⓪(BLS     spdmo3
  3116. ⓪(JSR     overflow
  3117. ⓪(JMP     restoretags
  3118. ⓪ spdmo3  MOVE.L  A2,(A3)+
  3119. ⓪(MOVE.L  D0,(A3)+
  3120. ⓪(ADDA.L  D0,A2
  3121. ⓪(MOVEM.L A1/A2,-(A7)
  3122. ⓪(JSR     MoveTags
  3123. ⓪(MOVEM.L (A7)+,A1/A2
  3124. ⓪(MOVEQ   #0,D3
  3125. ⓪ rldld   SUBQ.L  #1,D2
  3126. ⓪(BGE     rldln
  3127. ⓪(; Fertig mit Tag-Korrektur
  3128. ⓪(MOVE.L  ptrEnd,A0
  3129. ⓪(MOVE.L  BufferL,A1
  3130. ⓪(SUBQ.L  #2,A1
  3131. ⓪(MOVE.L  A0,D0
  3132. ⓪(SUB.L   ptrStart,D0
  3133. ⓪(MOVE.L  D0,D2
  3134. ⓪(MOVE.L  A1,A2
  3135. ⓪(SUBA.L  D0,A2
  3136. ⓪(ADDQ.L  #1,A0
  3137. ⓪(ADDQ.L  #1,A1
  3138. ⓪(SWAP    D0
  3139. ⓪ rmdom1  SWAP    D0
  3140. ⓪ rmdomv  MOVE.B  -(A0),-(A1)
  3141. ⓪(DBF     D0,rmdomv
  3142. ⓪(SWAP    D0
  3143. ⓪(DBF     D0,rmdom1
  3144. ⓪ rmdln   MOVE.B  (A1)+,D0
  3145. ⓪(CMPI.B  #$0D,D0
  3146. ⓪(BNE     notCR2
  3147. ⓪(MOVE.B  D0,(A0)+
  3148. ⓪(MOVEQ   #$0A,D0
  3149. ⓪ notCR2  CMPI.B  #DLEchar,D0
  3150. ⓪(BEQ     rmdcnt
  3151. ⓪(MOVE.B  D0,(A0)+
  3152. ⓪ rmdld   SUBQ.L  #1,D2
  3153. ⓪(BGE     rmdln
  3154. ⓪ rmdx    SUBQ.L  #1,A0
  3155. ⓪(MOVE.L  A0,ptrEnd
  3156. ⓪ rmex    RTS
  3157. ⓪ rmdcnt  MOVE.B  (A1)+,D0
  3158. ⓪(SUBQ.L  #1,D2
  3159. ⓪(SUBI.B  #DLEoffset,D0
  3160. ⓪ rmdspc  BLE     rmdld
  3161. ⓪(MOVE.B  #' ',(A0)+
  3162. ⓪(SUBQ.B  #1,D0
  3163. ⓪(BRA     rmdspc
  3164. ⓪ END
  3165. ⓪ END CleanText;
  3166. ⓪ 
  3167. ⓪ (*$l+*)
  3168. ⓪ PROCEDURE WriteText: BOOLEAN;
  3169. ⓪"VAR oldend: POINTER TO CHAR; blockAnz, lastInBl, ioerr : Cardinal;
  3170. ⓪&oldch: CHAR;
  3171. ⓪ BEGIN
  3172. ⓪"IF saveinfo THEN
  3173. ⓪$tags['=']:= ptrEnd;
  3174. ⓪$tags[';']:= ptr;
  3175. ⓪"END;
  3176. ⓪"IF makeDLE & NOT leaveDLEonWrite THEN
  3177. ⓪$makeDLE := False; Cleantext
  3178. ⓪"END;
  3179. ⓪"oldend:= ptrend-2L;
  3180. ⓪"oldch:= oldend^;
  3181. ⓪"oldend^:= CHR (26); (* Ctrl-Z *)
  3182. ⓪"IF saveinfo THEN
  3183. ⓪$INC (ptrend);
  3184. ⓪$IF odd (ptrend-ptrstart) THEN
  3185. ⓪&inc (ptrend)
  3186. ⓪$END;
  3187. ⓪"END;
  3188. ⓪"WriteBytes (f,ptrStart,ptrend-ptrstart-2L);
  3189. ⓪"oldend^:= oldch;
  3190. ⓪"ptrend:= ADDRESS (oldend)+2L;
  3191. ⓪"IOResult := State (f);
  3192. ⓪"IF saveinfo & (ioresult >= 0) THEN
  3193. ⓪$PutInfo;
  3194. ⓪$WriteBytes (f,adr(infobuffer),long(infoLen));
  3195. ⓪$IOResult := State (f);
  3196. ⓪"END;
  3197. ⓪"tags['=']:= ptrStart;
  3198. ⓪"tags[';']:= ptrStart;
  3199. ⓪"ResetState(f);
  3200. ⓪"Close(f);
  3201. ⓪"ioerr := State (f);
  3202. ⓪"IF SuccessFull(1) THEN
  3203. ⓪$IOResult := ioerr;
  3204. ⓪$IF SuccessFull(3) THEN
  3205. ⓪&saved:=true;
  3206. ⓪&RETURN true
  3207. ⓪$END
  3208. ⓪"END;
  3209. ⓪"RETURN false
  3210. ⓪ END WriteText;
  3211. ⓪ 
  3212. ⓪ VAR fullDate: Date; fullTime: Time;
  3213. ⓪ 
  3214. ⓪ PROCEDURE GetDT;
  3215. ⓪"BEGIN
  3216. ⓪$GetDateTime (f, fullDate, fullTime);
  3217. ⓪$fileD:= PackDate (fullDate);
  3218. ⓪$fileT:= PackTime (fullTime)
  3219. ⓪"END GetDT;
  3220. ⓪ 
  3221. ⓪ (*$l+*)
  3222. ⓪ PROCEDURE SaveText(VAR fn:STRING; sBack, sWarn, keepTime:BOOLEAN):BOOLEAN;
  3223. ⓪"VAR createTime, createDate:CARDINAL; gotOld:BOOLEAN; bp, be, bf:STRING;
  3224. ⓪ BEGIN
  3225. ⓪"IF autoIncVer & NOT saved & NOT restoreFileDT THEN
  3226. ⓪$WriteString (IncrementVersion())
  3227. ⓪"END;
  3228. ⓪"WriteLn;
  3229. ⓪"Open (f,fn,readonly);
  3230. ⓪"IOResult := State(f);
  3231. ⓪"gotOld:=IOResult>=0;
  3232. ⓪"IF gotOld THEN
  3233. ⓪$Close (f);
  3234. ⓪$IF sWarn THEN
  3235. ⓪&WriteString('File already exists. Overwrite it?');
  3236. ⓪&IF NOT Yes() THEN RETURN false END;
  3237. ⓪&WriteLn
  3238. ⓪$END;
  3239. ⓪$IF sBack OR autoBack THEN
  3240. ⓪&WriteString('Backing up...');WriteLn;
  3241. ⓪&bf:=fn;
  3242. ⓪&SplitPath (bf, bf, bp);
  3243. ⓪&SplitName (bp, bp, be);
  3244. ⓪&Append (bp, bf, strok);
  3245. ⓪&Append('.BAK',bf,strok);
  3246. ⓪&ioresult:= FDelete (ADR(bf));
  3247. ⓪&ioresult:= Rename (ADR(fn),ADR(bf));
  3248. ⓪&IF NOT SuccessFull(7) THEN RETURN false END
  3249. ⓪$END;
  3250. ⓪$ioresult:= FDelete (ADR(fn));
  3251. ⓪"END;
  3252. ⓪"Create (f,fn,writeonly,noreplace);
  3253. ⓪"IOResult := State (f);
  3254. ⓪"IF SuccessFull(9) THEN
  3255. ⓪$WriteString('Writing ');WriteString(fn); WriteLn;
  3256. ⓪$IF WriteText () THEN
  3257. ⓪&Open (f,fn,readonly);
  3258. ⓪&IF restoreFileDT OR keepTime THEN
  3259. ⓪(fullDate:= UnpackDate (fileD);
  3260. ⓪(fullTime:= UnpackTime (fileT);
  3261. ⓪(SetDateTime (f, fullDate, fullTime);
  3262. ⓪&ELSE
  3263. ⓪(GetDT
  3264. ⓪&END;
  3265. ⓪&Close (f);
  3266. ⓪&RETURN TRUE
  3267. ⓪$ELSE
  3268. ⓪&IF sBack OR autoBack THEN
  3269. ⓪(ioresult:= FDelete (ADR(fn));
  3270. ⓪(ioresult:= Rename (ADR(bf),ADR(fn));
  3271. ⓪&END;
  3272. ⓪$END
  3273. ⓪"END;
  3274. ⓪"RETURN false
  3275. ⓪ END SaveText;
  3276. ⓪ 
  3277. ⓪ (*$l-*)
  3278. ⓪ PROCEDURE GetInfo;      (* Marker usw. aus infoBlock holen *)
  3279. ⓪ BEGIN
  3280. ⓪ ASSEMBLER
  3281. ⓪(movem.l a0/A1/d0/d1/d2/d3/d4/d5/d6,-(a7)
  3282. ⓪(CLR     saveinfo
  3283. ⓪(clr     leaveDLEonWrite   ; damit ReadText nix falsch macht
  3284. ⓪(BRA     cont
  3285. ⓪(
  3286. ⓪ getlcard
  3287. ⓪(move.l  a1,-(a7)
  3288. ⓪(lea     printline,a1
  3289. ⓪(move.l  a1,(a3)+
  3290. ⓪(moveq   #8,D3
  3291. ⓪(move    d3,(a3)+
  3292. ⓪ copstr  move.b  (a0)+,(a1)+
  3293. ⓪(dbra    d3,copstr
  3294. ⓪(clr.b   (a1)
  3295. ⓪(clr.w   -(a7)
  3296. ⓪(move.l  a7,(a3)+
  3297. ⓪(clr.w   -(a7)
  3298. ⓪(move.l  a7,(a3)+
  3299. ⓪(movem.l d0/d1/a0/a2,-(a7)
  3300. ⓪(jsr     strtolcard
  3301. ⓪(movem.l (a7)+,d0/d1/a0/a2
  3302. ⓪(addq.l  #4,a7
  3303. ⓪(move.l  (a7)+,a1
  3304. ⓪(move.l  -(a3),d2
  3305. ⓪(rts
  3306. ⓪(
  3307. ⓪ cont    LEA     -infoLen(A2),A0
  3308. ⓪(CMPA.L  ptrStart,A0
  3309. ⓪(BLS.W   noget
  3310. ⓪(MOVE.L  A0,D0
  3311. ⓪(CMPI.B  #$0D,(A0)+
  3312. ⓪(BNE.L   noget
  3313. ⓪(CMPI.B  #$0A,(A0)+
  3314. ⓪(BNE.L   noget
  3315. ⓪(CMPI.B  #'(',(A0)+
  3316. ⓪(BNE.L   noget
  3317. ⓪(CMPI.B  #'*',(A0)+
  3318. ⓪(BNE.L   noget
  3319. ⓪(CMPI.B  #' ',(A0)+
  3320. ⓪(BNE.L   noget
  3321. ⓪(
  3322. ⓪(MOVE.L  D0,A2
  3323. ⓪(
  3324. ⓪((*
  3325. ⓪*MOVE.L  ptrStart,A1
  3326. ⓪*CMPI.B  #DLEchar,(a1)
  3327. ⓪*BNE.W   noget           ; Es ist eine Info da, aber wir ignorieren sie
  3328. ⓪(*)
  3329. ⓪(
  3330. ⓪(; Die tags werden erstmal in einen Kopierpuffer geladen und erst
  3331. ⓪(; am Ende, wenn sicher ist, daß die Infoline noch aktuell ist,
  3332. ⓪(; per restoreTags in den richtigen Puffer übertragen.
  3333. ⓪(
  3334. ⓪(lea     svs2,A1
  3335. ⓪(move.l  ptrStart,d1
  3336. ⓪(moveq   #41,d0
  3337. ⓪ coptag  bsr     getlcard
  3338. ⓪(add.l   d1,d2
  3339. ⓪(move.l  d2,(A1)+
  3340. ⓪(dbf     d0,coptag
  3341. ⓪(
  3342. ⓪(move.b  (a0)+,d0
  3343. ⓪(andi    #1,d0
  3344. ⓪(move    d0,findCase
  3345. ⓪(
  3346. ⓪(bsr     getlcard
  3347. ⓪(add.l   d1,d2
  3348. ⓪(move.l  d2,svlptr
  3349. ⓪(
  3350. ⓪(moveq   #79,d0
  3351. ⓪ coptab  move.b  (a0)+,(a3)+
  3352. ⓪(dbf     d0,coptab
  3353. ⓪(clr.w   (a3)+
  3354. ⓪(movem.l d0-d2/a0-A2,-(a7)
  3355. ⓪(jsr     gettabs
  3356. ⓪(movem.l (a7)+,d0-d2/a0-A2
  3357. ⓪(
  3358. ⓪(lea     saveStack,A1
  3359. ⓪(moveq   #15,d0
  3360. ⓪ ctag2   bsr     getlcard
  3361. ⓪(add.l   d1,d2
  3362. ⓪(move.l  d2,(A1)+
  3363. ⓪(dbf     d0,ctag2
  3364. ⓪(
  3365. ⓪(move.b  (a0)+,d0
  3366. ⓪(andi    #$3C,d0
  3367. ⓪(move    d0,ptrCount
  3368. ⓪(
  3369. ⓪(move.b  (a0)+,d0
  3370. ⓪(andi    #1,d0
  3371. ⓪(move    d0,autoBack
  3372. ⓪(
  3373. ⓪(move.b  (a0)+,d0
  3374. ⓪(move    d0,d1
  3375. ⓪(andi    #1,d0
  3376. ⓪(move    d0,autoIncVer
  3377. ⓪(lsr     #1,d1
  3378. ⓪(andi    #1,d1
  3379. ⓪(move    d1,leaveDLEonWrite
  3380. ⓪(
  3381. ⓪(; Konsistenzprüfung der Infoline:
  3382. ⓪(; tags['='] muß identisch mit ptrEnd sein
  3383. ⓪ 
  3384. ⓪(MOVE    #1,saveinfo
  3385. ⓪ 
  3386. ⓪ noGet   movem.l (a7)+,a0/A1/d0/d1/d2/d3/d4/d5/d6
  3387. ⓪ END
  3388. ⓪ END GetInfo;
  3389. ⓪ 
  3390. ⓪ (*$l-*)
  3391. ⓪ PROCEDURE GetFile;     (* file laden *)
  3392. ⓪ BEGIN
  3393. ⓪"ASSEMBLER
  3394. ⓪.move.l  flen,d0
  3395. ⓪.move.l  d0,d5
  3396. ⓪.add.l   A2,d0
  3397. ⓪.move.l  d0,d6             ;VORRAUSSICHTLICHES TEXTENDE
  3398. ⓪.tst.l   d5
  3399. ⓪.beq     nullget
  3400. ⓪.addi.l  #$100,d0
  3401. ⓪.cmp.l   hilf,d0
  3402. ⓪.blt     blockok
  3403. ⓪.jsr     Overflow
  3404. ⓪.move    #-1,ioresult
  3405. ⓪.bra.w   lesende
  3406. ⓪"blockok     MOVE.L  f,(A3)+
  3407. ⓪.MOVE.L  A2,(A3)+
  3408. ⓪.MOVE.L  D5,(A3)+
  3409. ⓪.clr.l   -(a7)
  3410. ⓪.move.l  a7,(a3)+
  3411. ⓪.movem.l A1/A2/d0/d1/d2,-(a7)
  3412. ⓪.JSR     ReadBytes
  3413. ⓪.MOVE.L  f,(A3)+
  3414. ⓪.JSR     State
  3415. ⓪.MOVE    -(A3),IOResult
  3416. ⓪.move    #11,(a3)+
  3417. ⓪.jsr     SuccessFull
  3418. ⓪.movem.l (a7)+,A1/A2/d0/d1/d2
  3419. ⓪.addq.l  #4,a7
  3420. ⓪ 
  3421. ⓪.tst     -(a3)
  3422. ⓪.beq.S   lesende
  3423. ⓪ 
  3424. ⓪+nullget
  3425. ⓪.movea.l d6,A1
  3426. ⓪.clr.b   (A1)
  3427. ⓪.move.l  A1,A2
  3428. ⓪.
  3429. ⓪"lesende     move.l  A2,-(a7)
  3430. ⓪"END;
  3431. ⓪"IF State (f) >= 0 THEN
  3432. ⓪$GetDT;
  3433. ⓪"END;
  3434. ⓪"ResetState(f);
  3435. ⓪"Close(f);
  3436. ⓪"ASSEMBLER     movea.l (a7)+,A2
  3437. ⓪"END
  3438. ⓪ END GetFile;
  3439. ⓪ 
  3440. ⓪ (*$l-*)
  3441. ⓪ PROCEDURE ReadText;     (* File von Diskette laden und aufbereiten *)
  3442. ⓪ BEGIN                   (* alle Text-Pointer setzen *)
  3443. ⓪ ASSEMBLER
  3444. ⓪(clr.w   saveinfo
  3445. ⓪(move.l  bufferL,hilf
  3446. ⓪(move.l  ptrStart,A2     ;ZEIGER LESEN
  3447. ⓪(move.l  A2,ptr
  3448. ⓪(move.l  a2,-(a7)
  3449. ⓪(jsr     ResetTextOptions
  3450. ⓪(move.l  (a7)+,a2
  3451. ⓪(jsr     GetFile
  3452. ⓪(tst     IOResult
  3453. ⓪(bmi.w   noload
  3454. ⓪(TST.L   D5
  3455. ⓪(; BEQ.W   noload
  3456. ⓪(beq     skipeot
  3457. ⓪(jsr     getinfo
  3458. ⓪ look40  move.b  -(a2),d0
  3459. ⓪(beq     look40
  3460. ⓪(cmpi.b  #26,d0          ; ctrl-z
  3461. ⓪(beq     skipeot
  3462. ⓪(addq.l  #1,a2
  3463. ⓪ skipeot clr.b   (A2)+
  3464. ⓪(clr.b   (A2)+
  3465. ⓪(move.l  A2,ptrEnd
  3466. ⓪(TST.W   saveinfo
  3467. ⓪(BEQ     noinfo
  3468. ⓪(lea     svs2,a1         ; Kopie v. 'tags'
  3469. ⓪(cmpa.l  $34(a1),a2      ; tags['='] = ptrEnd?
  3470. ⓪(beq     infook
  3471. ⓪(move.l  $34(a1),d0      ; tags['='] überhaupt definiert?
  3472. ⓪(MOVE.L  ptrStart,A1
  3473. ⓪(cmp.l   a1,d0
  3474. ⓪(bcs     chkold          ; nein -> auf DLE prüfen
  3475. ⓪(cmp.l   a2,d0           ; (A2=ptrEnd)
  3476. ⓪(bcs     noinfo          ; ja -> info nicht mehr gültig
  3477. ⓪ chkold  CMPI.B  #DLEchar,(a1)
  3478. ⓪(bne     noinfo          ; bei alten Texten ist DLE das Kriterium
  3479. ⓪ infook  MOVE.W  #1,saveinfo
  3480. ⓪(JSR     restoreTags
  3481. ⓪(bra     info0
  3482. ⓪ noinfo  CLR.W   saveinfo
  3483. ⓪ info0   clr.b   (A2)+
  3484. ⓪(clr.b   (A2)+
  3485. ⓪(clr.b   (A2)+
  3486. ⓪(clr.b   (A2)+
  3487. ⓪(move    #1,saved
  3488. ⓪(move.l  ptrStart,d1
  3489. ⓪(tst     errorNr
  3490. ⓪(beq     nomark
  3491. ⓪(clr     errorNr
  3492. ⓪(move.l  errorpos,d0
  3493. ⓪(beq     nomark
  3494. ⓪(add.l   d1,d0
  3495. ⓪(lea     tags,A1
  3496. ⓪(move.l  d0,$3C(A1)      ; tags['?'] setzen
  3497. ⓪ nomark  lea     tabs,a0
  3498. ⓪(cmpi.b  #80,(a0)
  3499. ⓪(bne     noload
  3500. ⓪(moveq   #39,d0
  3501. ⓪ cptab   move    (a0)+,(a3)+
  3502. ⓪(dbf     d0,cptab
  3503. ⓪(clr.w   (a3)+
  3504. ⓪(jsr     GetTabs
  3505. ⓪ noload  jsr     CountTabs
  3506. ⓪(tst     leaveDLEonWrite
  3507. ⓪(bne     noclean         ; Text wurde mit DLEs gespeichert
  3508. ⓪(jsr     Cleantext
  3509. ⓪ noclean
  3510. ⓪ END
  3511. ⓪ END ReadText;
  3512. ⓪ 
  3513. ⓪ 
  3514. ⓪ 
  3515. ⓪ (*$l-*)
  3516. ⓪ PROCEDURE Page(dir: BOOLEAN);   (* 20*Repeatfactor Zeilen vor/zurⁿck *)
  3517. ⓪ BEGIN
  3518. ⓪ ClrKBDbuffer;
  3519. ⓪ ASSEMBLER
  3520. ⓪(move.l ptr,a0
  3521. ⓪(move.l a0,scrPtr
  3522. ⓪(jsr    RptfOK   ; liefert rptf in D0
  3523. ⓪(move.l d0,d5
  3524. ⓪(; umrechnen in Zeilenanzahl
  3525. ⓪(move.l d5,d0
  3526. ⓪(asl.l  #2,d0  ; Zeilen := rptf * 20
  3527. ⓪(add.l  d0,d5
  3528. ⓪(asl.l  #2,d5
  3529. ⓪(lea    NextCR,A1
  3530. ⓪(tst    -(a3)
  3531. ⓪(beq    pbild
  3532. ⓪(lea    LastCR,A1
  3533. ⓪ pbild   jsr    (A1)
  3534. ⓪(bne    nokor1   ; end of text
  3535. ⓪(subq.l #1,d5
  3536. ⓪(bgt    pbild
  3537. ⓪ nokor1  jsr    LineSt
  3538. ⓪(clr.l  rptf
  3539. ⓪(move.l a0,ptr
  3540. ⓪(move.l #ScreenOut,(a3)+
  3541. ⓪(jmp    CondScreen
  3542. ⓪ END
  3543. ⓪ END Page;
  3544. ⓪"
  3545. ⓪ (*$l-*)
  3546. ⓪ PROCEDURE Down;         (* eine Zeile runter *)
  3547. ⓪ BEGIN
  3548. ⓪ ASSEMBLER
  3549. ⓪*clr    forceTab
  3550. ⓪*move.l ptr,a0
  3551. ⓪ cr1       move.b (a0)+,d0
  3552. ⓪*beq    Downrt
  3553. ⓪*cmpi.b #CRchar,d0
  3554. ⓪*bne    cr1
  3555. ⓪*move.b ptrX,hilf
  3556. ⓪*jsr    WriteLn
  3557. ⓪*move   ptrLine,d0
  3558. ⓪*addq   #1,d0
  3559. ⓪*move   d0,ptrLine
  3560. ⓪*cmp    maxLine,d0
  3561. ⓪*ble    crzanflf
  3562. ⓪*move   maxLine,ptrLine
  3563. ⓪*move.l a0,-(a7)
  3564. ⓪*clr    cmdFlag
  3565. ⓪*jsr    LineOut
  3566. ⓪*move.l (a7)+,a0
  3567. ⓪ crzanflf  move   ptrY,d1
  3568. ⓪*move.b ptrX,d1
  3569. ⓪*moveq  #0,d0
  3570. ⓪*move.b ch,d0
  3571. ⓪*clr.b  d1
  3572. ⓪*tst    delFlag
  3573. ⓪*bne    crzanf1
  3574. ⓪*cmpi   #downKey,d0
  3575. ⓪*bne    crzanf1
  3576. ⓪*move.b hilf,d1
  3577. ⓪ crzanf1   jmp    FindCursor
  3578. ⓪ Downrt    move   #1,forceTab
  3579. ⓪ END
  3580. ⓪ END Down;
  3581. ⓪ 
  3582. ⓪ (*$l-*)
  3583. ⓪ PROCEDURE UpNoCursor;           (* eine Zeile rauf *)
  3584. ⓪ BEGIN
  3585. ⓪ ASSEMBLER
  3586. ⓪(clr     forceTab
  3587. ⓪(move.l  ptr,a0
  3588. ⓪(jsr     LineSt
  3589. ⓪(tst.b   -1(a0)
  3590. ⓪(beq     uprt
  3591. ⓪(jsr     LastCR
  3592. ⓪(jsr     LineSt
  3593. ⓪(cmpi    #1,ptrLine
  3594. ⓪(bhi     up1
  3595. ⓪(clr     cmdflag
  3596. ⓪(moveq   #HomeChar,d0
  3597. ⓪(jsr     ChrOut
  3598. ⓪(moveq   #ClrLnChar,D0
  3599. ⓪(jsr     ChrOut
  3600. ⓪(moveq   #UpChar,D0
  3601. ⓪(jsr     ChrOut
  3602. ⓪(moveq   #DownChar,D0
  3603. ⓪(jsr     ChrOut
  3604. ⓪(movem.l d0/a0,-(a7)
  3605. ⓪(jsr     LineOut
  3606. ⓪(movem.l (a7)+,d0/a0
  3607. ⓪(rts
  3608. ⓪ up1     subq.b  #1,ptrY
  3609. ⓪(subq    #1,ptrLine
  3610. ⓪(rts
  3611. ⓪ uprt    move    #1,forceTab
  3612. ⓪ END
  3613. ⓪ END UpNoCursor;
  3614. ⓪ 
  3615. ⓪ (*$l-*)
  3616. ⓪ PROCEDURE Up;           (* eine Zeile rauf *)
  3617. ⓪ BEGIN
  3618. ⓪ ASSEMBLER
  3619. ⓪(clr     forceTab
  3620. ⓪(move.l  ptr,a0
  3621. ⓪(jsr     LineSt
  3622. ⓪(tst.b   -1(a0)
  3623. ⓪(beq.l   uprt
  3624. ⓪(jsr     LastCR
  3625. ⓪(jsr     LineSt
  3626. ⓪(cmpi    #1,ptrLine
  3627. ⓪(bhi     up1
  3628. ⓪(move    ptrX,-(a7)
  3629. ⓪(clr     cmdflag
  3630. ⓪(moveq   #HomeChar,d0
  3631. ⓪(jsr     ChrOut
  3632. ⓪(moveq   #ClrLnChar,D0
  3633. ⓪(jsr     ChrOut
  3634. ⓪(moveq   #UpChar,D0
  3635. ⓪(jsr     ChrOut
  3636. ⓪(moveq   #DownChar,D0
  3637. ⓪(jsr     ChrOut
  3638. ⓪(movem.l d0/a0,-(a7)
  3639. ⓪(jsr     LineOut
  3640. ⓪(movem.l (a7)+,d0/a0
  3641. ⓪(move    (a7)+,ptrX
  3642. ⓪(bra     up2
  3643. ⓪ up1     subq.b  #1,ptrY
  3644. ⓪(subq    #1,ptrLine
  3645. ⓪ up2     move    ptrY,d1
  3646. ⓪(clr.b   d1
  3647. ⓪(cmpi.b  #CRchar,ch
  3648. ⓪(beq     upzanf
  3649. ⓪(move.b  ptrX,d1
  3650. ⓪ upzanf  jmp     FindCursor
  3651. ⓪ uprt    move    #1,forceTab
  3652. ⓪ END
  3653. ⓪ END Up;
  3654. ⓪ 
  3655. ⓪ (*$l-*)
  3656. ⓪ PROCEDURE ScrollUp;
  3657. ⓪"BEGIN
  3658. ⓪$ASSEMBLER
  3659. ⓪*clr    forceTab
  3660. ⓪*move.l ptr,a0
  3661. ⓪ cr1       move.b (a0)+,d0
  3662. ⓪*beq.w  Downrt
  3663. ⓪*cmpi.b #CRchar,d0
  3664. ⓪*bne    cr1
  3665. ⓪*
  3666. ⓪*; prüfen, ob noch /ptrLine/ Zeilen darunter sind
  3667. ⓪*move.l  a0,temp
  3668. ⓪*move    maxline,d1
  3669. ⓪*sub     ptrline,d1
  3670. ⓪*cmp     d1,d1
  3671. ⓪*bra     con1
  3672. ⓪ lup1      jsr     nextcr
  3673. ⓪ con1      dbne    d1,lup1
  3674. ⓪*bne.w   downrt
  3675. ⓪*
  3676. ⓪*; jsr     lastcr
  3677. ⓪*; jsr     LineSt
  3678. ⓪*move   ptrY,d1
  3679. ⓪*move.b ptrX,d1
  3680. ⓪*move   d1,-(a7)
  3681. ⓪*move   ptrLine,-(a7)
  3682. ⓪*move   maxLine,ptrLine
  3683. ⓪*move   maxLine,D1
  3684. ⓪*lsl    #8,d1
  3685. ⓪*jsr    gotoxyd1       ; auf letzte Zeile springen
  3686. ⓪*jsr    writeln
  3687. ⓪*clr    cmdFlag
  3688. ⓪*jsr    LineOut
  3689. ⓪*move.l temp,a0
  3690. ⓪*move   (a7)+,ptrLine
  3691. ⓪*move   (a7)+,d1
  3692. ⓪*jmp    FindCursor
  3693. ⓪ Downrt    move   #1,forceTab
  3694. ⓪$END
  3695. ⓪"END ScrollUp;
  3696. ⓪ 
  3697. ⓪ (*$l-*)
  3698. ⓪ PROCEDURE ScrollDown;
  3699. ⓪"BEGIN
  3700. ⓪$ASSEMBLER
  3701. ⓪(clr     forceTab
  3702. ⓪(move.l  ptr,a0
  3703. ⓪(jsr     LineSt
  3704. ⓪(tst.b   -1(a0)
  3705. ⓪(beq.l   uprt
  3706. ⓪(jsr     LastCR
  3707. ⓪(jsr     LineSt
  3708. ⓪ 
  3709. ⓪(; prüfen, ob noch /ptrLine/ Zeilen darüber sind
  3710. ⓪(move.l  a0,temp
  3711. ⓪(move    ptrline,d1
  3712. ⓪(subq    #1,d1
  3713. ⓪(cmp     d1,d1
  3714. ⓪(bra     con1
  3715. ⓪ lup1    jsr     lastcr
  3716. ⓪ con1    dbne    d1,lup1
  3717. ⓪(bne.w   uprt
  3718. ⓪ 
  3719. ⓪(jsr     LineSt
  3720. ⓪(move    ptrY,d1
  3721. ⓪(move.b  ptrX,d1
  3722. ⓪(move    d1,-(a7)
  3723. ⓪(moveq   #HomeChar,d0
  3724. ⓪(jsr     ChrOut
  3725. ⓪(moveq   #ClrLnChar,D0
  3726. ⓪(jsr     ChrOut
  3727. ⓪(moveq   #UpChar,D0
  3728. ⓪(jsr     ChrOut
  3729. ⓪(move   #$0100,D1
  3730. ⓪(jsr    gotoxyd1
  3731. ⓪(move   ptrLine,-(a7)
  3732. ⓪(move   #1,ptrLine
  3733. ⓪(clr    cmdFlag
  3734. ⓪(jsr    LineOut
  3735. ⓪(move.l temp,a0
  3736. ⓪(move   (a7)+,ptrLine
  3737. ⓪(move   (a7)+,d1
  3738. ⓪(jmp     FindCursor
  3739. ⓪ uprt    move    #1,forceTab
  3740. ⓪$END
  3741. ⓪"END ScrollDown;
  3742. ⓪ 
  3743. ⓪ (*$l-*)
  3744. ⓪ PROCEDURE Right;        (* ein Zeichen nach rechts *)
  3745. ⓪ BEGIN
  3746. ⓪ ASSEMBLER
  3747. ⓪(clr    forceTab
  3748. ⓪(move.l ptr,a0
  3749. ⓪ again   move.b (a0)+,d0
  3750. ⓪(beq    force
  3751. ⓪(cmpi.b #CRchar,d0
  3752. ⓪(beq    rcr
  3753. ⓪(cmpi.b #$20,d0
  3754. ⓪(bcs    again
  3755. ⓪(move.l a0,ptr
  3756. ⓪(move   ptrY,d1
  3757. ⓪(move.b ptrX,d1
  3758. ⓪(cmp.b  maxCol,d1
  3759. ⓪(beq    force
  3760. ⓪(addq.b #1,d1
  3761. ⓪(jmp    GotoXYd1
  3762. ⓪ rcr     jmp    Down
  3763. ⓪ force   move   #1,forceTab
  3764. ⓪ END
  3765. ⓪ END Right;
  3766. ⓪ 
  3767. ⓪ 
  3768. ⓪ (*$l-*)
  3769. ⓪ PROCEDURE GotoEOLN;
  3770. ⓪ BEGIN
  3771. ⓪ ASSEMBLER
  3772. ⓪ goright move.l  ptr,a0
  3773. ⓪(move.b  (a0),d0
  3774. ⓪(beq     xit
  3775. ⓪(cmpi.b  #CRchar,d0
  3776. ⓪(beq     xit
  3777. ⓪(jsr     Right
  3778. ⓪(bra     goright
  3779. ⓪ xit
  3780. ⓪ END
  3781. ⓪ END GotoEOLN;
  3782. ⓪ 
  3783. ⓪ (*$l-*)
  3784. ⓪ PROCEDURE WordRight;    (* ein Wort nach rechts *)
  3785. ⓪ BEGIN
  3786. ⓪ ASSEMBLER
  3787. ⓪(move.l  ptr,a0
  3788. ⓪(move.b  (a0),d0
  3789. ⓪(jsr     alphanum
  3790. ⓪(bne     lp2
  3791. ⓪ lp1     jsr     Right
  3792. ⓪(tst     forceTab
  3793. ⓪(bne     wrout
  3794. ⓪(move.l  ptr,a0
  3795. ⓪(move.b  (a0),d0
  3796. ⓪(jsr     AlphaNum
  3797. ⓪(beq     lp1
  3798. ⓪ lp2     jsr     Right
  3799. ⓪(tst     forceTab
  3800. ⓪(bne     wrout
  3801. ⓪(move.l  ptr,a0
  3802. ⓪(move.b  (a0),d0
  3803. ⓪(jsr     AlphaNum
  3804. ⓪(bne     lp2
  3805. ⓪ wrout
  3806. ⓪ END
  3807. ⓪ END WordRight;
  3808. ⓪ 
  3809. ⓪ (*$l-*)
  3810. ⓪ PROCEDURE Left;         (* ein Zeichen nach links *)
  3811. ⓪ BEGIN
  3812. ⓪ ASSEMBLER
  3813. ⓪(clr    forceTab
  3814. ⓪(move.l ptr,a0
  3815. ⓪ again   move.b -(a0),d0
  3816. ⓪(beq    leftrt
  3817. ⓪(cmpi.b #CRchar,d0
  3818. ⓪(beq    crback
  3819. ⓪(cmpi.b #DLEchar,-1(a0)
  3820. ⓪(bne    delit
  3821. ⓪(tst.b  -2(a0)
  3822. ⓪(beq    leftrt
  3823. ⓪(bra    crback
  3824. ⓪ delit   cmpi.b #$20,d0
  3825. ⓪(bcs    again
  3826. ⓪(jsr    LineSt
  3827. ⓪(move   ptrY,d1
  3828. ⓪(move.b ptrX,d1
  3829. ⓪(subq.b #1,d1
  3830. ⓪(jmp    FindCursor
  3831. ⓪(move.l a0,ptr
  3832. ⓪(moveq  #LeftChar,d0
  3833. ⓪(jmp    ChrOut
  3834. ⓪ crback  jsr    UpNoCursor
  3835. ⓪(jsr    LineSt
  3836. ⓪(move   ptrY,d1
  3837. ⓪(move.b maxCol,d1
  3838. ⓪(jmp    FindCursor
  3839. ⓪ leftrt  move   #1,forceTab
  3840. ⓪ END
  3841. ⓪ END Left;
  3842. ⓪ 
  3843. ⓪ (*$l-*)
  3844. ⓪ PROCEDURE OnSOLn (): BOOLEAN;
  3845. ⓪ BEGIN
  3846. ⓪ ASSEMBLER
  3847. ⓪(moveq   #1,d0
  3848. ⓪(move.l  ptr,a0
  3849. ⓪(cmpi.b  #CRchar,-1(a0)
  3850. ⓪(beq     xit
  3851. ⓪(cmpi.b  #dlechar,-2(a0)
  3852. ⓪(beq     xit
  3853. ⓪(clr     d0
  3854. ⓪ xit     move    d0,(a3)+
  3855. ⓪ END
  3856. ⓪ END OnSOLn;
  3857. ⓪ 
  3858. ⓪ (*$l-*)
  3859. ⓪ PROCEDURE GotoSOLN;
  3860. ⓪ BEGIN
  3861. ⓪ ASSEMBLER
  3862. ⓪ goleft  move.l  ptr,a0
  3863. ⓪(move.b  -1(a0),d0
  3864. ⓪(beq     xit
  3865. ⓪(cmpi.b  #CRchar,d0
  3866. ⓪(beq     xit
  3867. ⓪(move.b  -2(a0),d0
  3868. ⓪(beq     xit
  3869. ⓪(cmpi.b  #DLEchar,d0
  3870. ⓪(beq     xit
  3871. ⓪(jsr     Left
  3872. ⓪(bra     goleft
  3873. ⓪ xit
  3874. ⓪ END
  3875. ⓪ END GotoSOLN;
  3876. ⓪ 
  3877. ⓪ (*$l-*)
  3878. ⓪ PROCEDURE WordLeft;    (* ein Wort nach links *)
  3879. ⓪ BEGIN
  3880. ⓪ ASSEMBLER
  3881. ⓪ lp1     jsr     Left
  3882. ⓪(tst     forceTab
  3883. ⓪(bne     wrout
  3884. ⓪(move.l  ptr,a0
  3885. ⓪(move.b  (a0),d0
  3886. ⓪(jsr     AlphaNum
  3887. ⓪(bne     lp1
  3888. ⓪ lp2     move.l  ptr,a0
  3889. ⓪(move.b  -1(a0),d0
  3890. ⓪(beq     wrout
  3891. ⓪(cmpi.b  #DLEchar,-2(a0)
  3892. ⓪(beq     wrout
  3893. ⓪(jsr     alphanum
  3894. ⓪(bne     wrout
  3895. ⓪(jsr     Left
  3896. ⓪(tst     forceTab
  3897. ⓪(beq     lp2
  3898. ⓪ wrout
  3899. ⓪ END
  3900. ⓪ END WordLeft;
  3901. ⓪ 
  3902. ⓪ (*$l-*)
  3903. ⓪ PROCEDURE DelRight;             (* nach rechts l÷schen *)
  3904. ⓪ BEGIN
  3905. ⓪ ASSEMBLER
  3906. ⓪(clr    forceTab
  3907. ⓪(move.l ptr,a0
  3908. ⓪ again   move.b (a0)+,d0
  3909. ⓪(beq    force
  3910. ⓪(cmpi.b #CRchar,d0
  3911. ⓪(beq    rcr
  3912. ⓪(cmpi.b #$20,d0
  3913. ⓪(bcs    again
  3914. ⓪(move.l a0,ptr
  3915. ⓪(move.b ptrX,d1
  3916. ⓪(cmp.b  maxCol,d1
  3917. ⓪(beq    force
  3918. ⓪(moveq  #' ',d0
  3919. ⓪(cmpa.l delPtr,a0
  3920. ⓪(bhi    delaus
  3921. ⓪(move.b -1(a0),d0
  3922. ⓪ delaus  jmp    ChrOut
  3923. ⓪ rcr     jmp    Down
  3924. ⓪ force   move   #1,forceTab
  3925. ⓪ END
  3926. ⓪ END DelRight;
  3927. ⓪ 
  3928. ⓪ (*$l-*)
  3929. ⓪ PROCEDURE DelLeft;              (* nach links l÷schen *)
  3930. ⓪ BEGIN
  3931. ⓪ ASSEMBLER
  3932. ⓪(clr    forceTab
  3933. ⓪(move.l ptr,a0
  3934. ⓪ again   move.b -(a0),d0
  3935. ⓪(beq    leftrt
  3936. ⓪(cmpi.b #CRchar,d0
  3937. ⓪(beq    crback
  3938. ⓪(cmpi.b #DLEchar,-1(a0)
  3939. ⓪(bne    delit
  3940. ⓪(tst.b  -2(a0)
  3941. ⓪(beq    leftrt
  3942. ⓪(bra    crback
  3943. ⓪ delit   cmpi.b #$20,d0
  3944. ⓪(bcs    again
  3945. ⓪(move.l a0,ptr
  3946. ⓪(moveq  #LeftChar,d0
  3947. ⓪(jsr    ChrOut
  3948. ⓪(move.b (a0),d0
  3949. ⓪(cmpa.l delPtr,a0
  3950. ⓪(bcc    delaus
  3951. ⓪(moveq  #' ',d0
  3952. ⓪ delaus  jsr    ChrOut
  3953. ⓪(moveq  #LeftChar,d0
  3954. ⓪(jmp    ChrOut
  3955. ⓪ crback  jsr    UpNoCursor
  3956. ⓪(jsr    LineSt
  3957. ⓪(move   ptrY,d1
  3958. ⓪(move.b maxCol,d1
  3959. ⓪(jmp    FindCursor
  3960. ⓪ leftrt  move   #1,forceTab
  3961. ⓪ END
  3962. ⓪ END DelLeft;
  3963. ⓪ 
  3964. ⓪ (*$l-*)
  3965. ⓪ PROCEDURE DelLine;              (* Zeile löschen mit DelRight/Left *)
  3966. ⓪ BEGIN
  3967. ⓪ ASSEMBLER
  3968. ⓪ delln   move.l temp,a0
  3969. ⓪(cmpa.l ptr,a0
  3970. ⓪(bgt    delfor
  3971. ⓪(blt    delbck
  3972. ⓪(rts
  3973. ⓪ delfor  jsr    DelRight
  3974. ⓪(bra    delln
  3975. ⓪ delbck  jsr    DelLeft
  3976. ⓪(bra    delln
  3977. ⓪ END
  3978. ⓪ END DelLine;
  3979. ⓪ 
  3980. ⓪ (*$l-*)
  3981. ⓪ PROCEDURE DelWordRight;         (* Wort rechts l÷schen *)
  3982. ⓪ BEGIN
  3983. ⓪ ASSEMBLER
  3984. ⓪(bra     lp0
  3985. ⓪ again   move.b  (a0)+,d0
  3986. ⓪(beq     wrout
  3987. ⓪(cmpi.b  #CRchar,d0
  3988. ⓪(bne     nocr
  3989. ⓪(cmpi.b  #DLEchar,(a0)
  3990. ⓪(bne     ok
  3991. ⓪(addq.l  #2,a0
  3992. ⓪(bra     ok
  3993. ⓪ nocr    cmpi.b  #$20,d0
  3994. ⓪(bcs     again
  3995. ⓪ ok      rts
  3996. ⓪ lp0     move.l  ptr,a0
  3997. ⓪(move.b  (a0),d0
  3998. ⓪(beq     wrout
  3999. ⓪(jsr     alphanum
  4000. ⓪(bne     lp2
  4001. ⓪ lp1     bsr     again
  4002. ⓪(move.b  (a0),d0
  4003. ⓪(beq     wrout
  4004. ⓪(jsr     AlphaNum
  4005. ⓪(beq     lp1
  4006. ⓪ lp2     bsr     again
  4007. ⓪(move.b  (a0),d0
  4008. ⓪(beq     wrout
  4009. ⓪(jsr     AlphaNum
  4010. ⓪(bne     lp2
  4011. ⓪(move.l  a0,temp
  4012. ⓪(jsr     DelLine
  4013. ⓪ wrout
  4014. ⓪ END
  4015. ⓪ END DelWordRight;
  4016. ⓪ 
  4017. ⓪ (*$l-*)
  4018. ⓪ PROCEDURE DelWordLeft;          (* Wort links l÷schen *)
  4019. ⓪ BEGIN
  4020. ⓪ ASSEMBLER
  4021. ⓪(move.l  ptr,a0
  4022. ⓪(bra     lp1
  4023. ⓪ again   move.b  -(a0),d0
  4024. ⓪(beq     dwlout
  4025. ⓪(cmpi.b  #CRchar,d0
  4026. ⓪(beq     leftok
  4027. ⓪(cmpi.b  #DLEchar,-1(a0)
  4028. ⓪(bne     delit
  4029. ⓪(subq.l  #1,a0
  4030. ⓪(bra     again
  4031. ⓪ delit   cmpi.b  #$20,d0
  4032. ⓪(bcs     again
  4033. ⓪ leftok  rts
  4034. ⓪ lp1     bsr     again
  4035. ⓪(tst.b   d0
  4036. ⓪(beq     dwlout
  4037. ⓪(jsr     AlphaNum
  4038. ⓪(bne     lp1
  4039. ⓪ lp2     move.b  -1(a0),d0
  4040. ⓪(beq     dwlok
  4041. ⓪(cmpi.b  #DLEchar,-2(a0)
  4042. ⓪(beq     dwlok
  4043. ⓪(jsr     alphanum
  4044. ⓪(bne     dwlok
  4045. ⓪(bsr     again
  4046. ⓪(tst.b   d0
  4047. ⓪(beq     dwlout
  4048. ⓪(tst     forceTab
  4049. ⓪(beq     lp2
  4050. ⓪ dwlok   move.l  a0,temp
  4051. ⓪(jsr     DelLine
  4052. ⓪ dwlout
  4053. ⓪ END
  4054. ⓪ END DelWordLeft;
  4055. ⓪ 
  4056. ⓪ (*$l-*)
  4057. ⓪ PROCEDURE DelToEOLN;            (* bis Zeilenende l÷schen *)
  4058. ⓪ BEGIN
  4059. ⓪ ASSEMBLER
  4060. ⓪(move.l  ptr,a0
  4061. ⓪(jsr     NextCR
  4062. ⓪(bne     nodel
  4063. ⓪(subq.l  #1,a0
  4064. ⓪(move.l  a0,temp
  4065. ⓪(jmp     DelLine
  4066. ⓪ nodel
  4067. ⓪ END
  4068. ⓪ END DelToEOLN;
  4069. ⓪ 
  4070. ⓪ (*$l-*)
  4071. ⓪ PROCEDURE DelToSOLN;            (* bis Zeilenanfang l÷schen *)
  4072. ⓪ BEGIN
  4073. ⓪ ASSEMBLER
  4074. ⓪(move.l  ptr,a0
  4075. ⓪(jsr     LastCR
  4076. ⓪(bne     noadd
  4077. ⓪(addq.l  #1,a0
  4078. ⓪ noadd   cmpi.b  #DLEchar,(a0)
  4079. ⓪(bne     ok
  4080. ⓪(addq.l  #2,a0
  4081. ⓪ ok      move.l  a0,temp
  4082. ⓪(jmp     DelLine
  4083. ⓪ END
  4084. ⓪ END DelToSOLN;
  4085. ⓪ 
  4086. ⓪ (*$l-*)
  4087. ⓪ PROCEDURE DelDown;              (* nach unten löschen *)
  4088. ⓪ BEGIN
  4089. ⓪ ASSEMBLER
  4090. ⓪*move.l ptr,a0
  4091. ⓪ cr1       move.b (a0)+,d0
  4092. ⓪*bne    cr11
  4093. ⓪*rts
  4094. ⓪ cr11      cmpi.b #CRchar,d0
  4095. ⓪*bne    cr1
  4096. ⓪*moveq  #0,d0
  4097. ⓪*move.b ch,d0
  4098. ⓪*move.b ptrX,d1
  4099. ⓪*cmpi   #downKey,d0
  4100. ⓪*beq    crmitte
  4101. ⓪*moveq  #0,d1
  4102. ⓪ crmitte   moveq  #0,d3
  4103. ⓪*cmpi.b #DLEchar,(a0)
  4104. ⓪*bne    xit
  4105. ⓪*addq.l #1,a0
  4106. ⓪*move.b (a0)+,d3
  4107. ⓪*sub.b  #DLEoffset,d3
  4108. ⓪*cmp.b  d3,d1
  4109. ⓪*ble    xit
  4110. ⓪ fc1       move.b (a0),d4
  4111. ⓪*beq    xit
  4112. ⓪*cmpi.b #CRchar,d4
  4113. ⓪*beq    xit
  4114. ⓪*addq.l #1,a0
  4115. ⓪*addq.b #1,d3
  4116. ⓪*cmp.b  d3,d1
  4117. ⓪*bne    fc1
  4118. ⓪ xit       move.l a0,temp
  4119. ⓪*jmp    DelLine
  4120. ⓪ END
  4121. ⓪ END DelDown;
  4122. ⓪ 
  4123. ⓪ (*$l-*)
  4124. ⓪ PROCEDURE DelUp;              (* nach oben löschen *)
  4125. ⓪ BEGIN
  4126. ⓪ ASSEMBLER
  4127. ⓪(move.l ptr,a0
  4128. ⓪(jsr    LineSt
  4129. ⓪(jsr    LastCR
  4130. ⓪(bne    uprt
  4131. ⓪(jsr    LineSt
  4132. ⓪(move.b ptrX,d1
  4133. ⓪(cmpi.b #EnterKey,ch
  4134. ⓪(bne    crmitt
  4135. ⓪(moveq  #0,d1
  4136. ⓪ crmitt  moveq  #0,d3
  4137. ⓪(cmpi.b #DLEchar,(a0)
  4138. ⓪(bne    xit
  4139. ⓪(addq.l #1,a0
  4140. ⓪(move.b (a0)+,d3
  4141. ⓪(sub.b  #DLEoffset,d3
  4142. ⓪(cmp.b  d3,d1
  4143. ⓪(ble    xit
  4144. ⓪ fc1     move.b (a0),d4
  4145. ⓪(beq    xit
  4146. ⓪(cmpi.b #CRchar,d4
  4147. ⓪(beq    xit
  4148. ⓪(addq.l #1,a0
  4149. ⓪(addq.b #1,d3
  4150. ⓪(cmp.b  d3,d1
  4151. ⓪(bne    fc1
  4152. ⓪ xit     move.l a0,temp
  4153. ⓪(jmp    DelLine
  4154. ⓪ uprt
  4155. ⓪ END
  4156. ⓪ END DelUp;
  4157. ⓪ 
  4158. ⓪ (*$l-*)
  4159. ⓪ PROCEDURE InsWrite;     (* Bildschrim ab Cursor neu aufbauen *)
  4160. ⓪ BEGIN
  4161. ⓪ ASSEMBLER
  4162. ⓪(move   d1,-(a7)
  4163. ⓪(jsr    GotoXYd1
  4164. ⓪(clr    d0
  4165. ⓪(move.b ptrY,d0
  4166. ⓪(move   d0,ptrLine
  4167. ⓪(move.l ptr,a0
  4168. ⓪ inslnw  jsr    LineOut
  4169. ⓪(moveq  #0,d0
  4170. ⓪(move.b ptrY,d0
  4171. ⓪(cmp    maxLine,d0
  4172. ⓪(bcc    inslnx
  4173. ⓪(jsr    WriteLn
  4174. ⓪(bra    inslnw
  4175. ⓪ inslnx  move   (a7)+,d1
  4176. ⓪(jmp    GotoXYd1
  4177. ⓪ END
  4178. ⓪ END InsWrite;
  4179. ⓪ 
  4180. ⓪ (*$l-*)
  4181. ⓪ PROCEDURE InsRight;     (* ein Zeichen nach rechts im Insert-Buf. (bufferM) *)
  4182. ⓪ END InsRight;
  4183. ⓪ 
  4184. ⓪ (*$l-*)
  4185. ⓪ PROCEDURE InsBackSpace; (* ein Zeichen aus Insert-Buffer l÷schen (bufferM) *)
  4186. ⓪ BEGIN
  4187. ⓪ ASSEMBLER
  4188. ⓪+clr    forceTab
  4189. ⓪+move.l bufferL,a0
  4190. ⓪+cmpa.l bufferH,a0
  4191. ⓪+bcs    eleft1
  4192. ⓪+move.l ptr,a0
  4193. ⓪+cmpi.b #DLEchar,-2(a0)
  4194. ⓪+bne    ilefterr
  4195. ⓪+move.b -(a0),d0
  4196. ⓪+cmpi.b #DLEoffset,d0
  4197. ⓪+bls    ilefterr
  4198. ⓪+subq.b #1,d0
  4199. ⓪+move.b d0,(a0)
  4200. ⓪+move.b d0,dleWert
  4201. ⓪+bra.l  insback
  4202. ⓪ ilefterr   move   #1,forceTab
  4203. ⓪+rts
  4204. ⓪ eleft1     cmpi.b #CRchar,(a0)
  4205. ⓪+beq    crleft
  4206. ⓪+cmpi.b #DLEchar,1(a0)
  4207. ⓪+beq    dleleft
  4208. ⓪+move.b (a0),d0
  4209. ⓪+addq.l #1,bufferL
  4210. ⓪+addq.l #1,bufferM
  4211. ⓪+cmpi.b #$20,d0
  4212. ⓪+bcs    insbctrl
  4213. ⓪+bra    insback
  4214. ⓪ dleleft    move.b (a0),d0
  4215. ⓪+cmpi.b #DLEoffset,d0
  4216. ⓪+bhi    dleleft1
  4217. ⓪+addq.l #2,a0
  4218. ⓪ crleft     addq.l #1,a0
  4219. ⓪+move.l a0,bufferL
  4220. ⓪+move.l a0,bufferM
  4221. ⓪+move   ptrY,d1
  4222. ⓪+clr.b  d1
  4223. ⓪+subi   #256,d1
  4224. ⓪+ble    ilefterr
  4225. ⓪ findx      cmpi.b #CRchar,(a0)
  4226. ⓪+beq    foundx
  4227. ⓪+addq.l #1,a0
  4228. ⓪+addq.b #1,d1
  4229. ⓪+cmpa.l bufferH,a0
  4230. ⓪+bls    findx
  4231. ⓪+move.l bufferH,a0
  4232. ⓪+subq.b #1,d1
  4233. ⓪+add.b  ptrXIns,d1
  4234. ⓪ foundx     cmpi.b #DLEchar,-(a0)
  4235. ⓪+bne    foundx1
  4236. ⓪+subq.b #2,d1
  4237. ⓪+add.b  -(a0),d1
  4238. ⓪+sub.b  #DLEoffset,d1
  4239. ⓪ foundx1    jmp    InsWrite
  4240. ⓪ dleleft1   subq.b #1,d0
  4241. ⓪+move.b d0,dleWert
  4242. ⓪+move.b d0,(a0)
  4243. ⓪ insback    moveq  #BSchar,d0
  4244. ⓪+jsr    ChrOut
  4245. ⓪ insbctrl   move   ptrY,d1
  4246. ⓪+move.b ptrX,d1
  4247. ⓪+move   d1,-(a7)
  4248. ⓪+move.l ptr,a0
  4249. ⓪+jsr    LineOut
  4250. ⓪+move   (a7)+,d1
  4251. ⓪+jmp    GotoXYd1
  4252. ⓪ END
  4253. ⓪ END InsBackSpace;
  4254. ⓪ 
  4255. ⓪ (*$l-*)
  4256. ⓪ PROCEDURE InsLeft;      (* ein Zeichen nach links im Insert-Buf. (bufferM) *)
  4257. ⓪ BEGIN
  4258. ⓪ ASSEMBLER jmp     InsBackSpace
  4259. ⓪ END
  4260. ⓪ END InsLeft;
  4261. ⓪ 
  4262. ⓪ (*$l-*)
  4263. ⓪ PROCEDURE InsDelete;    (* Zeichen unter Cursor l÷schen (bufferM) *)
  4264. ⓪ BEGIN
  4265. ⓪ ASSEMBLER jmp     InsBackSpace
  4266. ⓪ END
  4267. ⓪ END InsDelete;
  4268. ⓪ 
  4269. ⓪ (*$l-*)
  4270. ⓪ PROCEDURE InsLine;      (* eine Zeile einfⁿgen *)
  4271. ⓪ BEGIN
  4272. ⓪ ASSEMBLER
  4273. ⓪(move   #3,(a3)+
  4274. ⓪(jsr    Available
  4275. ⓪(tst    -(a3)
  4276. ⓪(bne    ins1
  4277. ⓪(jsr    Overflow
  4278. ⓪(jmp    InsCmd
  4279. ⓪ ins1    jsr    ClrLn
  4280. ⓪(moveq  #ClrEOLNchar,d0
  4281. ⓪(jsr    ChrOut
  4282. ⓪(move.l bufferL,a0
  4283. ⓪(move.b #CRchar,-(a0)
  4284. ⓪(move.b dleWert,d5
  4285. ⓪(move.b d5,d4
  4286. ⓪(subi.b #DLEoffset,d4
  4287. ⓪(move.b d4,d6
  4288. ⓪(tst    makeDLE
  4289. ⓪(beq    inodle
  4290. ⓪(move.b #DLEchar,-(a0)
  4291. ⓪(move.b d5,-(a0)
  4292. ⓪(bra    ins2
  4293. ⓪ inodle  subq.b #1,d4
  4294. ⓪(bmi    ins2
  4295. ⓪(move.b #' ',-(a0)
  4296. ⓪(bra    inodle
  4297. ⓪ ins2    move.l a0,bufferL
  4298. ⓪(move.l a0,bufferM
  4299. ⓪(move   ptrY,d1
  4300. ⓪(move.b d6,d1
  4301. ⓪(jmp    InsWrite
  4302. ⓪ END
  4303. ⓪ END InsLine;
  4304. ⓪ 
  4305. ⓪ (*$l-*)
  4306. ⓪ PROCEDURE IntoBuffer(ch: CHAR);         (* ch im Insert-Buffer ablegen *)
  4307. ⓪ BEGIN
  4308. ⓪ ASSEMBLER
  4309. ⓪(subq.l #1,a3
  4310. ⓪(moveq  #0,d0
  4311. ⓪(move.b -(a3),d0
  4312. ⓪(move   #1,(a3)+
  4313. ⓪(jsr    Available
  4314. ⓪(tst    -(a3)
  4315. ⓪(bne    ins1
  4316. ⓪(jsr    Overflow
  4317. ⓪(jmp    InsCmd
  4318. ⓪ ins1    move   #1,forceTab
  4319. ⓪(move.b ptrX,d1
  4320. ⓪(cmp.b  maxCol,d1
  4321. ⓪(bcc    ins2
  4322. ⓪ ins11   jsr    ChrOut
  4323. ⓪(clr    forceTab
  4324. ⓪ ins2    move.l bufferL,a0
  4325. ⓪(cmpi.b #' ',d0
  4326. ⓪(bne    bufch
  4327. ⓪(cmpi.b #DLEchar,1(a0)
  4328. ⓪(beq    bufdle
  4329. ⓪(cmpa.l bufferH,a0
  4330. ⓪(bcs    bufch
  4331. ⓪(move.l ptr,A1
  4332. ⓪(cmpi.b #DLEchar,-2(A1)
  4333. ⓪(bne    bufch
  4334. ⓪(lea    -1(A1),a0
  4335. ⓪ bufdle  addq.b #1,dleWert
  4336. ⓪(bpl    bufdl1
  4337. ⓪(subq.b #1,dleWert
  4338. ⓪ bufdl1  addq.b #1,(a0)
  4339. ⓪(bpl    bufwrt
  4340. ⓪(subq.b #1,(a0)
  4341. ⓪(bra    bufwrt
  4342. ⓪ bufch   move.b d0,-(a0)
  4343. ⓪(move.l a0,bufferL
  4344. ⓪(move.l a0,bufferM
  4345. ⓪ bufwrt  move   ptrY,d1
  4346. ⓪(move.b ptrX,d1
  4347. ⓪(move   d1,-(a7)
  4348. ⓪(move.l ptr,a0
  4349. ⓪(jsr    LineOut
  4350. ⓪(move   (a7)+,d1
  4351. ⓪(jmp    GotoXYd1
  4352. ⓪ END
  4353. ⓪ END IntoBuffer;
  4354. ⓪ 
  4355. ⓪ (*$l-*)
  4356. ⓪ PROCEDURE Break;
  4357. ⓪ BEGIN
  4358. ⓪ ASSEMBLER
  4359. ⓪(move.l  ptr,a0
  4360. ⓪(cmpi.b  #DLEchar,-2(a0)
  4361. ⓪(beq     fndna
  4362. ⓪(move.b  -1(a0),d0
  4363. ⓪(jsr     AlphaNum
  4364. ⓪(bne     spcvor
  4365. ⓪ fndna   move.b  (a0)+,d0        ;suche non-alpha-char.
  4366. ⓪(beq.l   exbrk
  4367. ⓪(jsr     AlphaNum
  4368. ⓪(beq     fndna
  4369. ⓪(subq.l  #1,a0
  4370. ⓪ spcvor  cmpi.b  #' ',(a0)+
  4371. ⓪(beq     spcvor
  4372. ⓪(subq.l  #1,a0
  4373. ⓪(move.l  a0,ptr
  4374. ⓪(jsr     LineSt          ;a0 zeigt auf voriges CR
  4375. ⓪(moveq   #DLEoffset,d0
  4376. ⓪(moveq   #1,d1
  4377. ⓪(tst     makeDLE
  4378. ⓪(beq     nodle
  4379. ⓪(cmpi.b  #DLEchar,(a0)
  4380. ⓪(bne     nodle
  4381. ⓪(addq.l  #2,d1
  4382. ⓪(move.b  1(a0),d0
  4383. ⓪ nodle   move    d1,d2
  4384. ⓪(move.b  d0,dleWert
  4385. ⓪(move.l  ptr,a0
  4386. ⓪(move.l  a0,(a3)+
  4387. ⓪ spcweg  move.b  -(a0),d0
  4388. ⓪(cmpi.b  #DLEchar,d0
  4389. ⓪(beq     fnddle
  4390. ⓪(cmpi.b  #' ',d0
  4391. ⓪(bne     nospc
  4392. ⓪(subq.l  #1,d1
  4393. ⓪(bra     spcweg
  4394. ⓪ fnddle  addq.l  #1,d1
  4395. ⓪ nospc   move.l  d1,(a3)+
  4396. ⓪(add.l   d1,ptr
  4397. ⓪(move    d2,-(a7)
  4398. ⓪(jsr     MoveText
  4399. ⓪(move    (a7)+,d2
  4400. ⓪(move.l  ptr,a0
  4401. ⓪(suba    d2,a0
  4402. ⓪(move.b  #CRchar,(a0)+
  4403. ⓪(tst     makeDLE
  4404. ⓪(beq     exbrk
  4405. ⓪(move.b  #DLEchar,(a0)+
  4406. ⓪(move.b  dleWert,(a0)+
  4407. ⓪ exbrk   jsr     ScreenOut
  4408. ⓪ END
  4409. ⓪ END Break;
  4410. ⓪ 
  4411. ⓪ (*$l-*)
  4412. ⓪ PROCEDURE Glue;
  4413. ⓪ BEGIN
  4414. ⓪ ASSEMBLER
  4415. ⓪(jsr     RptfOK
  4416. ⓪ gluelp  move.l  ptr,a0
  4417. ⓪(moveq   #-1,d1
  4418. ⓪ fndcr   move.b  (a0)+,d0
  4419. ⓪(beq     exglue
  4420. ⓪(cmpi.b  #CRchar,d0
  4421. ⓪(bne     fndcr
  4422. ⓪(cmpi.b  #DLEchar,-3(a0)
  4423. ⓪(beq     spcda
  4424. ⓪(cmpi.b  #' ',-2(a0)
  4425. ⓪(beq     spcda
  4426. ⓪(move.b  #' ',-1(a0)
  4427. ⓪(addq.l  #1,d1
  4428. ⓪ spcda   cmpi.b  #DLEchar,(a0)
  4429. ⓪(bne     movok
  4430. ⓪(addq.l  #2,a0
  4431. ⓪(subq.l  #2,d1
  4432. ⓪ movok   move.l  a0,(a3)+
  4433. ⓪(move.l  d1,(a3)+
  4434. ⓪(adda.l  d1,a0
  4435. ⓪(move.l  a0,ptr
  4436. ⓪(jsr     MoveText
  4437. ⓪(subq.l  #1,rptf
  4438. ⓪(;bne     gluelp         ;Glue ohne Rptf!!
  4439. ⓪ exglue  jsr     ScreenOut
  4440. ⓪(clr.l  rptf
  4441. ⓪ END
  4442. ⓪ END Glue;
  4443. ⓪ 
  4444. ⓪ (*$l-*)
  4445. ⓪ PROCEDURE DelOneChar;
  4446. ⓪ BEGIN
  4447. ⓪ ASSEMBLER
  4448. ⓪(move.l  ptr,a0
  4449. ⓪(move.b  (a0),d0
  4450. ⓪(beq     xit
  4451. ⓪(cmpi.b  #CRchar,d0
  4452. ⓪(beq     xit
  4453. ⓪(addq.l  #1,a0
  4454. ⓪(move.l  a0,(a3)+
  4455. ⓪(move.l  #-1,(a3)+
  4456. ⓪(jsr     MoveText
  4457. ⓪(jsr     PushPtr
  4458. ⓪(move    ptrY,d1
  4459. ⓪(move.b  ptrX,d1
  4460. ⓪(move.l  ptr,a0
  4461. ⓪(move    #1,insflag
  4462. ⓪(jsr     LineOut
  4463. ⓪(clr     insflag
  4464. ⓪(jsr     GotoXYd1
  4465. ⓪ xit
  4466. ⓪ END
  4467. ⓪ END DelOneChar;
  4468. ⓪ 
  4469. ⓪ (*$l-*)
  4470. ⓪ PROCEDURE DelOneCharLeft;
  4471. ⓪ BEGIN
  4472. ⓪ ASSEMBLER
  4473. ⓪(move.l  ptr,a0
  4474. ⓪(tst.b   -(a0)
  4475. ⓪(beq     xit
  4476. ⓪(move.b  -1(a0),d0
  4477. ⓪(beq     xit
  4478. ⓪(cmpi.b  #DLEchar,d0
  4479. ⓪(bne     nodle
  4480. ⓪(move.b  (a0),d0
  4481. ⓪(subq.b  #1,d0
  4482. ⓪(cmpi.b  #DLEoffset,d0
  4483. ⓪(bge     store0
  4484. ⓪(moveq   #DLEoffset,d0
  4485. ⓪ store0  move.b  d0,(a0)+
  4486. ⓪(move.l  a0,ptr
  4487. ⓪(subq.l  #2,a0
  4488. ⓪(move    ptrY,d1
  4489. ⓪(clr.b   d1
  4490. ⓪(jsr     GotoXYd1
  4491. ⓪(jsr     LineOut
  4492. ⓪(jmp     GotoPtr
  4493. ⓪ nodle   jsr     Left
  4494. ⓪(jmp     DelOneChar
  4495. ⓪ xit
  4496. ⓪ END
  4497. ⓪ END DelOneCharLeft;
  4498. ⓪ 
  4499. ⓪ (*$l-*)
  4500. ⓪ PROCEDURE InsOneChar;
  4501. ⓪ BEGIN
  4502. ⓪ ASSEMBLER
  4503. ⓪&(*move.l  ptr,a0
  4504. ⓪(move.b  -(a0),d0
  4505. ⓪(beq     nodle
  4506. ⓪(cmpi.b  #DLEchar,-1(a0)
  4507. ⓪(bne     nodle
  4508. ⓪(addq.b  #1,d0
  4509. ⓪(bmi     xit
  4510. ⓪(move.b  d0,(a0)
  4511. ⓪(subq.l  #1,a0
  4512. ⓪(move    ptrY,d1
  4513. ⓪(clr.b   d1
  4514. ⓪(jsr     GotoXYd1
  4515. ⓪(jsr     LineOut
  4516. ⓪(jmp     GotoPtr
  4517. ⓪ nodle*) move    #1,(a3)+
  4518. ⓪(jsr     Available
  4519. ⓪(tst     -(a3)
  4520. ⓪(beq     xit
  4521. ⓪(move.l  ptr,(a3)+
  4522. ⓪(move.l  #1,(a3)+
  4523. ⓪(jsr     MoveText
  4524. ⓪(jsr     PushPtr
  4525. ⓪(move    ptrY,d1
  4526. ⓪(move.b  ptrX,d1
  4527. ⓪(move    #1,insflag
  4528. ⓪(move.l  ptr,a0
  4529. ⓪(move.b  #' ',(a0)
  4530. ⓪(jsr     LineOut
  4531. ⓪(clr     insflag
  4532. ⓪(jsr     GotoXYd1
  4533. ⓪ xit
  4534. ⓪ END
  4535. ⓪ END InsOneChar;
  4536. ⓪ 
  4537. ⓪ (*$l+*)
  4538. ⓪ PROCEDURE InsMode;              (* Insert-Modus *)
  4539. ⓪"VAR ptrLTemp:CARDINAL;
  4540. ⓪ BEGIN
  4541. ⓪"InsCmd;
  4542. ⓪"ASSEMBLER
  4543. ⓪,move.b ptrX,ptrXIns
  4544. ⓪,move   ptrLine,ptrLTemp(A6)
  4545. ⓪,move   #1,insFlag
  4546. ⓪,move.l bufferH,a0
  4547. ⓪,move.l a0,bufferL
  4548. ⓪,move.l a0,bufferM
  4549. ⓪,move.l ptr,a0
  4550. ⓪,move.b -1(a0),temp
  4551. ⓪,jsr    LineSt
  4552. ⓪,moveq  #DLEoffset,d0
  4553. ⓪,cmpi.b #DLEchar,(a0)+
  4554. ⓪,bne    ikeindle
  4555. ⓪,move.b (a0),d0
  4556. ⓪"ikeindle  move.b d0,dleWert
  4557. ⓪"END;
  4558. ⓪"REPEAT
  4559. ⓪$ReadCh;
  4560. ⓪$IF ch=EnterKey THEN
  4561. ⓪&InsLine;
  4562. ⓪&IF ptrLine=maxLine THEN InsCmd END
  4563. ⓪$ELSIF ch=leftKey THEN InsLeft
  4564. ⓪$ELSIF ch=BSkey THEN InsBackSpace
  4565. ⓪$ELSIF ch=DELkey THEN InsDelete
  4566. ⓪$ELSIF ch=TabLeftKey THEN REPEAT InsLeft UNTIL TabSet()
  4567. ⓪$ELSIF ch=rightKey THEN
  4568. ⓪&IF bufferM=bufferL THEN IntoBuffer(' ') ELSE InsRight END
  4569. ⓪$ELSIF ch=TabRightKey THEN
  4570. ⓪&REPEAT
  4571. ⓪(IF bufferM=bufferL THEN IntoBuffer(' ') ELSE InsRight END
  4572. ⓪&UNTIL TabSet()
  4573. ⓪$ELSIF ch IN allowed THEN IntoBuffer(ch)
  4574. ⓪$ELSIF accept THEN BufferToText(false) END
  4575. ⓪"UNTIL abort OR accept;
  4576. ⓪"PushPtr;
  4577. ⓪"lastPtr:=ptr;
  4578. ⓪"insFlag:=false;
  4579. ⓪"IF abort THEN
  4580. ⓪$ASSEMBLER move.l ptr,a0 move.b temp,-1(a0) move ptrLTemp(A6),ptrLine END;
  4581. ⓪$ScreenOut
  4582. ⓪"END
  4583. ⓪ END InsMode;
  4584. ⓪ 
  4585. ⓪ (*$l+*)
  4586. ⓪ PROCEDURE DelMode;              (* Delete-Modus *)
  4587. ⓪"VAR ptrLTemp:CARDINAL;
  4588. ⓪ BEGIN
  4589. ⓪"ASSEMBLER move.l ptr,delPtr move ptrLine,ptrLTemp(A6) clr cmdFlag
  4590. ⓪*move #1,delFlag clr.l rptf
  4591. ⓪"END;
  4592. ⓪"LOOP
  4593. ⓪$IF CmdLineAway(FALSE) THEN
  4594. ⓪&PutCmdOrTab('Delete: /F1/ or /Enter/ deletes, /ESC/ ignores');
  4595. ⓪&cmdFlag:=true
  4596. ⓪$END;
  4597. ⓪$ReadUpCh;
  4598. ⓪$IF accept THEN AbInBuffer; EXIT
  4599. ⓪$ELSIF abort THEN DelInBuffer; EXIT
  4600. ⓪$ELSIF DirKey() OR Rptfx10() THEN
  4601. ⓪$ELSE RptfOk;
  4602. ⓪&REPEAT
  4603. ⓪(IF (ch=leftKey) OR (ch=BSkey) OR (ch=DELkey) THEN DelLeft
  4604. ⓪(ELSIF (ch=rightKey) OR (ch=' ') THEN DelRight
  4605. ⓪(ELSIF ch=TabLeftKey THEN REPEAT DelLeft UNTIL (ptr<=ptrStart) OR TabSet()
  4606. ⓪(ELSIF ch=TabRightKey THEN REPEAT DelRight UNTIL (ptr>=ptrEnd-2L) OR TabSet()
  4607. ⓪(ELSIF ch=EnterKey THEN IF direction THEN DelUp ELSE DelDown END;
  4608. ⓪(ELSIF ch=EOLNkey THEN DelToEOLN
  4609. ⓪(ELSIF ch=SOLNkey THEN DelToSOLN
  4610. ⓪(ELSIF ch=WordLeftKey THEN DelWordLeft
  4611. ⓪(ELSIF ch=WordRightKey THEN DelWordRight
  4612. ⓪(ELSIF ch=upKey THEN DelUp
  4613. ⓪(ELSIF ch=downKey THEN DelDown
  4614. ⓪(END;
  4615. ⓪(DEC(rptf)
  4616. ⓪&UNTIL (rptf=0L) OR KeyPressed()
  4617. ⓪$END
  4618. ⓪"END;
  4619. ⓪"cmdFlag:=false; delFlag:=false;
  4620. ⓪"IF (ptr>delPtr) OR abort THEN ptr:=delPtr END;
  4621. ⓪"PushPtr;
  4622. ⓪"lastPtr:=ptr;
  4623. ⓪"ptrLine:=ptrLTemp;
  4624. ⓪"ScreenOut
  4625. ⓪ END DelMode;
  4626. ⓪ 
  4627. ⓪ (*$l-*)
  4628. ⓪ PROCEDURE Zap;          (* Zap zum l÷schen gr÷sserer Stⁿcke *)
  4629. ⓪ BEGIN
  4630. ⓪"temp:=ptr;
  4631. ⓪"ChkLastPtr;
  4632. ⓪"CASE ChkZap() OF
  4633. ⓪"0:AbInBuffer; ScreenOut |
  4634. ⓪"1:PutCmd('Zap more than 200 characters? ');
  4635. ⓪$IF Yes() THEN AbInBuffer; ScreenOut ELSE ptr:=temp END |
  4636. ⓪"2:PutCmd('Zap: no room to buffer - delete anyway? ');
  4637. ⓪$IF Yes() THEN
  4638. ⓪&bufferL:=bufferH;
  4639. ⓪&MoveText(delPtr,LONGINT(ptr)-LONGINT(delPtr));
  4640. ⓪&ScreenOut
  4641. ⓪$ELSE ptr:=temp
  4642. ⓪$END
  4643. ⓪"END
  4644. ⓪ END Zap;
  4645. ⓪ 
  4646. ⓪ (* ED5.ICL *)
  4647. ⓪ 
  4648. ⓪ (*$l-*)
  4649. ⓪ PROCEDURE Exchange;
  4650. ⓪ BEGIN
  4651. ⓪"cmdFlag:=false;
  4652. ⓪"LOOP
  4653. ⓪$IF CmdLineAway(FALSE) THEN
  4654. ⓪&PutCmdOrTab('Exchange: /ESC/, /F1/ or /Enter/ to END');
  4655. ⓪&cmdFlag:=true
  4656. ⓪$END;
  4657. ⓪$ReadCh;
  4658. ⓪$IF accept OR abort THEN EXIT
  4659. ⓪$ELSIF ch=EOLNkey THEN GotoEOLN
  4660. ⓪$ELSIF ch=SOLNkey THEN GotoSOLN
  4661. ⓪$ELSIF ch=leftKey THEN Left
  4662. ⓪$ELSIF ch=rightKey THEN Right
  4663. ⓪$ELSIF ch=wordLeftKey THEN WordLeft
  4664. ⓪$ELSIF ch=wordRightKey THEN WordRight
  4665. ⓪$ELSIF ch=TabLeftKey THEN REPEAT Left UNTIL TabSet()
  4666. ⓪$ELSIF ch=TabRightKey THEN REPEAT Right UNTIL TabSet()
  4667. ⓪$ELSIF ch=EnterKey THEN Down
  4668. ⓪$ELSIF (ch=PageDownKey) OR (ch=PageUpKey) THEN Page(ch=PageUpKey)
  4669. ⓪$ELSIF ch=upKey THEN Up
  4670. ⓪$ELSIF ch=downKey THEN Down
  4671. ⓪$ELSIF ch=scrlUpKey THEN ScrollUp;
  4672. ⓪$ELSIF ch=scrlDownKey THEN ScrollDown;
  4673. ⓪$ELSIF ch=DELkey THEN DelOneChar
  4674. ⓪$ELSIF ch=INSkey THEN InsOneChar
  4675. ⓪$ELSIF ch=BSkey THEN DelOneCharLeft
  4676. ⓪$ELSIF (ch IN allowed) & Exchg(ch) THEN ASSEMBLER
  4677. ⓪&move.b ptrX,d0 cmp.b maxCol,d0 bhi no move.b ch,d0 jsr ChrOut no END
  4678. ⓪$END
  4679. ⓪"END;
  4680. ⓪"PushPtr;
  4681. ⓪"cmdFlag:=false
  4682. ⓪ END Exchange;
  4683. ⓪ 
  4684. ⓪ (*$l+*)
  4685. ⓪ PROCEDURE Adjust;       (* zum Einrⁿcken von Zeilen und Bl÷cken *)
  4686. ⓪"VAR dlediff:CARDINAL;
  4687. ⓪ BEGIN
  4688. ⓪"ASSEMBLER clr dlediff(A6) clr cmdFlag clr.l rptf END;
  4689. ⓪"LOOP
  4690. ⓪$IF CmdLineAway(FALSE) THEN
  4691. ⓪&PutCmdOrTab('Adjust: <-, ->, L(eft, /CR/, /ESC/');
  4692. ⓪&cmdFlag:=true
  4693. ⓪$END;
  4694. ⓪$ReadUpCh;
  4695. ⓪$IF abort OR accept THEN EXIT
  4696. ⓪$ELSIF DirKey() OR Rptfx10() THEN
  4697. ⓪$ELSE RptfOK;
  4698. ⓪&ASSEMBLER
  4699. ⓪&adjloop    move.l ptr,a0          ;Hauptschleife
  4700. ⓪1jsr    LineSt          ;a0 zeigt auf evtl. DLE
  4701. ⓪1moveq  #0,d0
  4702. ⓪1move.b ch,d0
  4703. ⓪1cmpi   #upKey,d0
  4704. ⓪1beq.l  adjup
  4705. ⓪1cmpi.b #EnterKey,d0
  4706. ⓪1bne    adj0
  4707. ⓪1tst.w  direction
  4708. ⓪1bne.w  adjUp
  4709. ⓪1bra.w  adjDown
  4710. ⓪&adj0       cmpi   #downKey,d0
  4711. ⓪1beq.l  adjDown
  4712. ⓪1cmpi.b #DLEchar,(a0)+      ;kein DLE => gleich wieder raus
  4713. ⓪1bne.l  adjmor1
  4714. ⓪1move.b (a0),d1         ;Space-Count nach DLE
  4715. ⓪1cmpi   #leftKey,d0
  4716. ⓪1bne    adj1
  4717. ⓪1cmpi.b #DLEoffset,d1
  4718. ⓪1beq.l  adjmor1
  4719. ⓪1subq.b #1,d1
  4720. ⓪1subq.b #1,dlediff(A6)
  4721. ⓪1move.b d1,(a0)         ;eins nach links
  4722. ⓪1bra.l  adjzeile
  4723. ⓪&adj1       cmpi.b #' ',d0
  4724. ⓪1beq    adj11
  4725. ⓪1cmpi   #rightKey,d0
  4726. ⓪1bne    adj2
  4727. ⓪&adj11      addq.b #1,d1
  4728. ⓪1bpl    adjright
  4729. ⓪1subq.b #1,d1
  4730. ⓪&adjright   addq.b #1,dlediff(A6)
  4731. ⓪1move.b d1,(a0)         ;eins nach rechts
  4732. ⓪1bra.l  adjzeile
  4733. ⓪&adj2       cmpi.b #'L',d0         ;L(eft-Adjust
  4734. ⓪1bne    adj3
  4735. ⓪1moveq  #DLEoffset,d1
  4736. ⓪1sub.b  (a0),d1
  4737. ⓪1move.b d1,dlediff(A6)  ;Distanz fⁿr weitere Zeilen ber.
  4738. ⓪1move.b #DLEoffset,(a0)
  4739. ⓪1bra.l  adjzeile
  4740. ⓪&adj3       cmpi.b #TabRightKey,d0
  4741. ⓪1bne    adj4
  4742. ⓪1sub.b  #DLEoffset,d1
  4743. ⓪1move.b d1,ptrX
  4744. ⓪&adjtab     addq.b #1,dleDiff(A6)
  4745. ⓪1addq.b #1,ptrX
  4746. ⓪1bmi    adjzeile
  4747. ⓪1addq.b #1,(a0)
  4748. ⓪1jsr    TabSet
  4749. ⓪1tst    -(a3)
  4750. ⓪1beq    adjtab
  4751. ⓪1bra    adjzeile
  4752. ⓪&adj4       cmpi.b #TabLeftKey,d0
  4753. ⓪1bne.l  adjmore
  4754. ⓪1sub.b  #DLEoffset,d1
  4755. ⓪1move.b d1,ptrX
  4756. ⓪&adjbaktab  subq.b #1,dleDiff(A6)
  4757. ⓪1subq.b #1,ptrX
  4758. ⓪1bmi    adjzeile
  4759. ⓪1subq.b #1,(a0)
  4760. ⓪1jsr    TabSet
  4761. ⓪1tst    -(a3)
  4762. ⓪1beq    adjbaktab
  4763. ⓪1bra    adjzeile
  4764. ⓪&adjDown    jsr    Down
  4765. ⓪1bra    adjupDown
  4766. ⓪&adjup      jsr    Up
  4767. ⓪&adjupDown  move.l ptr,a0
  4768. ⓪1jsr    LineSt
  4769. ⓪1cmpi.b #DLEchar,(a0)+
  4770. ⓪1bne    adjmor1
  4771. ⓪1move.b (a0),d3
  4772. ⓪1add.b  dlediff(A6),d3  ;Zeile erst mal um dlediff verschieben
  4773. ⓪1cmpi.b #DLEoffset,d3
  4774. ⓪1bge    adjhl
  4775. ⓪1moveq  #DLEoffset,d3
  4776. ⓪&adjhl      move.b d3,(a0)
  4777. ⓪&adjzeile   clr    saved
  4778. ⓪1clr     restoreFileDT
  4779. ⓪1move   ptrY,d1
  4780. ⓪1clr.b  d1
  4781. ⓪1jsr    GotoXYd1
  4782. ⓪1addq.l #1,a0
  4783. ⓪1move.l a0,ptr
  4784. ⓪1jsr    LineSt
  4785. ⓪1jsr    LineOut
  4786. ⓪1jsr    GoToPtr
  4787. ⓪&adjmor1    jsr    KeyPressed        ;bei Repeatfactor evtl. abbrechen
  4788. ⓪1tst    -(a3)
  4789. ⓪1bne    adjmor2
  4790. ⓪1subq.l #1,rptf
  4791. ⓪1bne.l  adjloop
  4792. ⓪&adjmor2    clr.l  rptf
  4793. ⓪&adjmore
  4794. ⓪&END
  4795. ⓪$END
  4796. ⓪"END;
  4797. ⓪"cmdFlag:=false
  4798. ⓪ END Adjust;
  4799. ⓪ 
  4800. ⓪ (*$l-*)
  4801. ⓪ PROCEDURE SetTag;       (* Tag an aktuelle Text-Position setzen *)
  4802. ⓪ BEGIN
  4803. ⓪"PutCmd('Set tag: enter 0..9 or A..Z: ');
  4804. ⓪"ASSEMBLER
  4805. ⓪*jsr    ChrIn
  4806. ⓪*jsr    ShiftUp
  4807. ⓪*cmpi   #'Z',d0        ;'Z' höchster erlaubter Marker
  4808. ⓪*bhi    notag
  4809. ⓪*subi   #'0',d0        ;'0'=Untergrenze abziehen
  4810. ⓪*blt    notag
  4811. ⓪*lsl    #2,d0          ;in der Tabelle stehen LONGs
  4812. ⓪*lea    tags,a0
  4813. ⓪*move.l ptr,0(a0,d0.w)
  4814. ⓪"notag
  4815. ⓪"END
  4816. ⓪ END SetTag;
  4817. ⓪ 
  4818. ⓪ (*$l-*)
  4819. ⓪ PROCEDURE GotoLine (l:LONGCARD;col:CARDINAL);
  4820. ⓪ BEGIN
  4821. ⓪"ASSEMBLER
  4822. ⓪(move.l  ptr,scrPtr
  4823. ⓪(move.l  ptrStart,a0
  4824. ⓪(move.w  -(a3),d2
  4825. ⓪(move.l  -(a3),d1
  4826. ⓪(beq     asgn
  4827. ⓪ lp      subq.l  #1,d1
  4828. ⓪(beq     asgn
  4829. ⓪(jsr     NextCR
  4830. ⓪(bra     lp
  4831. ⓪ asgn    tst.b   (a0)
  4832. ⓪(beq     pre0
  4833. ⓪(addq.l  #1,a0           ; DLE überspringen
  4834. ⓪(move.b  (a0)+,d1
  4835. ⓪(subi.b  #DLEoffset,d1
  4836. ⓪(sub.b   d1,d2
  4837. ⓪(bmi     set0
  4838. ⓪(adda.w  d2,a0
  4839. ⓪ set0    move.l  a0,ptr
  4840. ⓪ ext0    jmp     CenterScreen
  4841. ⓪ pre0    jsr     LastCR
  4842. ⓪(addq.l  #3,a0           ; hinter DLE
  4843. ⓪(bra     ext0
  4844. ⓪"END
  4845. ⓪ END GotoLine;
  4846. ⓪ 
  4847. ⓪ (*$l-*)
  4848. ⓪ PROCEDURE Jump;         (* Setzen des Text-Pointers *)
  4849. ⓪ BEGIN
  4850. ⓪ ASSEMBLER
  4851. ⓪(move.l  rptf,d1
  4852. ⓪(bne.l   count
  4853. ⓪(END; PutCmd('Jump: B(egin, E(nd, L(ast or tag '); ASSEMBLER
  4854. ⓪(jsr     ReadUpCh
  4855. ⓪(move    ptrCount,workCount
  4856. ⓪(move.l  ptr,scrPtr
  4857. ⓪ jmplp   move.l  ptr,a0
  4858. ⓪(cmpi.b  #'L',d0
  4859. ⓪(bne     nolast
  4860. ⓪(move.l  lastPtr,a0
  4861. ⓪(bra     nomar1
  4862. ⓪ nolast  cmpi.b  #'E',d0
  4863. ⓪(bne     noend
  4864. ⓪(move.l  ptrEnd,a0
  4865. ⓪(subq.l  #2,a0
  4866. ⓪(bra     nomar1
  4867. ⓪ noend   cmpi.b  #'B',d0
  4868. ⓪(bne     nobeg
  4869. ⓪(move.l  ptrStart,a0
  4870. ⓪ nomar1  bra.l   nomark
  4871. ⓪ nobeg   cmpi.b  #' ',d0
  4872. ⓪(bne     nospc
  4873. ⓪(jsr     ReadUpCh
  4874. ⓪(move.l  ptr,a0
  4875. ⓪(bra.l   nosyn
  4876. ⓪ nospc   lea     ptrStack,A1
  4877. ⓪(move    workCount,d1
  4878. ⓪(cmpi.b  #'+',d0
  4879. ⓪(bne     noplus
  4880. ⓪(addq    #4,d1
  4881. ⓪(bra     bckpls
  4882. ⓪ noplus  cmpi.b  #'-',d0
  4883. ⓪(bne     noback
  4884. ⓪(subq    #4,d1
  4885. ⓪ bckpls  andi    #$3C,d1
  4886. ⓪(move.l  0(A1,d1.w),a0
  4887. ⓪(move    d1,workCount
  4888. ⓪(bsr.l   nomark
  4889. ⓪(jsr     ReadUpCh
  4890. ⓪(cmpi.b  #'-',d0
  4891. ⓪(beq     nospc
  4892. ⓪(bra     jmplp
  4893. ⓪ noback  cmpi.b  #'?',d0
  4894. ⓪(bne     nosyn
  4895. ⓪(tst.l   ErrorPos
  4896. ⓪(beq     nosyn
  4897. ⓪(END; PutCmd(ErrMsg); ASSEMBLER
  4898. ⓪(tst     saved
  4899. ⓪(bne     syn1
  4900. ⓪(lea     tags,A1
  4901. ⓪(move.l  $3C(A1),a0
  4902. ⓪(bra     syn2
  4903. ⓪ syn1    move.l  ptrStart,a0
  4904. ⓪(adda.l  ErrorPos,a0
  4905. ⓪(lea     tags,A1
  4906. ⓪(move.l  a0,$3C(A1)
  4907. ⓪ syn2    bsr     nomark
  4908. ⓪(jmp     ErrorWait
  4909. ⓪ nosyn   cmpi.b  #'Z',d0
  4910. ⓪(bhi     nomark
  4911. ⓪(subi.b  #'0',d0
  4912. ⓪(bcs     nomark
  4913. ⓪(asl     #2,d0
  4914. ⓪(lea     tags,A1
  4915. ⓪(move.l  0(A1,d0.w),a0
  4916. ⓪ nomark  cmpa.l  ptrStart,a0
  4917. ⓪(bcs     bad
  4918. ⓪(cmpa.l  ptrEnd,a0
  4919. ⓪(bcc     bad
  4920. ⓪(bra     asgn
  4921. ⓪ count   move.l  d1,(a3)+
  4922. ⓪(clr     (a3)+
  4923. ⓪(jmp     gotoLine
  4924. ⓪ asgn    move.l  a0,ptr
  4925. ⓪ bad     move.l  #CenterScreen,(a3)+
  4926. ⓪(jmp     CondScreen
  4927. ⓪ END
  4928. ⓪ END Jump;
  4929. ⓪ 
  4930. ⓪ (*$l+*)
  4931. ⓪ PROCEDURE WriteTitle;
  4932. ⓪"BEGIN
  4933. ⓪$writestring ('Gepard-Atari Editor '+Version+' for Megamax Modula-2'); WriteLn;
  4934. ⓪$writestring
  4935. ⓪$('Copyright © [1985..1990], Thomas Tempelmann, Schusterwolfstr. 13, 81241 München');
  4936. ⓪$writeLn;
  4937. ⓪$writeLn
  4938. ⓪"END WriteTitle;
  4939. ⓪ 
  4940. ⓪ PROCEDURE UpdatePath (VAR tPath: ARRAY OF CHAR);
  4941. ⓪"VAR res: INTEGER;
  4942. ⓪"BEGIN
  4943. ⓪$MakeFullPath (tPath, res);
  4944. ⓪$ConcatPath (tPath, Path1, Path1);
  4945. ⓪"END UpdatePath;
  4946. ⓪ 
  4947. ⓪ PROCEDURE Getpath (VAR tPath: String);
  4948. ⓪"BEGIN
  4949. ⓪$GetDefaultPath(tPath);
  4950. ⓪$Append('*.*',tPath,strOk);
  4951. ⓪"END GetPath;
  4952. ⓪L(*Hü*)
  4953. ⓪ PROCEDURE getFilefromBox (title: MaxStr): String;
  4954. ⓪"VAR selectOK,Ok   :Boolean;
  4955. ⓪&REST,TEMPPATH,fName: STRING;
  4956. ⓪"BEGIN
  4957. ⓪$IF UseGem THEN
  4958. ⓪&Write(ClrScrnChar);
  4959. ⓪&IF GEMVersion () <= $120 THEN
  4960. ⓪(GotoXY ( (cols-Length(title)) DIV 2, 1);
  4961. ⓪(WriteString (title);
  4962. ⓪&END;
  4963. ⓪&SelectFile(title,Path1,FName1,selectOK);
  4964. ⓪&Write(ClrScrnChar);
  4965. ⓪&SplitPath(Path1,tempPath,Rest);
  4966. ⓪&abort:= NOT selectOK OR Empty (FName1);
  4967. ⓪&IF NOT abort then
  4968. ⓪(Concat(tempPath,FName1,fName,Ok);
  4969. ⓪(if Ok then return fName end
  4970. ⓪&END;
  4971. ⓪&Return ''
  4972. ⓪$ELSE
  4973. ⓪&WriteString (title);
  4974. ⓪&Write (' ');
  4975. ⓪&ReadString (fName);
  4976. ⓪&IF Empty (fName) THEN abort:= TRUE END;
  4977. ⓪&IF Abort THEN fName:= '' END;
  4978. ⓪&RETURN fName
  4979. ⓪$END
  4980. ⓪!END getFilefromBox;
  4981. ⓪ 
  4982. ⓪ PROCEDURE NewFile;      (* neues File laden *)
  4983. ⓪"VAR fn:STRING;
  4984. ⓪ BEGIN
  4985. ⓪"ClrKBDbuffer;
  4986. ⓪"ClrCmdLine;
  4987. ⓪"IF NOT saved & Worthy() THEN
  4988. ⓪$WriteString('New file: Throw away changes ? ');
  4989. ⓪$IF NOT Yes() THEN GoToPtr; RETURN END
  4990. ⓪"END;
  4991. ⓪"GotoXY(0,0); Write(ClrEOLnchar);
  4992. ⓪"fn:=getFilefromBox('Load which file?');
  4993. ⓪"IF ChkName(fn) THEN
  4994. ⓪$SearchFile (fn,SrcPaths,fromStart,strok,fn);
  4995. ⓪$Open (f,fn,readOnly);
  4996. ⓪$IOResult:=State(f);
  4997. ⓪$IF SuccessFull(13) THEN
  4998. ⓪&UpdatePath (fn);
  4999. ⓪&WriteString('Reading ');WriteString(fn);WriteLn;
  5000. ⓪&flen:= FileSize(f);
  5001. ⓪&ReadText;
  5002. ⓪$END;
  5003. ⓪$IF IOResult=0 THEN Flip(fileName,fn) END
  5004. ⓪"END;
  5005. ⓪"jumpPtr (tags[';']);
  5006. ⓪"tags[';']:= ptrEnd
  5007. ⓪ END NewFile;
  5008. ⓪ 
  5009. ⓪ (*$l+*)
  5010. ⓪ PROCEDURE CopyText;         (* einkopieren eines Files oder des Buffers *)
  5011. ⓪"VAR copyname:STRING; tagDisplace:LONGINT;
  5012. ⓪ BEGIN
  5013. ⓪"PutCmd('Copy: B(uffer');
  5014. ⓪"ReadUpCh;
  5015. ⓪"IF ch='B' THEN
  5016. ⓪$BufferToText(true); PushPtr; ScreenOut
  5017. ⓪"END
  5018. ⓪ END CopyText;
  5019. ⓪ 
  5020. ⓪ (*$l-*)
  5021. ⓪ PROCEDURE FiReDefault;  (* Defaultwerte fⁿr Find/Replace *)
  5022. ⓪ BEGIN
  5023. ⓪ ASSEMBLER
  5024. ⓪(tst.l  rptf
  5025. ⓪(bne    nodflt
  5026. ⓪(tst    infinite
  5027. ⓪(bne    nodflt
  5028. ⓪(move   #1,verify
  5029. ⓪(move   #1,infinite
  5030. ⓪ nodflt  jmp    ClrCmdLine
  5031. ⓪ END
  5032. ⓪ END FiReDefault;
  5033. ⓪ 
  5034. ⓪ (*$l+*)
  5035. ⓪ PROCEDURE Prompt(ps:STRING; id1:STRING; VAR inp1:STRING);
  5036. ⓪ BEGIN           (* Prompt für Find/Replace *)
  5037. ⓪"ASSEMBLER
  5038. ⓪$jsr     PutDir
  5039. ⓪$moveq   #'(',d0
  5040. ⓪$jsr     ChrOut
  5041. ⓪$moveq   #'?',d0
  5042. ⓪$tst     verify
  5043. ⓪$beq     inf
  5044. ⓪$jsr     ChrOut
  5045. ⓪ inf
  5046. ⓪$tst     infinite
  5047. ⓪$beq     inf1
  5048. ⓪$moveq   #'/',d0
  5049. ⓪$jsr     ChrOut
  5050. ⓪$bra     inf2
  5051. ⓪ inf1
  5052. ⓪$move.l  rptf,(a3)+
  5053. ⓪$jsr     WriteLCard
  5054. ⓪ inf2
  5055. ⓪$moveq   #')',d0
  5056. ⓪$jsr     ChrOut
  5057. ⓪$moveq   #' ',d0
  5058. ⓪$jsr     ChrOut
  5059. ⓪"END;
  5060. ⓪"WriteString(ps);
  5061. ⓪"IF findWord THEN WriteString(' Word') END;
  5062. ⓪"WriteString(id1);
  5063. ⓪"WriteString(': ');
  5064. ⓪"ReadString(inp1)
  5065. ⓪ END Prompt;
  5066. ⓪ 
  5067. ⓪ (*$l+*)
  5068. ⓪ PROCEDURE ConvToST (VAR s:ARRAY OF CHAR);
  5069. ⓪"VAR i,n:CARDINAL;
  5070. ⓪"BEGIN
  5071. ⓪$n:=ORD(s[0]);
  5072. ⓪$FOR i:=1 TO n DO
  5073. ⓪&s[i-1]:=s[i]
  5074. ⓪$END;
  5075. ⓪$s[n]:=0C
  5076. ⓪"END ConvToST;
  5077. ⓪ 
  5078. ⓪ (*$l+*)
  5079. ⓪ PROCEDURE ConvToGep (VAR s:ARRAY OF CHAR);
  5080. ⓪"VAR i,n:CARDINAL;
  5081. ⓪"BEGIN
  5082. ⓪$n:=Length(s);
  5083. ⓪$FOR i:=n TO 1 BY -1 DO
  5084. ⓪&s[i]:=s[i-1]
  5085. ⓪$END;
  5086. ⓪$s[0]:=CHR(n)
  5087. ⓪"END ConvToGep;
  5088. ⓪ 
  5089. ⓪ (*$l+*)
  5090. ⓪ PROCEDURE Find;         (* oldString suchen *)
  5091. ⓪ VAR s: String;
  5092. ⓪ BEGIN
  5093. ⓪"FiReDefault;
  5094. ⓪"IF NOT findSame THEN Prompt('Find','',oldString) END;
  5095. ⓪"GoToPtr;
  5096. ⓪"IF NOT abort & (Length(oldString)>0) THEN
  5097. ⓪$scrPtr:=ptr;
  5098. ⓪$ConvToGep (oldString);
  5099. ⓪$LOOP
  5100. ⓪&IF Search() THEN
  5101. ⓪(IF verify THEN
  5102. ⓪*CenterScreen;
  5103. ⓪*PutCmd('Find: /SPACE/ to proceed, any key to end');
  5104. ⓪*ReadCh;IF ch#' ' THEN EXIT END
  5105. ⓪(END;
  5106. ⓪(ASSEMBLER move.l rptf,d0 tst infinite beq decr addq.l #2,d0
  5107. ⓪(decr subq.l #1,d0 move.l d0,rptf bne goOn END; EXIT; ASSEMBLER
  5108. ⓪(!goOn
  5109. ⓪(END
  5110. ⓪&ELSE
  5111. ⓪(CondScreen(CenterScreen);
  5112. ⓪(Concat(CardToStr(rptf,0),' Find: string not found',s,strok);
  5113. ⓪(PutCmd(s);
  5114. ⓪(ErrorWait; EXIT
  5115. ⓪&END
  5116. ⓪$END;
  5117. ⓪$ConvToST (oldString);
  5118. ⓪$CondScreen(CenterScreen)
  5119. ⓪"END
  5120. ⓪ END Find;
  5121. ⓪ 
  5122. ⓪ (*$l-*)
  5123. ⓪ PROCEDURE Look;
  5124. ⓪ BEGIN
  5125. ⓪ ASSEMBLER
  5126. ⓪(move.l  ptr,a0
  5127. ⓪ fndna   cmpi.b  #DLEchar,-2(a0)
  5128. ⓪(beq     Lookit
  5129. ⓪(move.b  -1(a0),d0
  5130. ⓪(beq     Lookit
  5131. ⓪(jsr     AlphaNum
  5132. ⓪(bne     Lookit
  5133. ⓪(subq.l  #1,a0
  5134. ⓪(bra     fndna
  5135. ⓪ Lookit  lea     oldString,A1
  5136. ⓪(moveq   #0,d6
  5137. ⓪ Looklp  move.b  (a0)+,d0
  5138. ⓪(move.b  d0,d1
  5139. ⓪(jsr     AlphaNum        ;d1 bleibt erhalten
  5140. ⓪(bne     ex
  5141. ⓪(move.b  d1,0(A1,d6.w)
  5142. ⓪(clr.b   1(A1,d6.w)
  5143. ⓪(addq.b  #1,d6
  5144. ⓪(cmpi    #79,d6
  5145. ⓪(bcs     Looklp
  5146. ⓪(subq.b  #1,d6
  5147. ⓪ ex      tst.b   d6
  5148. ⓪(beq     noLook
  5149. ⓪(JSR     PushPtr         ; für Rücksprung mit J-
  5150. ⓪(move.l  ptr,a0
  5151. ⓪(tst     findSame
  5152. ⓪(bne     fnd
  5153. ⓪(move    #1,findSame
  5154. ⓪(move.l  ptrStart,a0
  5155. ⓪(tst     direction
  5156. ⓪(beq     fnd
  5157. ⓪(move.l  ptrEnd,a0
  5158. ⓪(subq.l  #2,a0
  5159. ⓪ fnd     move.l  a0,ptr
  5160. ⓪(jmp     Find
  5161. ⓪ noLook
  5162. ⓪ END
  5163. ⓪ END Look;
  5164. ⓪ 
  5165. ⓪ (*$l+*)
  5166. ⓪ PROCEDURE FReplace;      (* oldString suchen und durch newString erstzen *)
  5167. ⓪"VAR tagDisplace:LONGINT; s: String;
  5168. ⓪ BEGIN
  5169. ⓪"FiReDefault;
  5170. ⓪"IF NOT findSame THEN
  5171. ⓪$Prompt('Replace',' old',oldString);
  5172. ⓪$IF NOT abort & (Length(oldString)>0) THEN Home;
  5173. ⓪&Prompt('Replace',' new',newString)
  5174. ⓪$END
  5175. ⓪"END;
  5176. ⓪"GoToPtr;
  5177. ⓪"IF NOT abort & (Length(oldString)>0) THEN
  5178. ⓪$tagDisplace:=LONG (INTEGER(Length(newString)-Length(oldString)));
  5179. ⓪$scrPtr:=ptr;
  5180. ⓪$ConvToGep (oldString);
  5181. ⓪$LOOP
  5182. ⓪&IF Search() THEN
  5183. ⓪(IF verify THEN
  5184. ⓪*CenterScreen;
  5185. ⓪*PutCmd('Replace: /SPACE/ replaces, /RETURN/ skips, /ESC/ ends');
  5186. ⓪*REPEAT ReadCh UNTIL (ch=' ') OR (ch=EnterKey) OR abort
  5187. ⓪(ELSE
  5188. ⓪*Home;WriteLCard(rptf);
  5189. ⓪*IF KeyPressed() THEN ChrIn END
  5190. ⓪(END;
  5191. ⓪(IF abort THEN EXIT END;
  5192. ⓪(IF NOT verify OR (ch=' ') THEN
  5193. ⓪*IF Available(SHORT(tagDisplace)) THEN
  5194. ⓪,IF direction THEN
  5195. ⓪.MoveText(delPtr,tagDisplace); FillIn(ptr,newString)
  5196. ⓪,ELSE
  5197. ⓪.MoveText(ptr,tagDisplace); FillIn(delPtr,newString);
  5198. ⓪.ASSEMBLER move.l tagDisplace(A6),d0 add.l d0,ptr END
  5199. ⓪,END;
  5200. ⓪,PushPtr;
  5201. ⓪,ASSEMBLER move.l rptf,d0 tst infinite beq decr addq.l #2,d0
  5202. ⓪,decr subq.l #1,d0 move.l d0,rptf bne goOn END; EXIT; ASSEMBLER
  5203. ⓪,!goOn
  5204. ⓪,END
  5205. ⓪*ELSE
  5206. ⓪,CondScreen(CenterScreen);
  5207. ⓪,PutCmd('Replace: Out of memory');ErrorWait; EXIT
  5208. ⓪*END
  5209. ⓪(END
  5210. ⓪&ELSE
  5211. ⓪(CondScreen(CenterScreen);
  5212. ⓪(Concat(CardToStr(rptf,0),' Replace: string not found',s,strok);
  5213. ⓪(PutCmd(s);
  5214. ⓪(ErrorWait; EXIT
  5215. ⓪&END
  5216. ⓪$END;
  5217. ⓪$ConvToST (oldString);
  5218. ⓪$CondScreen(CenterScreen)
  5219. ⓪"END
  5220. ⓪ END FReplace;
  5221. ⓪ 
  5222. ⓪ 
  5223. ⓪ (*$l-*)
  5224. ⓪ PROCEDURE ScreenTop: ADDRESS;
  5225. ⓪ BEGIN
  5226. ⓪ ASSEMBLER
  5227. ⓪(move.l ptr,a0           ;aktueller Ptr
  5228. ⓪(move   ptrLine,d1       ;aktuelle Zeile
  5229. ⓪ pcr     cmp    maxLine,d1       ;bis in letzte Bildschirmzeile vorpirschen
  5230. ⓪(bhi    zcr
  5231. ⓪(jsr    NextCR           ;setzt A0 auf nächstes CR+1
  5232. ⓪(addq   #1,d1
  5233. ⓪(bra    pcr
  5234. ⓪ zcr     subq   #1,d1
  5235. ⓪(beq    korr
  5236. ⓪(jsr    LastCR           ;wieder zurⁿck, damit Bildschirm immer voll
  5237. ⓪(bra    zcr
  5238. ⓪ korr    move.l a0,(a3)+
  5239. ⓪ END
  5240. ⓪ END ScreenTop;
  5241. ⓪ 
  5242. ⓪ PROCEDURE ScreenTop1: ADDRESS;  (* geht nur nach oben, sonst Fehler bei *)
  5243. ⓪ BEGIN                           (* Mausaktion auf letzter Seite (Hü)    *)
  5244. ⓪ ASSEMBLER
  5245. ⓪(move.l ptr,a0           ;aktueller Ptr
  5246. ⓪(move   ptrLine,d1       ;aktuelle Zeile
  5247. ⓪(beq    zero
  5248. ⓪ subl    subq   #1,d1
  5249. ⓪(beq    zero
  5250. ⓪(jsr    LastCR           ;ein CR zurück
  5251. ⓪(bra    subl
  5252. ⓪ zero    move.l a0,(a3)+
  5253. ⓪ END
  5254. ⓪ END ScreenTop1;
  5255. ⓪ 
  5256. ⓪ PROCEDURE ScreenTop2: ADDRESS;
  5257. ⓪"BEGIN
  5258. ⓪$ASSEMBLER
  5259. ⓪(jsr    screentop1
  5260. ⓪(move.l -(a3),a0
  5261. ⓪(jsr    lineSt
  5262. ⓪(move.l a0,(a3)+
  5263. ⓪$END
  5264. ⓪"END ScreenTop2;
  5265. ⓪ 
  5266. ⓪ PROCEDURE ScreenBottom: ADDRESS;
  5267. ⓪ BEGIN
  5268. ⓪ ASSEMBLER
  5269. ⓪(move.l ptr,a0
  5270. ⓪(move   ptrLine,d1
  5271. ⓪ pcr     cmp    maxLine,d1       ;bis in letzte Bildschirmzeile vorpirschen
  5272. ⓪(bhi    zcr0
  5273. ⓪(jsr    NextCR
  5274. ⓪(addq   #1,d1
  5275. ⓪(bra    pcr
  5276. ⓪ zcr0    move.l a0,(a3)+
  5277. ⓪ END
  5278. ⓪ END ScreenBottom;
  5279. ⓪ 
  5280. ⓪ 
  5281. ⓪ (*$l-*)
  5282. ⓪ PROCEDURE HardCopyFromTo(a,b:ADDRESS; fwd:BOOLEAN);
  5283. ⓪"PROCEDURE timeOut;
  5284. ⓪$BEGIN
  5285. ⓪&PutCmd ('Printer: Timeout');Bell;ErrorWait;
  5286. ⓪$END timeOut;
  5287. ⓪"BEGIN
  5288. ⓪$ASSEMBLER
  5289. ⓪(MOVEM.L D3/D4/A4/A5,-(A7)
  5290. ⓪(MOVE    -(A3),D3
  5291. ⓪(MOVE.L  -(A3),A5
  5292. ⓪(MOVE.L  -(A3),A4
  5293. ⓪(MOVEQ   #CRChar,D0
  5294. ⓪(BRA     print
  5295. ⓪ 
  5296. ⓪&get
  5297. ⓪(TST     D3
  5298. ⓪(BNE     forw
  5299. ⓪(CMPA.L  A4,A5
  5300. ⓪(BLS     noget
  5301. ⓪(MOVE.B  -(A5),D0
  5302. ⓪(RTS
  5303. ⓪&forw
  5304. ⓪(CMPA.L  A5,A4
  5305. ⓪(BCC     noget
  5306. ⓪(MOVE.B  (A4)+,D0
  5307. ⓪(RTS
  5308. ⓪&noget
  5309. ⓪(CLR     D0
  5310. ⓪(RTS
  5311. ⓪ 
  5312. ⓪&prn
  5313. ⓪(MOVE.W  D0,-(A7)
  5314. ⓪(MOVE    #5,-(A7)
  5315. ⓪(TRAP    #1
  5316. ⓪(ADDQ.L  #4,A7
  5317. ⓪(TST.W   D0
  5318. ⓪(RTS
  5319. ⓪ 
  5320. ⓪&again
  5321. ⓪(JSR     KeyPressed
  5322. ⓪(TST     -(A3)
  5323. ⓪(BEQ     nokey
  5324. ⓪(JSR     GetKeyD0
  5325. ⓪(CMPI.B  #EscKey,D0
  5326. ⓪(BEQ     ende
  5327. ⓪&noKey
  5328. ⓪(BSR     get
  5329. ⓪(BEQ     ende
  5330. ⓪(CMPI.B  #CRChar,D0
  5331. ⓪(BNE     nocr
  5332. ⓪(BSR     prn
  5333. ⓪(BEQ     timeout0
  5334. ⓪(MOVEQ   #LFChar,D0
  5335. ⓪(BRA     print
  5336. ⓪&nocr
  5337. ⓪(CMPI.B  #DLEChar,D0
  5338. ⓪(BNE     print
  5339. ⓪(BSR     get
  5340. ⓪(BEQ     ende
  5341. ⓪(SUBI.B  #' ',D0
  5342. ⓪(BCS     again
  5343. ⓪(CLR     D4
  5344. ⓪(MOVE.B  D0,D4
  5345. ⓪(BRA     pdle
  5346. ⓪&ldle
  5347. ⓪(MOVEQ   #' ',D0
  5348. ⓪(BSR     prn
  5349. ⓪(BEQ     timeout0
  5350. ⓪&pdle
  5351. ⓪(DBRA    D4,ldle
  5352. ⓪(BRA     again
  5353. ⓪&print
  5354. ⓪(BSR     prn
  5355. ⓪(BNE     again
  5356. ⓪&timeout0
  5357. ⓪(BSR     timeOut
  5358. ⓪(BRA     ret
  5359. ⓪&ende
  5360. ⓪(MOVEQ   #CRChar,D0
  5361. ⓪(BSR     prn
  5362. ⓪(BEQ     ret
  5363. ⓪(MOVEQ   #LFChar,D0
  5364. ⓪(BSR     prn
  5365. ⓪&ret
  5366. ⓪(MOVEM.L (A7)+,D3/D4/A4/A5
  5367. ⓪$END
  5368. ⓪"END HardCopyFromTo;
  5369. ⓪ 
  5370. ⓪ (*$l+*)
  5371. ⓪ PROCEDURE HardCopy;
  5372. ⓪ BEGIN
  5373. ⓪"PutCmd('HardCopy: S(creen, B(uffer, A(ll');
  5374. ⓪"ReadUpCh;
  5375. ⓪"IF ch='S' THEN HardCopyFromTo(ScreenTop2(),ScreenBottom(),true)
  5376. ⓪"ELSIF ch='B' THEN HardCopyFromTo(bufferL,bufferH,false)
  5377. ⓪"ELSIF ch='A' THEN HardCopyFromTo(ptrStart,ptrEnd,true)
  5378. ⓪"END
  5379. ⓪ END HardCopy;
  5380. ⓪ 
  5381. ⓪ PROCEDURE wrNotSaved;
  5382. ⓪"BEGIN
  5383. ⓪$WriteString('Last changes have not been saved yet!')
  5384. ⓪"END wrNotSaved;
  5385. ⓪ 
  5386. ⓪ (*$l+*)
  5387. ⓪ PROCEDURE Environment;
  5388. ⓪"PROCEDURE OnOff(x:BOOLEAN);
  5389. ⓪"(*$l-*)
  5390. ⓪"BEGIN
  5391. ⓪$ASSEMBLER tst -(a3) bne on moveq #'f',d0 jsr ChrOut bra on1
  5392. ⓪$on moveq #'n',d0 on1 jsr ChrOut jmp WriteLn
  5393. ⓪$END
  5394. ⓪"END OnOff;
  5395. ⓪"(*$l+*)
  5396. ⓪"VAR sTime:STRING; tabString:String; i:CARDINAL; tg: CHAR;
  5397. ⓪ BEGIN
  5398. ⓪"LOOP
  5399. ⓪$Write(ClrScrnChar);
  5400. ⓪$writeTitle;
  5401. ⓪$IF NOT saved THEN
  5402. ⓪&wrNotSaved;
  5403. ⓪$ELSE
  5404. ⓪&WriteString ("Editor's internal version: ");
  5405. ⓪&WriteString (intVersion);
  5406. ⓪$END;
  5407. ⓪$WriteLn;
  5408. ⓪$WriteLn;
  5409. ⓪$WriteString('Filename: ');WriteString(fileName); WriteLn;
  5410. ⓪$WriteString(' last update: '); DateToText (UnpackDate (fileD), '', sTime); WriteString(sTime);
  5411. ⓪$WriteString(' / '); TimeToText (UnpackTime (fileT), '', sTime); WriteString(sTime); WriteLn;
  5412. ⓪$IF restoreFileDT THEN
  5413. ⓪&WriteString (' last code: '); WriteString (CodeName); WriteString (', '); WriteString (CardToStr (Codesize,0)); WriteString (' bytes'); WriteLn;
  5414. ⓪$END;
  5415. ⓪$WriteLn;
  5416. ⓪$WriteString('O(ld: ');WriteString(oldString);WriteLn;
  5417. ⓪$WriteString('N(ew: ');WriteString(newString);WriteLn;
  5418. ⓪$WriteString('F(lip Old and New');WriteLn;
  5419. ⓪$WriteLn;
  5420. ⓪$WriteString('A(uto backup is o'); OnOff(autoBack);
  5421. ⓪$WriteString('C(ase sensitivity is o'); OnOff(findCase);
  5422. ⓪$WriteString('I(ncrement version is o'); OnOff(autoIncVer);
  5423. ⓪$WriteString('Q(uick save & load is o'); OnOff(leaveDLEonWrite);
  5424. ⓪$WriteString('S(ave <Editor-Info-Line> is o'); OnOff(saveInfo);
  5425. ⓪$WriteLn;
  5426. ⓪$WriteString('Tags: ');
  5427. ⓪$FOR tg:='0' TO 'Z' DO
  5428. ⓪&IF (ptrStart<tags[tg]) & (tags[tg]<ptrEnd) THEN
  5429. ⓪(Write(tg)
  5430. ⓪&ELSE
  5431. ⓪(Write(' ')
  5432. ⓪&END
  5433. ⓪$END;
  5434. ⓪$WriteLn;
  5435. ⓪$WriteLn;
  5436. ⓪$WriteString('T(ab setting'); WriteLn;
  5437. ⓪$tabString:=TabsToStr(); WriteString(tabString); WriteLn;
  5438. ⓪$WriteLn;
  5439. ⓪$WriteString('Enter option: '); ReadUpCh; WriteLn;
  5440. ⓪$IF    ch='A' THEN Negate(autoBack)
  5441. ⓪$ELSIF ch='C' THEN Negate(findCase)
  5442. ⓪$ELSIF ch='F' THEN Flip(oldString,newString)
  5443. ⓪$ELSIF ch='I' THEN Negate(autoIncVer)
  5444. ⓪$ELSIF ch='Q' THEN Negate(leaveDLEonWrite)
  5445. ⓪$ELSIF ch='S' THEN Negate(saveInfo)
  5446. ⓪$ELSIF ch='N' THEN WriteString('New: ');ReadString(newString)
  5447. ⓪$ELSIF ch='O' THEN WriteString('Old: ');ReadString(oldString)
  5448. ⓪$ELSIF ch='T' THEN ReadString(tabString);GetTabs(tabString);
  5449. ⓪$ELSIF ch='X' THEN
  5450. ⓪&makeDLE:=FALSE; CleanText; makeDLE:=TRUE; CleanText;
  5451. ⓪&ChkLastPtr; ptr:= ptrStart; CenterScreen
  5452. ⓪$ELSE EXIT
  5453. ⓪$END
  5454. ⓪"END;
  5455. ⓪"ScreenOut;
  5456. ⓪"cmdFlag:=false
  5457. ⓪ END Environment;
  5458. ⓪ 
  5459. ⓪ 
  5460. ⓪ FORWARD CloseTextFrame;
  5461. ⓪ 
  5462. ⓪ (*$l+*)
  5463. ⓪ PROCEDURE QuitEditor;           (* Q(uit- Untermenⁿ *)
  5464. ⓪"VAR fn:STRING; show,sWarn:BOOLEAN; p:CARDINAL;
  5465. ⓪ BEGIN
  5466. ⓪"ClrKBDbuffer;
  5467. ⓪"fn:= '';
  5468. ⓪"cmdFlag:=false;
  5469. ⓪"show:=true; sWarn:=false;
  5470. ⓪"Write(ClrScrnChar);
  5471. ⓪"LOOP
  5472. ⓪$IF show THEN
  5473. ⓪&GotoXY(0,0);
  5474. ⓪&IF saveinfo THEN WriteString('Editor Info-Line will be saved') END;
  5475. ⓪&ClrLn;
  5476. ⓪&IF leaveDLEonWrite THEN WriteString('Quick save is active') END;
  5477. ⓪&ClrLn;
  5478. ⓪&ClrLn;
  5479. ⓪&IF NOT saved AND Worthy() THEN
  5480. ⓪(wrNotSaved
  5481. ⓪&END;
  5482. ⓪&ClrLn;
  5483. ⓪&ClrLn;
  5484. ⓪&WriteString ('Filename: '); WriteString (fileName); ClrLn;
  5485. ⓪&ClrLn;
  5486. ⓪&WriteString('E(xit'); ClrLn;
  5487. ⓪&WriteString('I(ncrement'); ClrLn;
  5488. ⓪&WriteString  ('U(pdate  (Save & Exit)'); ClrLn;
  5489. ⓪&IF filesInMem=0 THEN
  5490. ⓪(WriteString('C(ompile (Update & Compile)'); ClrLn;
  5491. ⓪(WriteString('X(exute  (Execute)'); ClrLn;
  5492. ⓪(WriteString('M(ake    (Update & Make)'); ClrLn;
  5493. ⓪(WriteString('R(un     (Make & Execute)'); ClrLn;
  5494. ⓪&END;
  5495. ⓪&WriteString('S(ave'); ClrLn;
  5496. ⓪&WriteString('B(ack up and save'); ClrLn;
  5497. ⓪&WriteString('K(eep time stamp and save'); ClrLn;
  5498. ⓪&WriteString('W(rite to a file...'); ClrLn;
  5499. ⓪&WriteString('N(ew filename...'); ClrLn;
  5500. ⓪&WriteString('O(ther filename, no save...'); ClrLn;
  5501. ⓪&WriteString('ESC to return'); ClrLn;
  5502. ⓪&show:=false
  5503. ⓪$END;
  5504. ⓪$GoToXY(0,21);
  5505. ⓪$ReadUpCh; IF ch> ' ' THEN Write(ch) END;
  5506. ⓪$Write(ClrEOSchar);
  5507. ⓪$IF (ch=ESCkey) OR (ch=EnterKey) THEN EXIT
  5508. ⓪$ELSIF ch='I' THEN WriteString (IncrementVersion())
  5509. ⓪$ELSIF ch='E' THEN
  5510. ⓪&saved:=saved OR NOT Worthy();
  5511. ⓪&IF NOT saved THEN WriteLn;
  5512. ⓪(WriteString('Throw away changes since last update? ');
  5513. ⓪(saved:=Yes()
  5514. ⓪&END;
  5515. ⓪&IF saved THEN
  5516. ⓪(IF filesInMem=0 THEN endOfEd:=true ELSE CloseTextFrame END;
  5517. ⓪(EXIT
  5518. ⓪&END
  5519. ⓪$ELSIF ch='W' THEN WriteLn;
  5520. ⓪&(* WriteString('Write file: '); ReadString(fn); *)
  5521. ⓪&fn:=getFilefromBox('Write file:');
  5522. ⓪&show:=true;
  5523. ⓪&IF NOT abort & ChkName(fn) & SaveText(fn,false,true,false) THEN END
  5524. ⓪$ELSIF ch='O' THEN WriteLn;
  5525. ⓪&(* WriteString('Other filename: '); ReadString(fn); *)
  5526. ⓪&fn:=getFilefromBox('Other filename:');
  5527. ⓪&show:=true;
  5528. ⓪&IF NOT abort & ChkName(fn) THEN
  5529. ⓪(Flip(fn,fileName); sWarn:=true
  5530. ⓪&END
  5531. ⓪$ELSIF ch='N' THEN WriteLn;
  5532. ⓪&(* WriteString('New filename: '); ReadString(fn); *)
  5533. ⓪&fn:=getFilefromBox('New filename:');
  5534. ⓪&show:=true;
  5535. ⓪&IF NOT abort & ChkName(fn) & SaveText(fn,false,true,false) THEN
  5536. ⓪(Assign (fn,TextName,strok);
  5537. ⓪(Flip(fn,fileName);
  5538. ⓪&END
  5539. ⓪$ELSIF Length(fileName)>0 THEN
  5540. ⓪&IF (ch='S') OR (ch='K') THEN
  5541. ⓪(IF SaveText(fileName,false,sWarn,ch='K') THEN
  5542. ⓪*Assign (filename,TextName,strok);
  5543. ⓪(END
  5544. ⓪&ELSIF (ch='U')
  5545. ⓪&OR (
  5546. ⓪((filesInMem=0) & ( (ch='C') OR (ch='X') OR (ch='M') OR (ch='R') )
  5547. ⓪&) THEN
  5548. ⓪(IF SaveText(fileName,false,sWarn,false) THEN
  5549. ⓪*Assign (filename,TextName,strok);
  5550. ⓪*IF filesInMem=0 THEN
  5551. ⓪,endOfEd:=true;
  5552. ⓪,IF ch='C' THEN
  5553. ⓪.exitCode:= 1
  5554. ⓪,ELSIF ch='X' THEN
  5555. ⓪.exitCode:= 2
  5556. ⓪,ELSIF ch='M' THEN
  5557. ⓪.exitCode:= 3
  5558. ⓪,ELSIF ch='R' THEN
  5559. ⓪.exitCode:= 4
  5560. ⓪,END
  5561. ⓪*ELSE
  5562. ⓪,CloseTextFrame
  5563. ⓪*END;
  5564. ⓪*EXIT
  5565. ⓪(END
  5566. ⓪&ELSIF ch='B' THEN
  5567. ⓪(IF SaveText(fileName,true,false,false) THEN
  5568. ⓪*Assign (filename,TextName,strok);
  5569. ⓪(END
  5570. ⓪&END
  5571. ⓪$END
  5572. ⓪"END;
  5573. ⓪"IF NOT endOfEd THEN
  5574. ⓪$IF ~makeDLE THEN
  5575. ⓪&makeDLE:= True;
  5576. ⓪&WriteLn;
  5577. ⓪&WriteString ('please wait...');
  5578. ⓪&Cleantext;
  5579. ⓪$END;
  5580. ⓪$ScreenOut
  5581. ⓪"END
  5582. ⓪ END QuitEditor;
  5583. ⓪ 
  5584. ⓪ (*$l+*)
  5585. ⓪ PROCEDURE OpenTextFrame;
  5586. ⓪ BEGIN
  5587. ⓪"IF (bufferL-ptrEnd<1500L) THEN
  5588. ⓪$PutCmd('Not enough memory for text-frame'); Bell; ErrorWait
  5589. ⓪"ELSE
  5590. ⓪$ASSEMBLER
  5591. ⓪,jsr     finish
  5592. ⓪,move.l  ptrEnd,d0
  5593. ⓪,addq.l  #3,d0
  5594. ⓪,bclr    #0,d0
  5595. ⓪,move.l  d0,a0
  5596. ⓪,move.l  total,(a0)+
  5597. ⓪,move    direction,(a0)+
  5598. ⓪,move    saved,(a0)+
  5599. ⓪,move    saveinfo,(a0)+
  5600. ⓪,move    makeDLE,(a0)+
  5601. ⓪,move    leaveDLEonWrite,(a0)+
  5602. ⓪,move    findCase,(a0)+
  5603. ⓪,move    autoBack,(a0)+
  5604. ⓪,move    autoIncVer,(a0)+
  5605. ⓪,move.l  errorpos,(a0)+
  5606. ⓪,lea     ptrStack,A1
  5607. ⓪,moveq   #58,d0
  5608. ⓪$allptr  move.l  (A1)+,(a0)+
  5609. ⓪,dbf     d0,allptr
  5610. ⓪,lea     filename,A1
  5611. ⓪,moveq   #40,d0
  5612. ⓪$allfn   move    (A1)+,(a0)+
  5613. ⓪,dbf     d0,allfn
  5614. ⓪,lea     tabs,A1
  5615. ⓪,moveq   #40,d0
  5616. ⓪$alltab  move    (A1)+,(a0)+
  5617. ⓪,dbf     d0,alltab
  5618. ⓪,move    nrOfTabs,(a0)+
  5619. ⓪,move    ptrLine,(a0)+
  5620. ⓪,move    ptrCount,(a0)+
  5621. ⓪,move    fileD,(a0)+
  5622. ⓪,move    fileT,(a0)+
  5623. ⓪,move    restoreFileDT,(a0)+
  5624. ⓪,move.l  ptr,(a0)+
  5625. ⓪,move.l  lastPtr,(a0)+
  5626. ⓪,move.l  ptrStart,(a0)+
  5627. ⓪,move.l  ptrEnd,(a0)+
  5628. ⓪,clr     (a0)+
  5629. ⓪,
  5630. ⓪,addq    #1,filesInMem
  5631. ⓪,move.l  a0,ptrStart
  5632. ⓪,move.b  #DLEchar,(a0)+
  5633. ⓪,move.b  #DLEoffset,(a0)+
  5634. ⓪,move.l  a0,ptr
  5635. ⓪,move.l  a0,lastPtr
  5636. ⓪,clr     (a0)+
  5637. ⓪,move.l  a0,ptrEnd
  5638. ⓪,clr.l   (a0)+
  5639. ⓪,moveq #58,d0 lea ptrStack,a0 lp clr.l (a0)+ dbf d0,lp
  5640. ⓪,jsr      ResetTextOptions
  5641. ⓪,clr.b fileName
  5642. ⓪,clr delFlag clr insFlag clr.l total
  5643. ⓪,jsr Prepare
  5644. ⓪,move.l d0,startupTime clr.l errorpos
  5645. ⓪,move #1,ptrLine jsr ScreenOut
  5646. ⓪$END
  5647. ⓪"END
  5648. ⓪ END OpenTextFrame;
  5649. ⓪ 
  5650. ⓪ (*$l+*)
  5651. ⓪ PROCEDURE CloseTextFrame;
  5652. ⓪ BEGIN
  5653. ⓪"saved:=saved OR NOT Worthy();
  5654. ⓪"IF filesInMem=0 THEN
  5655. ⓪$PutCmd('No old text frame to close'); Errorwait; RETURN
  5656. ⓪"ELSIF NOT saved THEN
  5657. ⓪$ClrCmdLine;
  5658. ⓪$WriteString('Close text frame: Throw away changes ? ');
  5659. ⓪$IF NOT Yes() THEN GoToPtr; RETURN END
  5660. ⓪"END;
  5661. ⓪"ASSEMBLER
  5662. ⓪*move.l  ptrStart,a0
  5663. ⓪*subq.l  #2,a0
  5664. ⓪*move.l  -(a0),ptrEnd
  5665. ⓪*move.l  -(a0),ptrStart
  5666. ⓪*move.l  -(a0),lastPtr
  5667. ⓪*move.l  -(a0),ptr
  5668. ⓪*move    -(a0),restoreFileDT
  5669. ⓪*move    -(a0),fileT
  5670. ⓪*move    -(a0),fileD
  5671. ⓪*move    -(a0),ptrCount
  5672. ⓪*move    -(a0),ptrLine
  5673. ⓪*move    -(a0),nrOfTabs
  5674. ⓪*moveq   #40,d0
  5675. ⓪*lea     tabs,A1
  5676. ⓪*lea     82(A1),A1
  5677. ⓪"alltab  move    -(a0),-(A1)
  5678. ⓪*dbf     d0,alltab
  5679. ⓪*moveq   #40,d0
  5680. ⓪*lea     filename,A1
  5681. ⓪*lea     82(A1),A1
  5682. ⓪"allfn   move    -(a0),-(A1)
  5683. ⓪*dbf     d0,allfn
  5684. ⓪*moveq   #58,d0
  5685. ⓪*lea     ptrStack,A1
  5686. ⓪*lea     236(A1),A1
  5687. ⓪"allptr  move.l  -(a0),-(A1)
  5688. ⓪*dbf     d0,allptr
  5689. ⓪*move.l  -(a0),errorpos
  5690. ⓪*move    -(a0),autoIncVer
  5691. ⓪*move    -(a0),autoBack
  5692. ⓪*move    -(a0),findCase
  5693. ⓪*move    -(a0),leaveDLEonWrite
  5694. ⓪*move    -(a0),makeDLE
  5695. ⓪*move    -(a0),saveinfo
  5696. ⓪*move    -(a0),saved
  5697. ⓪*move    -(a0),direction
  5698. ⓪*move.l  -(a0),total
  5699. ⓪*jsr     Prepare
  5700. ⓪*move.l  d0,startupTime
  5701. ⓪*subq    #1,filesInMem
  5702. ⓪"END
  5703. ⓪ END CloseTextFrame;
  5704. ⓪ 
  5705. ⓪ 
  5706. ⓪ (*$? mayCallCompiler:
  5707. ⓪ 
  5708. ⓪ TYPE
  5709. ⓪(Header = RECORD
  5710. ⓪3LayoutNr : BYTE;
  5711. ⓪3Id : BYTE;
  5712. ⓪3QualificationFlag : CARDINAL;
  5713. ⓪3Key : LONGCARD;
  5714. ⓪3OffsExTree : ADDRESS;
  5715. ⓪3DefinedItems : CARDINAL;
  5716. ⓪3OffsImpList : ADDRESS;
  5717. ⓪3VarSize : LONGCARD;
  5718. ⓪3ModName : ADDRESS
  5719. ⓪1END;
  5720. ⓪ 
  5721. ⓪(
  5722. ⓪(TreeEntry = RECORD
  5723. ⓪6OffsNextItemNr: CARDINAL;
  5724. ⓪6Name: CHAR
  5725. ⓪4END;
  5726. ⓪ 
  5727. ⓪ (*$L-*)
  5728. ⓪ PROCEDURE CompName (ad: ADDRESS): MaxStr;
  5729. ⓪"BEGIN
  5730. ⓪$ASSEMBLER
  5731. ⓪(MOVE.L  -(A3),A0
  5732. ⓪(MOVE.L  A3,A2
  5733. ⓪(LEA     256(A3),A3
  5734. ⓪"CopyHelpStr
  5735. ⓪(MOVE.B  (A0)+,D0
  5736. ⓪(BEQ     EndCopy
  5737. ⓪(CMPI.B  #$FE,D0
  5738. ⓪(BCC     EndCopy
  5739. ⓪(MOVE.B  D0,(A2)+
  5740. ⓪(BRA     CopyHelpStr
  5741. ⓪"EndCopy
  5742. ⓪(CLR.B   (A2)+
  5743. ⓪$END
  5744. ⓪"END CompName;
  5745. ⓪ 
  5746. ⓪ VAR defFile: File; size: LONGCARD;
  5747. ⓪$returnVal: BOOLEAN;
  5748. ⓪ 
  5749. ⓪ (*$L+*)
  5750. ⓪ PROCEDURE Process;
  5751. ⓪ 
  5752. ⓪"VAR str: POINTER TO ARRAY [0..7] OF CHAR;
  5753. ⓪&first, continue, success: BOOLEAN;
  5754. ⓪&Data: POINTER TO Header;
  5755. ⓪&helpString: String;
  5756. ⓪&BytesRead: LONGCARD;
  5757. ⓪&modName: ADDRESS;
  5758. ⓪ 
  5759. ⓪ BEGIN
  5760. ⓪"(* Process File *)
  5761. ⓪"Home;
  5762. ⓪"IF (bufferL - ptrEnd < size + 1500L) THEN
  5763. ⓪$WriteString ('Insufficient memory!');
  5764. ⓪$ReadCh;
  5765. ⓪$returnVal:= FALSE;
  5766. ⓪$RETURN
  5767. ⓪"END;
  5768. ⓪"Data:= ptrEnd + 4L; (* leave some bytes unused for security resons *)
  5769. ⓪"ReadBytes (defFile, Data, size, BytesRead);
  5770. ⓪"IF BytesRead # size THEN
  5771. ⓪$(* if not all bytes read exit *)
  5772. ⓪$WriteString ('Read error!');
  5773. ⓪$ReadCh;
  5774. ⓪$returnVal:= TRUE;
  5775. ⓪$RETURN
  5776. ⓪"END;
  5777. ⓪"str:= ADDRESS (Data);
  5778. ⓪"INC (Data,8);
  5779. ⓪"IF (Compare (str^, "MM2Code") # equal) OR (Data^.ID # BYTE (3)) THEN
  5780. ⓪$(* not a DEF file *)
  5781. ⓪$returnVal:= TRUE;
  5782. ⓪$RETURN
  5783. ⓪"END;
  5784. ⓪"(* display modname *)
  5785. ⓪"modName:= ADDRESS(Data)+Data^.ModName;
  5786. ⓪"WriteString (CompName (modName));
  5787. ⓪"continue:= TRUE;      (* default: scan next file *)
  5788. ⓪"first:= TRUE;         (* first check the modname itself *)
  5789. ⓪"(* scan list of exported items *)
  5790. ⓪"ASSEMBLER
  5791. ⓪(; Cursorpos. merken
  5792. ⓪(move   ptrY,d0
  5793. ⓪(move.b ptrX,d0
  5794. ⓪(move   d0,yx
  5795. ⓪(MOVE.L  modName(A6),A1
  5796. ⓪(BRA.W   searchStart
  5797. ⓪(
  5798. ⓪"CaseSen
  5799. ⓪(; put next character of item-name in D0 and next of oldString in D1,
  5800. ⓪(; increment index.
  5801. ⓪(MOVE.B  0(A1,D2.W),D0
  5802. ⓪(MOVE.B  0(A2,D2.W),D1
  5803. ⓪(ADDQ.W  #1,D2
  5804. ⓪(RTS
  5805. ⓪"NoCaseSen
  5806. ⓪(; same as CaseSen, but characters are converted to capitals.
  5807. ⓪(CLR     D0
  5808. ⓪(MOVE.B  0(A2,D2.W),D0
  5809. ⓪(MOVE.B  0(A4,D0.W),D0
  5810. ⓪(MOVE.W  D0,D1
  5811. ⓪(MOVE.B  0(A1,D2.W),D0
  5812. ⓪(MOVE.B  0(A4,D0.W),D0
  5813. ⓪(ADDQ.W  #1,D2
  5814. ⓪(RTS
  5815. ⓪"
  5816. ⓪"ItemFound
  5817. ⓪(BSR.W   showItem
  5818. ⓪(BNE     CmpFailed
  5819. ⓪"endOfTree
  5820. ⓪(RTS
  5821. ⓪(
  5822. ⓪"CompNext
  5823. ⓪(MOVE.W  (A0)+,D0                        ; modul-lokale Item-Nr
  5824. ⓪(BEQ.L   endOfTree
  5825. ⓪(LEA     2(A0),A1
  5826. ⓪"CompFirst
  5827. ⓪(MOVEQ   #0,D2                           ; D2 := index in strings
  5828. ⓪"CmpNext
  5829. ⓪(JSR     (A5)                            ; get next characters in D0/D1
  5830. ⓪(TST.B   D0
  5831. ⓪(BEQ.W   ItemEnd
  5832. ⓪(CMP.B   #$FE,D0                         ; check end of item-name
  5833. ⓪(BCC.W   ItemEnd                         ; end of name
  5834. ⓪(CMP.B   D0,D1
  5835. ⓪(BEQ     CmpNext                         ; equal -> continue with next
  5836. ⓪(TST.B   D1
  5837. ⓪(BNE     CmpFailed
  5838. ⓪(TST.W   findWord
  5839. ⓪(BNE     CmpFailed
  5840. ⓪(BRA.W   ItemFound
  5841. ⓪"ItemEnd
  5842. ⓪(; End of name of item is reached. if also end of oldString ->
  5843. ⓪(; item is correct.
  5844. ⓪(TST.B   D1
  5845. ⓪(BEQ.W   ItemFound
  5846. ⓪"CmpFailed
  5847. ⓪(; skip to next item and continue search
  5848. ⓪(TST.W   first(A6)
  5849. ⓪(BEQ     notFirst
  5850. ⓪(CLR.W   first(A6)
  5851. ⓪(MOVE.L  Data(A6),A0                     ; A0 := pointer to header
  5852. ⓪(MOVE.L  Header.OffsExTree(A0),D0        ; D0 := offset to list of items
  5853. ⓪(BEQ.L   endOfTree                       ; no exported items
  5854. ⓪(ADDA.L  D0,A0                           ; A0 := pointer to list of items
  5855. ⓪(BRA     CompNext
  5856. ⓪"notFirst
  5857. ⓪(ADDQ.B  #1,D0
  5858. ⓪(BEQ     endOfName
  5859. ⓪(ADDA.W  D2,A1
  5860. ⓪"luup2 MOVE.B  (A1)+,D0
  5861. ⓪(BPL     luup2
  5862. ⓪(ADDQ.B  #1,D0
  5863. ⓪(BNE     luup2
  5864. ⓪"endOfName
  5865. ⓪(CMPI.B  #13,1(A1)
  5866. ⓪(BNE     noRecord
  5867. ⓪(
  5868. ⓪(; lokalen Record-Baum durchsuchen
  5869. ⓪(MOVE.L  A0,-(A7)
  5870. ⓪(LEA     8(A1),A0
  5871. ⓪(BSR     CompNext
  5872. ⓪(MOVE.L  (A7)+,A0
  5873. ⓪(TST     continue(A6)
  5874. ⓪(BEQ     endOfTree
  5875. ⓪(
  5876. ⓪"noRecord
  5877. ⓪(MOVE.W  TreeEntry.OffsNextItemNr(A0),D0 ; offset to next item
  5878. ⓪(BEQ.L   endOfTree
  5879. ⓪(ADDA.W  D0,A0
  5880. ⓪(BRA     CompNext
  5881. ⓪(
  5882. ⓪"writeName
  5883. ⓪(LEA     helpString(A6),A2
  5884. ⓪(CLR     D1
  5885. ⓪"CopyHelpStr
  5886. ⓪(MOVE.B  (A1)+,D0
  5887. ⓪(BEQ     EndCopy
  5888. ⓪(CMPI.B  #$FE,D0
  5889. ⓪(BCC     EndCopy
  5890. ⓪(ADDQ    #1,D1
  5891. ⓪(MOVE.B  D0,(A2)+
  5892. ⓪(BRA     CopyHelpStr
  5893. ⓪"EndCopy
  5894. ⓪(CLR.B   (A2)+
  5895. ⓪(MOVE.B  #'.',D0
  5896. ⓪(JSR     ChrOut                          ; write '.'
  5897. ⓪(LEA     helpString(A6),A2
  5898. ⓪(MOVE.L  A2,(A3)+
  5899. ⓪(MOVE.W  D1,(A3)+
  5900. ⓪(JMP     BufferWrite                     ; write helpString
  5901. ⓪"
  5902. ⓪"wrn   ; Namen auf Stack rückwärts ausgeben
  5903. ⓪(MOVE.L  4(A0),D0
  5904. ⓪(BEQ     wrn3
  5905. ⓪(MOVE.L  A1,-(A7)
  5906. ⓪(MOVE.L  D0,A1
  5907. ⓪(ADDQ.L  #2,A1
  5908. ⓪(ADDQ.L  #8,A0
  5909. ⓪(BSR     wrn
  5910. ⓪(MOVE.L  (A7)+,A1
  5911. ⓪"wrn3  BRA     writeName
  5912. ⓪ 
  5913. ⓪ 
  5914. ⓪"showItem
  5915. ⓪(; search successful
  5916. ⓪(MOVEM.L A0/A2/A5,-(A7)
  5917. ⓪(TST.W   first(A6)
  5918. ⓪(BNE     NoNam
  5919. ⓪(LEA     16(A7),A0
  5920. ⓪(BSR     wrn
  5921. ⓪"NoNam JSR     Bell
  5922. ⓪(MOVE.B  #' ',D0
  5923. ⓪(JSR     ChrOut                          ; write ' '
  5924. ⓪(MOVE.B  #'?',D0
  5925. ⓪(JSR     ChrOut                          ; write '?'
  5926. ⓪(JSR     ReadCh                          ; get input
  5927. ⓪(TST     abort
  5928. ⓪(BNE     FindEnd                         ; ESC -> abort
  5929. ⓪(TST     accept
  5930. ⓪(BNE     FindEnd                         ; F1 -> load
  5931. ⓪(MOVE.B  ch,D0
  5932. ⓪(CMPI.B  #EnterKey,D0
  5933. ⓪(BEQ     FindEnd
  5934. ⓪(JSR     ShiftUp                         ; convert to capitals
  5935. ⓪(CMPI.B  #'Y',D0
  5936. ⓪(BNE     ContSearch
  5937. ⓪"FindEnd
  5938. ⓪(; User wants to load this def.-module
  5939. ⓪(CLR     continue(A6)
  5940. ⓪"ContSearch
  5941. ⓪(MOVE    yx,d1
  5942. ⓪(JSR     GotoXYd1
  5943. ⓪(MOVEQ   #ClrEOLNchar,d0
  5944. ⓪(JSR     ChrOut
  5945. ⓪(MOVEM.L (A7)+,A0/A2/A5
  5946. ⓪(TST     continue(A6)
  5947. ⓪(RTS
  5948. ⓪ 
  5949. ⓪"searchStart
  5950. ⓪(MOVE.L  A4,-(A7)
  5951. ⓪(MOVE.L  A5,-(A7)                        ; save A5
  5952. ⓪(LEA     ShiftTab,A4
  5953. ⓪(LEA     NoCaseSen(PC),A5
  5954. ⓪(TST.W   findCase
  5955. ⓪(BEQ     StartSearch2                    ; not case sensitive
  5956. ⓪(LEA     CaseSen(PC),A5
  5957. ⓪"StartSearch2
  5958. ⓪(LEA     oldString,A2                    ; A2 := pointer to oldString
  5959. ⓪(CLR.L   -(A7)
  5960. ⓪(BSR     CompFirst
  5961. ⓪(ADDQ.L  #4,A7
  5962. ⓪(MOVE.L  (A7)+,A5                        ; restore A5
  5963. ⓪(MOVE.L  (A7)+,A4
  5964. ⓪"END;
  5965. ⓪"IF ~continue & ~abort THEN
  5966. ⓪$modNameFound:= first;
  5967. ⓪$oldString:= helpString;
  5968. ⓪$defFound:= TRUE
  5969. ⓪"END;
  5970. ⓪"returnVal:= continue
  5971. ⓪ END Process;
  5972. ⓪ 
  5973. ⓪ PROCEDURE ProcessDefFile (defFile0: File; size0: LONGCARD): BOOLEAN;
  5974. ⓪"VAR exc:Exception;
  5975. ⓪"BEGIN
  5976. ⓪$defFile:= defFile0;
  5977. ⓪$size:= size0;
  5978. ⓪$Call (Process, exc);
  5979. ⓪$RETURN returnVal
  5980. ⓪"END ProcessDefFile;
  5981. ⓪ 
  5982. ⓪ (*$L+*)
  5983. ⓪ PROCEDURE ProcessDefFile1 (REF path : ARRAY OF CHAR; entry : DirEntry): BOOLEAN;
  5984. ⓪"VAR name: ARRAY [0..139] OF CHAR;
  5985. ⓪&f: File;
  5986. ⓪&cont: BOOLEAN;
  5987. ⓪"BEGIN
  5988. ⓪$Assign (path, name, success);
  5989. ⓪$Append (entry.name, name, success);
  5990. ⓪$Open (f, name, readOnly);
  5991. ⓪$cont:= ProcessDefFile (f, entry.size);
  5992. ⓪$IF defFound THEN Assign (entry.name, filename, success) END;
  5993. ⓪$Close (f);
  5994. ⓪$RETURN cont
  5995. ⓪"END ProcessDefFile1;
  5996. ⓪ 
  5997. ⓪ (*$L+*)
  5998. ⓪ PROCEDURE ProcessDefFile2 (entry : LibEntry) : BOOLEAN;
  5999. ⓪"VAR cont: BOOLEAN;
  6000. ⓪"BEGIN
  6001. ⓪$Seek (DefLibFile.f, entry.start, fromBegin);
  6002. ⓪$cont:= ProcessDefFile (DefLibFile.f, entry.size);
  6003. ⓪$IF defFound THEN Assign (entry.name, filename, success) END;
  6004. ⓪$RETURN cont
  6005. ⓪"END ProcessDefFile2;
  6006. ⓪ 
  6007. ⓪ (*$L+*)
  6008. ⓪ PROCEDURE FindDefinition;
  6009. ⓪ 
  6010. ⓪ VAR
  6011. ⓪(Entry : PathEntry;
  6012. ⓪(wild : ARRAY [1..141] OF CHAR;
  6013. ⓪(b2, success : BOOLEAN;
  6014. ⓪(result : INTEGER;
  6015. ⓪ 
  6016. ⓪ BEGIN
  6017. ⓪"IF (bufferL-ptrEnd<1500L) THEN
  6018. ⓪$PutCmd('Not enough memory for this function'); Bell; ErrorWait; RETURN
  6019. ⓪"END;
  6020. ⓪"(* determine identifier to be searched *)
  6021. ⓪"ASSEMBLER
  6022. ⓪(; code is copied from procedure look and modified
  6023. ⓪(move.l  ptr,a0
  6024. ⓪ fndna   cmpi.b  #DLEchar,-2(a0)         ; is it start of line ?
  6025. ⓪(beq     Lookit                  ; yes -> start of word found
  6026. ⓪(move.b  -1(a0),d0               ; get previous character
  6027. ⓪(beq     Lookit                  ; if it's zero -> start of word found
  6028. ⓪(jsr     AlphaNum
  6029. ⓪(bne     Lookit                  ; if it's no alphanum. -> start found
  6030. ⓪(subq.l  #1,a0                   ; search backwards
  6031. ⓪(bra     fndna
  6032. ⓪ Lookit
  6033. ⓪(; now copy whole word into oldString
  6034. ⓪(lea     oldString,A1            ; A1 := pointer to oldString
  6035. ⓪(moveq   #0,d6                   ; length of copied word
  6036. ⓪ Looklp  move.b  (a0)+,d0                ; get one char
  6037. ⓪(move.b  d0,d1                   ; save char
  6038. ⓪(jsr     AlphaNum        ;d1 bleibt erhalten
  6039. ⓪(bne     ex                      ; if it's not alphanum. -> word copied
  6040. ⓪(move.b  d1,0(A1,d6.w)           ; put char
  6041. ⓪(clr.b   1(A1,d6.w)              ; clear next byte
  6042. ⓪(addq.b  #1,d6                   ; inc. length
  6043. ⓪(cmpi    #79,d6
  6044. ⓪(bcs     Looklp                  ; repeat until 80 characters copied
  6045. ⓪(subq.b  #1,d6                   ; dec. length
  6046. ⓪ ex      tst.b   d6
  6047. ⓪(beq.l   noLook                  ; if length = 0 -> no search
  6048. ⓪"END;
  6049. ⓪"success:= findCase;
  6050. ⓪"b2:= findWord;
  6051. ⓪"OpenTextFrame;
  6052. ⓪"findCase:= success;
  6053. ⓪"findWord:= b2;
  6054. ⓪"(* all memory between ptrEnd and bufferL can now be used *)
  6055. ⓪"defFound:= FALSE;
  6056. ⓪"
  6057. ⓪"(* Query Def-Libfile *)
  6058. ⓪"Assign (DefLibName, wild, success);
  6059. ⓪"ReplaceHome (wild);
  6060. ⓪"OpenLib (DefLibFile, wild, result);
  6061. ⓪"IF result >= 0 THEN
  6062. ⓪$LibQuery (DefLibFile, ProcessDefFile2, result);
  6063. ⓪$CloseLib (DefLibFile)
  6064. ⓪"END;
  6065. ⓪"
  6066. ⓪"(* Query normal .DEF files *)
  6067. ⓪"IF NOT defFound THEN
  6068. ⓪$ResetList (DefPaths);
  6069. ⓪$LOOP
  6070. ⓪&Entry:= NextEntry (DefPaths);
  6071. ⓪&IF (Entry = NIL) OR defFound OR abort THEN EXIT END;
  6072. ⓪&(* Process Entry *)
  6073. ⓪&Concat (Entry^, '*.', wild, success);
  6074. ⓪&Append (DefSfx, wild, success);
  6075. ⓪&ReplaceHome (wild);
  6076. ⓪&DirQuery (wild, FileAttrSet{}, ProcessDefFile1, result);
  6077. ⓪$END;
  6078. ⓪"END;
  6079. ⓪ 
  6080. ⓪"IF defFound THEN
  6081. ⓪$ASSEMBLER
  6082. ⓪(; change extension from .def to .d
  6083. ⓪(LEA     filename,A0                     ; A0 := pointer to filename
  6084. ⓪"TestOneChar
  6085. ⓪(MOVE.B  (A0)+,D0                        ; get one char from name
  6086. ⓪(CMPI.B  #'.',D0
  6087. ⓪(BNE     TestOneChar                     ; repeat until '.' found
  6088. ⓪(CLR.B   1(A0)                           ; terminate string after 'D'
  6089. ⓪$END;
  6090. ⓪$Write(ClrScrnchar);
  6091. ⓪$SearchFile (filename,SrcPaths,fromStart,success,filename);  (* Search
  6092. ⓪csource *)
  6093. ⓪$success:= findCase;
  6094. ⓪$Open (f,filename,readOnly);
  6095. ⓪$IOResult:=State(f);
  6096. ⓪$IF SuccessFull(13) THEN
  6097. ⓪&WriteString('Reading ');WriteString(filename);WriteLn;
  6098. ⓪&flen:= FileSize(f);
  6099. ⓪&ReadText
  6100. ⓪$END;
  6101. ⓪$findCase:= success;
  6102. ⓪$IF IOResult#0 THEN
  6103. ⓪&CloseTextFrame;
  6104. ⓪&cmdFlag:= FALSE;
  6105. ⓪&ScreenOut
  6106. ⓪$ELSE
  6107. ⓪&(* file is read. Now set Cursor *)
  6108. ⓪&ScreenOut;
  6109. ⓪&IF NOT modNameFound THEN
  6110. ⓪(findWord:= TRUE;
  6111. ⓪(findSame:= TRUE;
  6112. ⓪(findCase:= TRUE;
  6113. ⓪(Find
  6114. ⓪&END
  6115. ⓪$END
  6116. ⓪"ELSE
  6117. ⓪$(* Kein File gefunden *)
  6118. ⓪$CloseTextFrame;
  6119. ⓪$ScreenOut;
  6120. ⓪$cmdFlag:=false;
  6121. ⓪"END;
  6122. ⓪"ASSEMBLER
  6123. ⓪ noLook
  6124. ⓪"END;
  6125. ⓪ END FindDefinition;
  6126. ⓪ *)
  6127. ⓪ 
  6128. ⓪ (*$L+*)
  6129. ⓪ (*$? mayCallCompiler:
  6130. ⓪ PROCEDURE callCompiler;
  6131. ⓪"VAR ok: BOOLEAN; ex: INTEGER; msg: ARRAY [0..125] OF CHAR;
  6132. ⓪&res: LoaderResults; l, l2: LONGINT;
  6133. ⓪&ad: ADDRESS; tim, dat: CARDINAL; p: POINTER TO CHAR;
  6134. ⓪&oldSize: LONGCARD; str: Strings.String;
  6135. ⓪"BEGIN
  6136. ⓪$(*
  6137. ⓪%* Puffer bis auf 1000 Byte freien Rest verkleinern
  6138. ⓪%*)
  6139. ⓪$l:= LONGINT (bufferH-ptrEnd-1000L); (* Länge des freien Puffers *)
  6140. ⓪$IF l>0L THEN
  6141. ⓪&IF NOT FullStorBaseAccess () THEN
  6142. ⓪((* wenn kein Vergrößern des Speichers am Ende möglich,
  6143. ⓪)* dann geben wir hier nur 2/3 des noch freien Speichers frei. *)
  6144. ⓪(l2:= AllAvail();
  6145. ⓪(IF l2 >= 2 * l THEN
  6146. ⓪*l:= 0
  6147. ⓪(ELSIF l2 >= l THEN
  6148. ⓪*l:= l DIV 3;
  6149. ⓪(ELSE
  6150. ⓪*l:= l - l DIV 3;
  6151. ⓪(END
  6152. ⓪&END;
  6153. ⓪&IF l > 0 THEN
  6154. ⓪(IF ODD (l) THEN DEC (l) END;
  6155. ⓪(DEALLOCATE (bufferStart, l);
  6156. ⓪(bufferH:= bufferStart + MemSize (bufferStart);
  6157. ⓪(ASSEMBLER
  6158. ⓪*MOVE.L  bufferH,D0
  6159. ⓪*BCLR    #0,D0
  6160. ⓪*MOVE.L  D0,A0
  6161. ⓪*CLR.L   -(A0)
  6162. ⓪*CLR.L   -(A0)
  6163. ⓪*MOVE.L  A0,bufferH
  6164. ⓪*MOVE.L  A0,bufferL
  6165. ⓪(END;
  6166. ⓪&END;
  6167. ⓪$END;
  6168. ⓪$
  6169. ⓪$ScanMode:= FALSE;
  6170. ⓪$IF autoIncVer & NOT saved THEN
  6171. ⓪&str:= IncrementVersion ()
  6172. ⓪$ELSE
  6173. ⓪&str:= ''
  6174. ⓪$END;
  6175. ⓪$PutCmd (conc ("Compiling...   ", str));
  6176. ⓪$p:= ptrEnd;
  6177. ⓪$p^:= 3C;
  6178. ⓪$
  6179. ⓪$Concat (fileName, ' /Q /@', msg, ok);
  6180. ⓪$Append (LHexToStr (ptrStart,0), msg, ok);
  6181. ⓪$IF MainOutputPath[0] # 0C THEN
  6182. ⓪&Append (' /O', msg, ok);
  6183. ⓪&Append (MainOutputPath, msg, ok);
  6184. ⓪$END;
  6185. ⓪$IF CompilerArgs[0] # 0C THEN
  6186. ⓪&Append (' ', msg, ok);
  6187. ⓪&Append (CompilerArgs, msg, ok);
  6188. ⓪$END;
  6189. ⓪$tim:= DirTime (); dat:= Today ();
  6190. ⓪$oldSize:= DefaultStackSize;
  6191. ⓪$DefaultStackSize:= 16000;
  6192. ⓪$CallModule (CompilerParm.name, StdPaths, msg, NIL, ex, str, res);
  6193. ⓪$DefaultStackSize:= oldSize;
  6194. ⓪$p^:= 0C;
  6195. ⓪$IF Inconsistent () THEN
  6196. ⓪&Bell; PutCmd ("Memory management is damaged! Save text with backup and reboot!"); ErrorWait
  6197. ⓪$END;
  6198. ⓪$IF res # noError THEN
  6199. ⓪&Bell; PutCmd (conc ("Compiler couldn't be executed: ", str)); ErrorWait
  6200. ⓪$ELSE
  6201. ⓪&CASE ex OF
  6202. ⓪(0:   restoreFileDT:= TRUE; fileD:= dat; fileT:= tim;
  6203. ⓪-ScreenOut|
  6204. ⓪(2,3: Assign (ErrorMsg, ErrMsg, ok);
  6205. ⓪-GotoLine (TextLine, TextCol-1);
  6206. ⓪-tags['?']:= ptr;
  6207. ⓪-ErrorPos:= ptr-ptrStart;
  6208. ⓪-Bell; PutCmd(ErrMsg); ErrorWait |
  6209. ⓪(4:   ScreenOut; Bell; PutCmd('Include files are not allowed here!'); ErrorWait |
  6210. ⓪&ELSE
  6211. ⓪-ScreenOut; Bell; GetStateMsg (ex, str); PutCmd(str); ErrorWait
  6212. ⓪&END
  6213. ⓪$END;
  6214. ⓪$ad:= bufferStart;
  6215. ⓪$IF (l>0L) & FullStorBaseAccess () THEN
  6216. ⓪&Enlarge (bufferStart, l, ok);
  6217. ⓪&IF ~ok THEN
  6218. ⓪(bufferStart:= ad (* wird anscheinend vom Storage zerstört?! *);
  6219. ⓪(Bell;
  6220. ⓪(PutCmd ("Editor's buffer is nearly full. You'd better save the text and quit/reboot!");
  6221. ⓪(ErrorWait
  6222. ⓪&ELSE
  6223. ⓪(bufferH:= bufferStart + MemSize (bufferStart);
  6224. ⓪(ASSEMBLER
  6225. ⓪*MOVE.L  bufferH,D0
  6226. ⓪*LSR     #1,D0
  6227. ⓪*LSL     #1,D0
  6228. ⓪*MOVE.L  D0,A0
  6229. ⓪*CLR.L   -(A0)
  6230. ⓪*CLR.L   -(A0)
  6231. ⓪*MOVE.L  A0,bufferH
  6232. ⓪*MOVE.L  A0,bufferL
  6233. ⓪(END
  6234. ⓪&END
  6235. ⓪$END;
  6236. ⓪"END callCompiler;
  6237. ⓪ *)
  6238. ⓪ 
  6239. ⓪ (*$L-*)
  6240. ⓪ PROCEDURE Supexec ( p : PROC );
  6241. ⓪ BEGIN
  6242. ⓪ ASSEMBLER
  6243. ⓪(MOVE.L  -(A3),-(A7)
  6244. ⓪(MOVE    #38,-(A7)
  6245. ⓪(TRAP    #14
  6246. ⓪(ADDQ.L  #6,A7
  6247. ⓪ END
  6248. ⓪ END Supexec;
  6249. ⓪ 
  6250. ⓪ (*$L-*)
  6251. ⓪ PROCEDURE Setrez (r: CARDINAL);
  6252. ⓪ BEGIN
  6253. ⓪ ASSEMBLER
  6254. ⓪(MOVE.W  -(A3),-(A7)
  6255. ⓪(MOVEQ   #-1,D0
  6256. ⓪(MOVE.L  D0,-(A7)
  6257. ⓪(MOVE.L  D0,-(A7)
  6258. ⓪(MOVE    #5,-(A7)
  6259. ⓪(TRAP    #14
  6260. ⓪(ADDA.W  #12,A7
  6261. ⓪ END
  6262. ⓪ END Setrez;
  6263. ⓪ 
  6264. ⓪ (*$L-*)
  6265. ⓪ PROCEDURE Getrez (): CARDINAL;
  6266. ⓪ BEGIN
  6267. ⓪ ASSEMBLER
  6268. ⓪(MOVE    #4,-(A7)
  6269. ⓪(TRAP    #14
  6270. ⓪(ADDQ.L  #2,A7
  6271. ⓪(MOVE.W  D0,(A3)+
  6272. ⓪ END
  6273. ⓪ END Getrez;
  6274. ⓪ 
  6275. ⓪ (*$L-*)
  6276. ⓪ PROCEDURE SetColor (n,c: CARDINAL): CARDINAL;
  6277. ⓪"BEGIN
  6278. ⓪$ASSEMBLER
  6279. ⓪(MOVE.L  -(A3),-(A7)
  6280. ⓪(MOVE    #7,-(A7)
  6281. ⓪(TRAP    #14
  6282. ⓪(ADDQ.L  #6,A7
  6283. ⓪(MOVE.W  D0,(A3)+
  6284. ⓪$END;
  6285. ⓪"END SetColor;
  6286. ⓪"
  6287. ⓪ (*$L-*)
  6288. ⓪ PROCEDURE Wvbl;
  6289. ⓪ BEGIN
  6290. ⓪ ASSEMBLER
  6291. ⓪(LEA     $FF8200,A1
  6292. ⓪(MOVEP.W 1(A1),D0
  6293. ⓪(NOP
  6294. ⓪(NOP
  6295. ⓪ W1      MOVEP.W 5(A1),D1
  6296. ⓪(CMP.W   D0,D1
  6297. ⓪(BEQ     W1
  6298. ⓪ W2      MOVEP.W 5(A1),D1
  6299. ⓪(CMP.W   D0,D1
  6300. ⓪(BNE     W2
  6301. ⓪ END
  6302. ⓪ END Wvbl;
  6303. ⓪ 
  6304. ⓪ (*$L-*)
  6305. ⓪ PROCEDURE initFont8_8;
  6306. ⓪"BEGIN
  6307. ⓪$ASSEMBLER
  6308. ⓪(MOVE.L  pFont8_8,A0
  6309. ⓪(; Daten in Font-Puffer kopieren, dabei umverteilen
  6310. ⓪(LEA     fontbuffer,A1
  6311. ⓪(MOVE.W  #255,D0
  6312. ⓪ l:      MOVEQ   #7,D1
  6313. ⓪(CLR     D2
  6314. ⓪ m:      MOVE.B  0(A0,D2.W),(A1)+
  6315. ⓪(ADDI.W  #$100,D2
  6316. ⓪(DBRA    D1,m
  6317. ⓪(ADDQ.L  #1,A0
  6318. ⓪(DBRA    D0,l
  6319. ⓪$END;
  6320. ⓪"END initFont8_8;
  6321. ⓪ 
  6322. ⓪ (*$L-*)
  6323. ⓪ PROCEDURE initFont8_16;
  6324. ⓪"BEGIN
  6325. ⓪$ASSEMBLER
  6326. ⓪(MOVE.L  pFont8_16,A0
  6327. ⓪(LEA     fontbuffer,A1
  6328. ⓪(MOVE.W  #255,D0
  6329. ⓪ n:      MOVEQ   #15,D1
  6330. ⓪(CLR     D2
  6331. ⓪ o:      MOVE.B  0(A0,D2.W),(A1)+
  6332. ⓪(ADDI.W  #$100,D2
  6333. ⓪(DBRA    D1,o
  6334. ⓪(ADDQ.L  #1,A0
  6335. ⓪(DBRA    D0,n
  6336. ⓪$END;
  6337. ⓪"END initFont8_16;
  6338. ⓪ 
  6339. ⓪ (*$L-*)
  6340. ⓪ PROCEDURE GetpScreen;
  6341. ⓪ BEGIN
  6342. ⓪"ASSEMBLER
  6343. ⓪(; zuerst dafür sorgen, daß wir die shift-bits bei bconin bekommen.
  6344. ⓪(MOVE.B  $484,oldconterm
  6345. ⓪(BSET    #3,$484
  6346. ⓪(MOVE.L  $44E,pScreen
  6347. ⓪ 
  6348. ⓪((*
  6349. ⓪(MOVE    SR,-(A7)
  6350. ⓪(MOVE    #$2700,SR
  6351. ⓪(JSR     Wvbl
  6352. ⓪(CLR     D1
  6353. ⓪(LEA     $FF8260,A2
  6354. ⓪(TST     isTT            ; bei TT immer auf 640*400
  6355. ⓪(BEQ     noTT
  6356. ⓪(ADDQ.L  #2,A2
  6357. ⓪ noTT    MOVE.L  A2,ColorReg
  6358. ⓪(MOVE.B  (A2),D0
  6359. ⓪(ANDI    #7,D0
  6360. ⓪(MOVE.B  D0,oldShiftMode
  6361. ⓪(TST     isTT            ; bei TT immer auf 640*400
  6362. ⓪(BNE     doTT
  6363. ⓪(BTST    #1,D0
  6364. ⓪(SEQ     D1
  6365. ⓪(MOVE.W  D1,color
  6366. ⓪(BEQ     mono
  6367. ⓪(BTST    #0,D0
  6368. ⓪(SNE     D1
  6369. ⓪(MOVE.W  D1,UseGEM     ; falls Auflösung gewechselt, kein GEM verw.
  6370. ⓪(BSET    #0,$FF8260
  6371. ⓪(JSR     initFont8_8
  6372. ⓪(BRA     ende
  6373. ⓪ doTT    CMPI.B  #2,oldShiftMode
  6374. ⓪(BEQ     mono
  6375. ⓪(CLR     UseGEM     ; falls Auflösung gewechselt, kein GEM verw.
  6376. ⓪(MOVE.B  (A2),D0
  6377. ⓪(ANDI    #$F8,D0
  6378. ⓪(OR.B    #2,D0
  6379. ⓪(MOVE.B  D0,(A2)
  6380. ⓪(BRA     mono2
  6381. ⓪ mono:   MOVE    #1,UseGEM
  6382. ⓪(; Daten in Font-Puffer kopieren, dabei umverteilen
  6383. ⓪ mono2   JSR     initFont8_16
  6384. ⓪ ende    MOVE    (A7)+,SR
  6385. ⓪(*)
  6386. ⓪"END
  6387. ⓪ END GetpScreen;
  6388. ⓪ 
  6389. ⓪ (*$L-*)
  6390. ⓪ PROCEDURE ResetpScreen;
  6391. ⓪ BEGIN
  6392. ⓪ ASSEMBLER
  6393. ⓪((*
  6394. ⓪(; auf VBL warten
  6395. ⓪(MOVE    SR,-(A7)
  6396. ⓪(MOVE    #$2700,SR
  6397. ⓪(JSR     Wvbl
  6398. ⓪(MOVE.L  ColorReg,A2
  6399. ⓪(MOVE.B  (A2),D0
  6400. ⓪(ANDI    #$F8,D0
  6401. ⓪(OR.B    oldShiftMode,D0
  6402. ⓪(MOVE.B  D0,(A2)
  6403. ⓪(MOVE    (A7)+,SR
  6404. ⓪(*)
  6405. ⓪(MOVE.B  oldconterm,$484
  6406. ⓪ END
  6407. ⓪ END ResetpScreen;
  6408. ⓪ 
  6409. ⓪ (*$L+*)
  6410. ⓪ 
  6411. ⓪ PROCEDURE OscanIs () : BOOLEAN;
  6412. ⓪"VAR oScan : CARDINAL;
  6413. ⓪ BEGIN
  6414. ⓪"ASSEMBLER
  6415. ⓪$MOVE.W      #4200,-(SP)
  6416. ⓪$TRAP        #14
  6417. ⓪$ADDQ.L      #2,SP
  6418. ⓪$MOVE.W      D0,oScan(A6)
  6419. ⓪"END;
  6420. ⓪"RETURN oScan # 4200
  6421. ⓪ END OscanIs;
  6422. ⓪ 
  6423. ⓪ PROCEDURE OscanSwitch (mode : INTEGER) : INTEGER;
  6424. ⓪"VAR oScanMode : INTEGER;
  6425. ⓪ BEGIN
  6426. ⓪"ASSEMBLER
  6427. ⓪$MOVE.W      mode(A6),-(SP)
  6428. ⓪$MOVE.W      #4206,-(SP)
  6429. ⓪$TRAP        #14
  6430. ⓪$ADDQ.L      #4,SP
  6431. ⓪$MOVE.W      D0,oScanMode(A6)
  6432. ⓪"END;
  6433. ⓪"RETURN oScanMode
  6434. ⓪ END OscanSwitch;
  6435. ⓪ 
  6436. ⓪ (*$L-*)
  6437. ⓪ PROCEDURE EsetShift (shftMode: WORD): CARDINAL;
  6438. ⓪"BEGIN
  6439. ⓪$ASSEMBLER
  6440. ⓪(MOVE.W  -(A3),-(A7)
  6441. ⓪(MOVE    #80,-(A7)
  6442. ⓪(TRAP    #14
  6443. ⓪(ADDQ.L  #4,A7
  6444. ⓪(MOVE.W  D0,(A3)+
  6445. ⓪$END
  6446. ⓪"END EsetShift;
  6447. ⓪ 
  6448. ⓪ (*$L-*)
  6449. ⓪ PROCEDURE EgetShift (): CARDINAL;
  6450. ⓪"BEGIN
  6451. ⓪$ASSEMBLER
  6452. ⓪(MOVE    #81,-(A7)
  6453. ⓪(TRAP    #14
  6454. ⓪(ADDQ.L  #2,A7
  6455. ⓪(MOVE.W  D0,(A3)+
  6456. ⓪$END
  6457. ⓪"END EgetShift;
  6458. ⓪ 
  6459. ⓪ 
  6460. ⓪ TABLE.B ColdStart: 1;
  6461. ⓪ 
  6462. ⓪ VAR oldOscan : INTEGER;
  6463. ⓪ 
  6464. ⓪ 
  6465. ⓪ (*$L+,A+*)
  6466. ⓪ PROCEDURE InitScreen;
  6467. ⓪"VAR i,newShiftMode: CARDINAL;
  6468. ⓪"BEGIN
  6469. ⓪$isTT:= Machine() >= 2;
  6470. ⓪$IF Oscanis() THEN oldOscan:= Oscanswitch (0); END;
  6471. ⓪$UseGem:= TRUE;
  6472. ⓪$color:= FALSE;
  6473. ⓪$rez_changed:= FALSE;
  6474. ⓪$IF ~isTT THEN
  6475. ⓪&oldShiftMode:= Getrez ();
  6476. ⓪&IF oldShiftMode # 2 THEN
  6477. ⓪(rez_changed:= TRUE;
  6478. ⓪(Setrez (1);
  6479. ⓪(oldColor[0]:= SetColor (0, $777);
  6480. ⓪(FOR i:= 1 TO 3 DO oldColor[i]:= SetColor (i, 0) END;
  6481. ⓪(color:= TRUE
  6482. ⓪&END;
  6483. ⓪$ELSE
  6484. ⓪&newShiftMode:= EgetShift ();
  6485. ⓪&ASSEMBLER
  6486. ⓪+MOVE.W newShiftMode(A6),D0
  6487. ⓪+ANDI   #$F0FF,D0
  6488. ⓪+ORI    #$0200,D0             ; 640*400 setzen
  6489. ⓪+MOVE.W D0,newShiftMode(A6)
  6490. ⓪&END;
  6491. ⓪&oldShiftMode:= EsetShift (newShiftMode);
  6492. ⓪$END;
  6493. ⓪$ASSEMBLER
  6494. ⓪(;*** ^ auf Fontdaten holen:
  6495. ⓪(DC.W    $A000
  6496. ⓪(MOVE.L  (A1)+,A0      ; f. System-Font 6*6 (Icon)
  6497. ⓪(MOVE.L  (A1)+,A0      ; f. System-Font 8*8 (Farbe)
  6498. ⓪(LEA     pFont8_8,A2
  6499. ⓪(MOVE.L  76(A0),(A2)
  6500. ⓪(MOVE.L  (A1)+,A0      ; f. System-Font 8*16 (S/W)
  6501. ⓪(LEA     pFont8_16,A2
  6502. ⓪(MOVE.L  76(A0),(A2)
  6503. ⓪$END;
  6504. ⓪$IF color THEN initFont8_8 ELSE initFont8_16 END;
  6505. ⓪$Supexec (GetpScreen);
  6506. ⓪"END InitScreen;
  6507. ⓪ 
  6508. ⓪ 
  6509. ⓪ (*$L+*)
  6510. ⓪ 
  6511. ⓪ PROCEDURE InitEditor;           (* Initialisierung der Pointer und Flags *)
  6512. ⓪"VAR bufferLaenge: LONGINT; v, r: CARDINAL; d: Date;
  6513. ⓪ BEGIN
  6514. ⓪"PointsPerChar:= 8;
  6515. ⓪"IF color THEN
  6516. ⓪$LinesPerChar:= 8
  6517. ⓪"ELSE
  6518. ⓪$LinesPerChar:= 16
  6519. ⓪"END;
  6520. ⓪"allowed:=ASCII{' '..255C};
  6521. ⓪"bufferLaenge:=(INT(MemAvail())-32000) * 2 DIV 3;
  6522. ⓪"IF bufferLaenge > 0 THEN
  6523. ⓪$Allocate(bufferStart,bufferLaenge);
  6524. ⓪"END;
  6525. ⓪"IF bufferStart=NIL THEN WriteString('Not enough memory'); HALT END;
  6526. ⓪"ASSEMBLER
  6527. ⓪*move.l  bufferStart,a0
  6528. ⓪*move.l  a0,d0
  6529. ⓪*clr.l   (a0)+
  6530. ⓪*move.l  a0,ptrStart
  6531. ⓪*move.b  #DLEchar,(a0)+
  6532. ⓪*move.b  #DLEoffset,(a0)+
  6533. ⓪*move.l  a0,ptr
  6534. ⓪*move.l  a0,lastPtr
  6535. ⓪*clr     (a0)+
  6536. ⓪*move.l  a0,ptrEnd
  6537. ⓪*clr.l   (a0)+
  6538. ⓪*add.l   bufferLaenge(A6),d0
  6539. ⓪*bclr.l  #0,d0
  6540. ⓪*move.l  d0,a0
  6541. ⓪*clr.l   -(a0)
  6542. ⓪*clr.l   -(a0)
  6543. ⓪*move.l  a0,bufferL
  6544. ⓪*move.l  a0,bufferH
  6545. ⓪*moveq   #25,d0
  6546. ⓪*move    d0,lines
  6547. ⓪*subq    #1,d0
  6548. ⓪*move    d0,maxLine
  6549. ⓪*moveq   #80,d0
  6550. ⓪*move    d0,cols
  6551. ⓪*subq    #1,d0
  6552. ⓪*move.b  d0,maxCol
  6553. ⓪*subq    #1,d0
  6554. ⓪*move.b  d0,maxColM1
  6555. ⓪*
  6556. ⓪*clr     exitCode
  6557. ⓪*clr     endOfEd
  6558. ⓪*clr     filesInMem
  6559. ⓪*clr     cmdFlag
  6560. ⓪*clr     delFlag
  6561. ⓪*clr     insFlag
  6562. ⓪*jsr     ResetTextOptions
  6563. ⓪*addq    #1,sessions
  6564. ⓪*clr.l   total
  6565. ⓪*jsr     Prepare
  6566. ⓪*move.l  d0,startupTime
  6567. ⓪*clr.b   oldString
  6568. ⓪*clr.b   newString
  6569. ⓪*move    #30,countDefault
  6570. ⓪*CLR.L   ShortKeyPtr
  6571. ⓪*CLR     Inserting
  6572. ⓪*MOVE    #1,errorNr
  6573. ⓪ 
  6574. ⓪*; Warmstart-Init geht nur, wenn die betroffenen Variablen als
  6575. ⓪*; TABLEs definiert werden (so auch die Find/Rpl-Strings).
  6576. ⓪*; tst.b   ColdStart
  6577. ⓪*; beq.l   warm
  6578. ⓪*; clr.b   ColdStart
  6579. ⓪ 
  6580. ⓪*move    #1,sessions
  6581. ⓪*clr     cmdMode
  6582. ⓪*clr     tabMode
  6583. ⓪*clr.l   keepTime
  6584. ⓪"warm
  6585. ⓪"END
  6586. ⓪ END InitEditor;
  6587. ⓪ 
  6588. ⓪ (*$l+*)
  6589. ⓪ PROCEDURE StopEditor;
  6590. ⓪ VAR i: CARDINAL;
  6591. ⓪ BEGIN
  6592. ⓪"DeAllocate(bufferStart,0L);
  6593. ⓪"Finish;
  6594. ⓪"(*
  6595. ⓪"SetNewDesk (NIL, Root);
  6596. ⓪"ForceDeskRedraw;
  6597. ⓪"*)
  6598. ⓪"Supexec (ResetpScreen);
  6599. ⓪"IF isTT THEN
  6600. ⓪$oldShiftMode:= EsetShift (oldShiftMode);
  6601. ⓪"ELSE
  6602. ⓪$IF rez_changed THEN Setrez (oldShiftMode) END;
  6603. ⓪$IF color THEN
  6604. ⓪&FOR i:= 0 TO 3 DO dumCard:= SetColor (i, oldColor[i]) END;
  6605. ⓪$END;
  6606. ⓪"END;
  6607. ⓪"IF Oscanis() THEN oldOscan:= Oscanswitch (oldOscan) END;
  6608. ⓪"SelectFile:= FileSelectProc (oldSelect);
  6609. ⓪"GrafMouse (mouseOn, NIL);
  6610. ⓪"MouseControl (FALSE);
  6611. ⓪"ForceDeskRedraw;
  6612. ⓪"ExitGem (hdl);
  6613. ⓪ END StopEditor;
  6614. ⓪ 
  6615. ⓪ 
  6616. ⓪ VAR first: boolean; argv:ARRAY [0..4] OF PtrArgStr;
  6617. ⓪$argc,strpos:CARDINAL; nullCh:CHAR;
  6618. ⓪ 
  6619. ⓪ 
  6620. ⓪ (*$l-*)
  6621. ⓪ PROCEDURE Right1;   (* ohne DOWN am Zeilen-Ende *)
  6622. ⓪ BEGIN
  6623. ⓪ ASSEMBLER
  6624. ⓪(;clr    forceTab
  6625. ⓪(move.l ptr,a0
  6626. ⓪ again   move.b (a0)+,d0
  6627. ⓪(beq    donix
  6628. ⓪(cmpi.b #CRchar,d0
  6629. ⓪(beq    donix
  6630. ⓪(cmpi.b #$20,d0
  6631. ⓪(bcs    again
  6632. ⓪(move.l a0,ptr
  6633. ⓪(move   ptrY,d1
  6634. ⓪(move.b ptrX,d1
  6635. ⓪(cmp.b  maxCol,d1
  6636. ⓪(beq    donix
  6637. ⓪(addq.b #1,d1
  6638. ⓪(jmp    GotoXYd1
  6639. ⓪ donix
  6640. ⓪ END
  6641. ⓪ END Right1;
  6642. ⓪ 
  6643. ⓪ (*$l+*)
  6644. ⓪ PROCEDURE ShowCmdLine;
  6645. ⓪"BEGIN
  6646. ⓪$CASE cmdMode OF
  6647. ⓪&0: PutCmdOrTab(
  6648. ⓪ 'Edit: C(py D(el E(nv F(ind I(ns J(mp N(ew Q(uit R(epl T(ag X(chg Z(ap   /'
  6649. ⓪(+Version+'/')|
  6650. ⓪&1: PutCmdOrTab(
  6651. ⓪ 'Edit: A(djust B(reak G(lue H(ardcopy L(ook M(id O(pp P(age              /'
  6652. ⓪(+Version+'/')|
  6653. ⓪&2: PutCmdOrTab(
  6654. ⓪ 'Edit: ?:info  K:show tabs  F2:set tab  F3/F4: Open/Close text frame     /'
  6655. ⓪(+Version+'/')|
  6656. ⓪&3: PutCmdOrTab(
  6657. ⓪ 'Edit: F5: Compile  F6: Look for exported identifier                     /'
  6658. ⓪(+Version+'/')|
  6659. ⓪&4: PutCmdOrTab(
  6660. ⓪ 'Edit: Find/Replace/Look prefix: S(ame V(erify W(ord                     /'
  6661. ⓪(+Version+'/')|
  6662. ⓪$END;
  6663. ⓪$cmdFlag:=true
  6664. ⓪"END ShowCmdLine;
  6665. ⓪ 
  6666. ⓪ (*$l+*)
  6667. ⓪ PROCEDURE WaitForKey;
  6668. ⓪ 
  6669. ⓪"VAR maus: BOOLEAN;
  6670. ⓪ 
  6671. ⓪"PROCEDURE CursorsOn;
  6672. ⓪$BEGIN
  6673. ⓪&Write (CursorOnChar);
  6674. ⓪&IF UseGem AND NOT maus THEN
  6675. ⓪(GrafMouse (arrow, NIL);
  6676. ⓪(GrafMouse (mouseOn, NIL);
  6677. ⓪(maus:= TRUE;
  6678. ⓪&END;
  6679. ⓪$END CursorsOn;
  6680. ⓪ 
  6681. ⓪"PROCEDURE CursorsOff;
  6682. ⓪$BEGIN
  6683. ⓪&IF UseGem & maus THEN
  6684. ⓪(GrafMouse (mouseOff, NIL);
  6685. ⓪(maus:= FALSE;
  6686. ⓪&END;
  6687. ⓪&ScrnCurOff;
  6688. ⓪$END CursorsOff;
  6689. ⓪ 
  6690. ⓪"VAR
  6691. ⓪$i, mousePtrX, mousePtrY: CARDINAL;
  6692. ⓪ 
  6693. ⓪"BEGIN
  6694. ⓪$maus:= FALSE;
  6695. ⓪$CursorsOn;
  6696. ⓪$IF CmdLineAway(TRUE) THEN
  6697. ⓪&CursorsOff;
  6698. ⓪&ShowCmdLine;
  6699. ⓪&CursorsOn;
  6700. ⓪$END;
  6701. ⓪$LOOP
  6702. ⓪&(* MAUS ist hier an *)
  6703. ⓪&IF Keypressed() THEN
  6704. ⓪(IF UseGem THEN GrafMouse (mouseOff, NIL); maus:= FALSE END;
  6705. ⓪(ReadUpCh;
  6706. ⓪(EXIT     (*Taste wurde gedrückt, Byte in Ch*)
  6707. ⓪&ELSE       (*Hü*)
  6708. ⓪(GetMouseState(dev,MousePoint, buttons); (*hält Ablauf nicht an *)
  6709. ⓪(IF (msbut1 IN buttons) THEN
  6710. ⓪*IF Mousepoint.y <= (LinesPerChar DIV 2) then
  6711. ⓪,ch:= UpKey;
  6712. ⓪,EXIT
  6713. ⓪*ElSIF Mousepoint.y > (INTEGER(Lines)*LinesPerChar-2) THEN
  6714. ⓪,ch:= DownKey;
  6715. ⓪,EXIT
  6716. ⓪*ELSIF (Mousepoint.y >= LinesPerChar)
  6717. ⓪*AND   (Mousepoint.y < (INTEGER(Lines)*LinesPerChar-2)) THEN
  6718. ⓪,(*Maustaste gedrückt und nicht Statuszeile*)
  6719. ⓪,CursorsOff;
  6720. ⓪,Ptr:=ScreenTop1();
  6721. ⓪,ptrLine:= 1;
  6722. ⓪,ASSEMBLER
  6723. ⓪0MOVE    #$0100,D1
  6724. ⓪0JSR     GotoXYD1        ; x=0, y=1
  6725. ⓪,END;
  6726. ⓪,mousePtrX := Mousepoint.x DIV PointsPerChar; (* 0-79*)
  6727. ⓪,mousePtrY := Mousepoint.y DIV LinesPerChar; (* 1-24, Cmd-Zeile=0 *)
  6728. ⓪,ch:= downKey;
  6729. ⓪,for i:=1 to mousePtrY-1 do Down end;
  6730. ⓪,GotoSOln;
  6731. ⓪,For i:=CursorX+1 to mousePtrX do Right1 end;
  6732. ⓪,ClrKbdbuffer;
  6733. ⓪,CursorsOn;
  6734. ⓪*END;
  6735. ⓪(END (*if Maus gedrückt*)
  6736. ⓪&END (*IF Key ELSE mouse*)
  6737. ⓪$END (*LOOP, keine Taste gedrückt*);
  6738. ⓪$CursorsOff;
  6739. ⓪"END WaitForKey;
  6740. ⓪ 
  6741. ⓪ (*$l+*)
  6742. ⓪ BEGIN   (* of Editor *)
  6743. ⓪"(* Screen löschen
  6744. ⓪$Conout (CHR(27)); Conout ('E');
  6745. ⓪"*)
  6746. ⓪"InitScreen;
  6747. ⓪"oldSelect:= ADDRESS (SelectFile);
  6748. ⓪"IF NOT UseGem THEN SelectFile:= NoSelect; END;
  6749. ⓪"InitGem(RC,dev,success);
  6750. ⓪"if success then hdl:= CurrGemHandle() end;
  6751. ⓪"HomePath:= ShellPath;
  6752. ⓪"GrafMouse (mouseOff, NIL);
  6753. ⓪"MouseControl (TRUE);
  6754. ⓪"MenuBar (NIL, FALSE);
  6755. ⓪"InitEditor;
  6756. ⓪"Write(ClrScrnChar);
  6757. ⓪"writeTitle;
  6758. ⓪"nullCh:=0C;
  6759. ⓪"InitArgCV (argc,argv);
  6760. ⓪"ErrorPos:=0L;
  6761. ⓪"GetPath(Path1); FName1:= '';
  6762. ⓪"first := TRUE;
  6763. ⓪"REPEAT
  6764. ⓪$IF first & (length(ArgV[1]^) # 0) THEN
  6765. ⓪&Assign (ArgV[1]^,filename,strok);
  6766. ⓪&splitpath(filename,Path1,FName1);
  6767. ⓪&IF Path1[0] = 0C THEN
  6768. ⓪(GetPath (Path1)
  6769. ⓪&ELSE
  6770. ⓪(Append ('*.*', Path1, strok)
  6771. ⓪&END
  6772. ⓪$ELSE
  6773. ⓪&(* writestring('Edit which file? ');
  6774. ⓪)filename := '';
  6775. ⓪)readstring(filename);
  6776. ⓪'*)
  6777. ⓪&filename:=getFilefromBox('Edit which file?');
  6778. ⓪$END;
  6779. ⓪$fnOK:=ChkName(fileName);
  6780. ⓪$IF fnOK THEN
  6781. ⓪&SearchFile (filename,SrcPaths,fromStart,strok,filename);
  6782. ⓪&Open (f,filename,readonly);
  6783. ⓪&IOResult:= State(f);
  6784. ⓪&IF IOResult >= 0 THEN
  6785. ⓪(UpdatePath (filename);
  6786. ⓪(writeLn;
  6787. ⓪(WriteString('Reading '); WriteString(fileName); WriteLn;
  6788. ⓪(flen:= FileSize(f);
  6789. ⓪(ReadText
  6790. ⓪&ELSE
  6791. ⓪(WriteString ('File not found !');
  6792. ⓪(ErrorWait
  6793. ⓪&END
  6794. ⓪$END;
  6795. ⓪$first := FALSE;
  6796. ⓪"UNTIL NOT fnOK OR (IOResult>=0);
  6797. ⓪"strpos:=0;
  6798. ⓪"ErrLine:= StrToLCard (ArgV[2]^,strpos,strok);
  6799. ⓪"IF fnOK & (ErrLine#0L) THEN
  6800. ⓪$strpos:=0;
  6801. ⓪$GotoLine (ErrLine, StrToCard (ArgV[3]^,strpos,strok));
  6802. ⓪$tags['?']:= ptr;
  6803. ⓪$ErrorPos:= ptr-ptrStart;
  6804. ⓪$Assign (argv[4]^,ErrMsg,strok);
  6805. ⓪$PutCmd(ErrMsg); ErrorWait
  6806. ⓪"ELSE
  6807. ⓪$jumpPtr (tags[';']);
  6808. ⓪$tags[';']:= ptrEnd
  6809. ⓪"END;
  6810. ⓪"REPEAT (*2*)
  6811. ⓪$WaitForKey; (* Mausaktionen werden allein in der Routine behandelt, *)
  6812. ⓪0(* außerhalb dieser Routine ist die Maus immer aus      *)
  6813. ⓪$IF Rptfx10() OR DirKey() THEN
  6814. ⓪$ELSIF ch='/' THEN Negate(infinite)
  6815. ⓪$ELSIF ch='S' THEN Negate(findSame)
  6816. ⓪$ELSIF ch='V' THEN Negate(verify)
  6817. ⓪$ELSIF ch='W' THEN Negate(findWord)
  6818. ⓪$ELSE
  6819. ⓪&CASE ch OF
  6820. ⓪&'A': Adjust |
  6821. ⓪&'C': CopyText |
  6822. ⓪&'D': DelMode |
  6823. ⓪&'E': Environment |
  6824. ⓪&'F': Find |
  6825. ⓪&'G': Glue |
  6826. ⓪&'H': HardCopy |
  6827. ⓪&'I': Inserting := True; InsMode; Inserting := False  |
  6828. ⓪&'J': Jump |
  6829. ⓪&'K': Negate(tabMode); cmdFlag:=false |
  6830. ⓪&'L': Look |
  6831. ⓪&'M': CenterScreen |
  6832. ⓪&'N': NewFile |
  6833. ⓪&'O': Page(true) |
  6834. ⓪&'P': Page(false) |
  6835. ⓪&'Q': QuitEditor |
  6836. ⓪&'R': FReplace |
  6837. ⓪&'T': SetTag |
  6838. ⓪&'X': Exchange |
  6839. ⓪&'Y': ASSEMBLER move.l rptf,d0 beq no move d0,countDefault !no END |
  6840. ⓪&'Z': Zap|
  6841. ⓪&ELSE
  6842. ⓪(IF ch=BreakKey THEN Break
  6843. ⓪((*$? mayCallCompiler:
  6844. ⓪(ELSIF ch=FindDefKey THEN FindDefinition
  6845. ⓪(*)
  6846. ⓪(ELSIF ch=HomeKey THEN CenterScreen
  6847. ⓪(ELSIF ch=INSKey THEN Inserting := True; InsMode; Inserting := False
  6848. ⓪(ELSIF ch=DELKey THEN DelMode
  6849. ⓪(ELSIF (ch=OpenFrameKey) THEN OpenTextFrame
  6850. ⓪(ELSIF (ch=CloseFrameKey) THEN
  6851. ⓪*CloseTextFrame;
  6852. ⓪*cmdFlag:=false;
  6853. ⓪*ScreenOut
  6854. ⓪(ELSIF ch=Helpkey THEN
  6855. ⓪*IF tabMode THEN tabMode:= FALSE ELSE cmdMode:= (cmdMode+1) MOD 5 END;
  6856. ⓪*cmdFlag:= FALSE
  6857. ⓪(ELSIF ch='?' THEN Info
  6858. ⓪(ELSIF (ch=PageDownKey) OR (ch=PageUpKey) THEN Page(ch=PageUpKey)
  6859. ⓪((*$? mayCallCompiler:
  6860. ⓪*ELSIF ch=compileKey THEN callCompiler
  6861. ⓪(*)
  6862. ⓪(ELSE
  6863. ⓪*RptfOK;
  6864. ⓪*REPEAT
  6865. ⓪,IF (ch=' ') OR (ch=rightKey) THEN Right
  6866. ⓪,ELSIF ch=EOLNkey THEN GotoEOLN
  6867. ⓪,ELSIF ch=SOLNkey THEN GotoSOLN
  6868. ⓪,ELSIF (ch=BSkey) OR (ch=leftKey) THEN Left
  6869. ⓪,ELSIF ch=wordLeftKey THEN WordLeft
  6870. ⓪,ELSIF ch=wordRightKey THEN WordRight
  6871. ⓪,ELSIF ch=TabRightKey THEN
  6872. ⓪.REPEAT
  6873. ⓪0Right
  6874. ⓪.UNTIL (OnSOLn() AND KeyPressed()) OR (ptr>=ptrEnd-2L) OR TabSet()
  6875. ⓪,ELSIF ch=TabLeftKey THEN
  6876. ⓪.REPEAT
  6877. ⓪0Left
  6878. ⓪.UNTIL (OnSOLn() AND KeyPressed()) OR (ptr<=ptrStart) OR TabSet()
  6879. ⓪,ELSIF ch=upKey THEN Up
  6880. ⓪,ELSIF ch=downKey THEN Down
  6881. ⓪,ELSIF ch=scrlUpKey THEN ScrollUp;
  6882. ⓪,ELSIF ch=scrlDownKey THEN ScrollDown;
  6883. ⓪,ELSIF ch=EnterKey THEN IF direction THEN Up ELSE Down END;
  6884. ⓪,END;
  6885. ⓪,DEC(rptf)
  6886. ⓪*UNTIL (rptf=0L) OR KeyPressed()
  6887. ⓪(END
  6888. ⓪&END;
  6889. ⓪&ASSEMBLER clr.l rptf clr findWord clr findSame clr infinite clr verify
  6890. ⓪&END
  6891. ⓪$END;
  6892. ⓪"UNTIL endOfEd (*2*);
  6893. ⓪"StopEditor;
  6894. ⓪"TermProcess (exitCode)
  6895. ⓪ END GEP_ED.
  6896. ⓪ ə
  6897. (* $FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$00007A4D$FFE597C0$000263E0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0$FFE597C0Ç$00007A4DT.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$FFE406A8$00007AD7$FFE406A8$00007A62$00007A9C$FFE406A8$00007B10$00007A9C$00007A4D$00002A9C$00002BD3$00002BE3$00007AC2$00007E04$00007AC2$FFE406A8ñÇâ*)
  6898.