{ Himpelsoft & Maxon präsentieren: } Program SystemMonitor; { benötigt mindestens 150 KByte Workspace } {$path "ram:include/","pascal:include/"} {$incl "intuition.lib","graphics.lib" } Const MaxStruct = 100; { maximale Anzahl von Einträgen in Strukturen } MaxRem =20 ; { Anzahl der gemerkten (und mit "B" zurück- verfolgbaren) "Jump"'s } ChH = 8; { CharHeight: Höhe eines Zeichens } EscKey = chr($1b); CrsrUKey = chr($81); { Die Procedure "ReadFromKeyboard" } CrsrDKey = chr($82); { wandelt die Escapsequenzen der } CrsrLKey = chr($83); { Cursortasten in diese Codes. } CrsrRKey = chr($84); Type Modes = { Modi: } (ByteDump,WordDump,LongDump,Asciidump, { verschiedene Dump-Arten } Structure, { Struktur-Modus, z. B. "ExecBase" } Nix { Text, z. B. "Help" oder "About" } ); Typus = { Eintragstypen von Strukturen: } (t_S, { Short } t_I, { integer } t_L, { Long } t_W, { Word } t_B, { Byte } t_str, { Zeiger auf String } t_sub { Unterstruktur } ); Bild32 = Array[1..16] of Long; { Typ für Images } IntArrMod = Array[ByteDump..Asciidump] Of integer; Feld = Record { Typ für Struktur-eintrag: } name: str; { Feldbezeichner } Offset: Long; { Adressdistanz zur Basis } typ: Typus; { Eintragstyp, s. o. } SubNum: integer { Typnummer einer Unterstruktur } End; Remem = Record { "Remember"-Struktur für "B"-Sprünge } Adr: Long; { alle relevanten Daten } Zeile,Spalte,StrNum: integer; { werden in einem solchen } Mode: Modes { Record aufbewahrt. } End; Var Breite,Hoehe: integer; { Screengröße } MyScreen: ^Screen; { Screenhandle } MyWindow: ^Window; { Windowhandle } Con: Ptr; { Zeiger auf Console-Device } Sig: Long; { Signalmaske } MyRast,MyUPt: Ptr; { " " RastPort und Userport } Mess: ^IntuiMessage; { empfangene Message } Klasse: Long; { "Class" der Message } Mode: Modes; { aktueller Modus, s. o. } Struct: Array[1..maxstruct] of Feld; { Speicher für Einträge der aktuellen Struktur } Remembers: Array[1..maxrem] of Remem; { Remember-Buffer } Adr,CursorAdr: Long; { Startadresse des Dumps/der Struktur und Adresse der Cursorposition } ende: Boolean; { Flag für Programmende } ch: Char; { zuletzt von Tastatur gelesenes Zeichen } Zeile,Spalte: integer; { Cursorposition im Dump bzw. in Struktur } Zeile0: integer; { erste dargestellte Zeile einer Struct } FeldAnz: integer; { Anzahl der Felder einer Struktur } StrNum: integer; { Nummer der Struktur (z.B. 1=ExecBase, 2=Node...} RemAnz: integer; { Ende des belegten Teils des Remember-Buffers } TextPage: integer; { Nummer der Textseite (0=About, 1=Help) } LineSize,Fieldsize: IntArrMod; { Umfang einer Zeile/eines Feldes im entsprechenden Dumpmodus } { Intuition-Strukturen für Menüs: } Menu0,Menu1,Menu2: Menu; Men00,Men01,Men02,Men10,Men11,Men12,Men13, Men14,Men140,Men141,Men142,Men143,Men144,Men145,Men146, Men15,Men150,Men151,Men152, Men20,Men21,Men22: MenuItem; Men00t,Men01t,Men02t,Men10t,Men11t,Men12t,Men13t, Men14t,Men140t,Men141t,Men142t,Men143t,Men144t,Men145t,Men146t, Men15t,Men150t,Men151t,Men152t, Men20t,Men21t,Men22t: IntuiText; { Strukturen für Gadgets und zugehörige Images: } Knopf1,Knopf2,Knopf3,Knopf4,Knopf5,Knopf6: Gadget; Image1,Image2,Image3,Image4,Image5,Image6: Image; Bild1,Bild2,Bild3,Bild4,Bild5,Bild6: ^Bild32; { PEEK dürfte jeder Ex-BASIC-Programmierer wohl kennen...} Function PeekB(a:Long):Byte; { Byte aus Speicher lesen } Var p:^Byte; Begin p:=ptr(a); PeekB:=p^ End; Function PeekW(a:Long):integer; Var p:^integer; Begin p:=ptr(a); PeekW:=p^ End; Function PeekL(a:Long):Long; Var p:^Long; Begin p:=ptr(a); PeekL:=p^ End; Procedure Clear; { Bildschirm löschen } Begin SetAPen(MyRast,0); RectFill(MyRast,0,0,Breite,17*8) End; Procedure CreateStruct(s:integer); { Jeder dem Monitor bekannten Amiga-Struktur ist eine Nummer zugeordnet (z.B. ExecBase=1, Node=2, ... ). Diese Prozedur initialisiert das Feld "Struct" mit den Einträgen der Struktur Nr. "s". } Procedure a(Off:Long; Nam:str; T:typus; Sub:integer); { "FeldAnz um 1 erhöhen und das entsprechende Felg von "Struct" mit den Parametern initialisieren } Begin Feldanz:=Feldanz+1; With Struct[Feldanz] Do Begin Offset:=Off; Name:=Nam; Typ:=T; SubNum:=Sub End; If CursorAdr>=Adr+Off Then Zeile:=FeldAnz End; Begin { Createstruct } FeldAnz:=0; Zeile:=1; StrNum:=s; Case s Of { Achtung, sehr langes "Case"! } 1: Begin { 1: ExecBase } a( 0,'LibNode', t_sub,3); a(34,'SoftVer', t_W,0); a(36,'LowMemChkSum',t_I,0); a(38,'ChkBase', t_L,0); a(42,'ColdCapture', t_L,0); a(46,'CoolCapture', t_L,0); a(50,'WarmCapture', t_L,0); a(54,'SysStkUpper', t_L,0); a(58,'SysStkLower', t_L,0); a(62,'MaxLocMem', t_L,0); a(66,'DebugEntry', t_L,0); a(70,'DebugData', t_L,0); a(74,'AlertData', t_L,0); a(78,'MaxExtMem', t_L,0); a(82,'ChkSum', t_W,0); a(84,'IntVects[0]', t_sub,7); a(96,'IntVects[1]', t_sub,7); a(108,'IntVects[2]', t_sub,7); a(120,'IntVects[3]', t_sub,7); a(132,'IntVects[4]', t_sub,7); a(144,'IntVects[5]', t_sub,7); a(156,'IntVects[6]', t_sub,7); a(168,'IntVects[7]', t_sub,7); a(180,'IntVects[8]', t_sub,7); a(192,'IntVects[9]', t_sub,7); a(204,'IntVects[10]',t_sub,7); a(216,'IntVects[11]',t_sub,7); a(228,'IntVects[12]',t_sub,7); a(240,'IntVects[13]',t_sub,7); a(252,'IntVects[14]',t_sub,7); a(264,'IntVects[15]',t_sub,7); a(276,'ThisTask', t_L,5); a(280,'IdleCount', t_L,0); a(284,'DispCount', t_L,0); a(288,'Quantum', t_W,0); a(290,'Elapsed', t_W,0); a(292,'SysFlags', t_W,0); a(294,'IDNestCnt', t_S,0); a(295,'TDNestCnt', t_S,0); a(296,'AttnFlags', t_W,0); a(298,'AttnResched',t_W,0); a(300,'ResModules', t_L,0); a(304,'TaskTrapCode',t_L,0); a(308,'TaskExceptCode',t_L,0); a(312,'TaskExitCode',t_L,0); a(316,'TaskSigAlloc',t_L,0); a(320,'TaskTrapAlloc',t_W,0); a(322,'MemList', t_Sub,4); a(336,'ResourceList',t_Sub,4); a(350,'DeviceList', t_Sub,4); a(364,'IntrList', t_Sub,4); a(378,'LibList', t_Sub,4); a(392,'PortList', t_Sub,4); a(406,'TaskReady', t_Sub,4); a(420,'TaskWait', t_Sub,4); a(434,'SoftInts', t_Sub,0); a(514,'LastAlert[0]',t_L,0); a(518,'LastAlert[1]',t_L,0); a(522,'LastAlert[2]',t_L,0); a(526,'LastAlert[3]',t_L,0); a(530,'VBlankFrequency',t_B,0); a(531,'PowerSupplyFrequency',t_B,0); a(532,'SemaphoreList',t_Sub,4); a(546,'KickMemPtr', t_L,0); a(550,'KickTagPtr', t_L,0); a(554,'KickCheckSum',t_L,0); a(558,'ExecBaseReserved',t_Sub,0); a(568,'ExecBaseNewReserved',t_Sub,0) End; 2: Begin { 2: Node } a( 0,'Succ', t_L,2); a( 4,'Pred', t_L,2); a( 8,'Type', t_B,0); a( 9,'Pri', t_S,0); a(10,'Name', t_str,0) End; 3: Begin { 3: Library } a( 0,'-Next', t_L,3); a( 0,'Node', t_Sub,2); a(14,'Flags', t_B,0); a(15,'pad', t_B,0); a(16,'NegSize', t_W,0); a(18,'PosSize', t_W,0); a(20,'Version', t_W,0); a(22,'Revision', t_W,0); a(24,'IdString', t_Str,0); a(28,'Sum', t_L,0); a(32,'OpenCnt', t_W,0) End 4: Begin { 4: List } a( 0,'Head', t_L,2); a( 4,'Tail', t_L,2); a( 8,'TailPred', t_L,2); a(12,'Type', t_B,0); a(13,'pad', t_B,0) End; 5: Begin { 5: Task } a( 0,'-Next', t_L,5); a( 0,'Node', t_Sub,2); a(14,'Flags', t_B,0); a(15,"State", t_B,0); a(16,"IDNestCnt", t_S,0); a(17,"TDNestCnt", t_S,0); a(18,"SigAlloc", t_L,0); a(22,"SigWait", t_L,0); a(26,"SigRecvd", t_L,0); a(30,"SigExcept", t_L,0); a(34,"TrapAlloc", t_W,0); a(36,"TrapAble", t_W,0); a(38,"ExceptData", t_L,0); a(42,"ExceptCode", t_L,0); a(46,"TrapData", t_L,0); a(50,"TrapCode", t_L,0); a(54,"SPReg", t_L,0); a(58,"SPLower", t_L,0); a(62,"SPUpper", t_L,0); a(66,"Switch", t_L,0); a(70,"Launch", t_L,0); a(74,"MemEntry", t_Sub,4); a(88,"UserData", t_L,0) End; 7: Begin { 7: IntVector } a( 0,'iv_Data', t_L,0); a( 4,'iv_Code', t_L,0); a( 8,'iv_Node', t_L,2) End; 100:Begin { 100: IntuitionBase } a( 0,'Libnode', t_S,3); a(34,'ViewLord', t_S,0); a(52,'ActiveWindow',t_L,101); a(56,'ActiveScreen',t_L,102); a(60,'FirstScreen', t_L,102); a(64,'Flags', t_L,0); a(68,'MouseY', t_I,0); a(70,'MouseX', t_I,0); a(72,'Seconds', t_L,0); a(76,'Micros', t_L,0) End; 101:Begin { 101: Window } a( 0,'NextWindow', t_L,101); a( 4,'LeftEdge', t_I,0); a( 6,'TopEdge', t_I,0); a( 8,'Width', t_W,0); a(10,'Height', t_W,0); a(12,'MouseX', t_I,0); a(14,'MouseY', t_I,0); a(16,"MinWidth", t_W,0); a(18,"MinHeight", t_W,0); a(20,"MaxWidth", t_W,0); a(22,"MaxHeight", t_W,0); a(24,"Flags", t_L,0); a(28,"MenuStrip", t_L,0); a(32,"Title", t_str,0); a(36,"FirstRequest",t_L,0); a(40,"DMRequest", t_L,0); a(44,"ReqCount", t_I,0); a(46,"WScreen", t_L,102); a(50,"RPort", t_L,0); a(54,"BorderLeft", t_S,0); a(55,"BorderTop", t_S,0); a(56,"BorderRight", t_S,0); a(57,"BorderBottom",t_S,0); a(58,"BorderRPort", t_L,0); a(62,"FirstGadget", t_L,0); a(66,"Parent", t_L,0); a(70,"Descendent", t_L,0); a(74,"Pointer", t_L,0); a(78,"PtrHeight", t_B,0); a(79,"PtrWidth", t_B,0); a(80,"XOffset", t_B,0); a(81,"YOffset", t_B,0); a(82,"IDCMPFlags", t_L,0); a(86,"UserPort", t_L,0); a(90,"WindowPort", t_L,0); a(94,"MessageKey", t_L,0); a(98,"DetailPen", t_B,0); a(99,"BlockPen", t_B,0); a(100,"CheckMark", t_L,0); a(104,"ScreenTitle",t_str,0); a(108,"GZZMouseX", t_I,0); a(110,"GZZMouseY", t_I,0); a(112,"GZZWidth", t_I,0); a(114,"GZZHeight", t_I,0); a(116,"ExtData", t_L,0); a(120,"UserData", t_L,0); a(124,"WLayer", t_L,0); a(128,"IFont", t_L,0) End; 102:Begin { 102: Screen } a( 0,"NextScreen", t_L,102); a( 4,"FirstWindow", t_L,101); a( 8,"LeftEdge", t_I,0); a(10,"TopEdge", t_I,0); a(12,"Width", t_W,0); a(14,"Height", t_W,0); a(16,"MouseY", t_I,0); a(18,"MouseX", t_I,0); a(20,"Flags", t_W,0); a(22,"Title", t_str,0); a(26,"DefaultTitle",t_str,0); a(30,"BarHeight", t_B,0); a(31,"BarVBorder", t_B,0); a(32,"BarHBorder", t_B,0); a(33,"MenuVBorder", t_B,0); a(34,"MenuHBorder", t_B,0); a(35,"WBorTop", t_B,0); a(36,"WBorLeft", t_B,0); a(37,"WBorRight", t_B,0); a(38,"WBorBottom", t_B,0); a(39,"KludgeFill00",t_B,0); a(40,"Font", t_L,0); a(44,"ViewPort", t_S,0); a(84,"RastPort", t_S,0); a(184,"BitMap", t_S,0); a(224,"LayerInfo", t_S,0); a(326,"FirstGadget",t_L,0); a(330,"DetailPen", t_B,0); a(331,"BlockPen", t_B,0); a(332,"SaveColor0", t_W,0); a(334,"BarLayer", t_L,0); a(338,"ExtData", t_L,0); a(342,"UserData", t_L,0) End; Otherwise { of CASE } a(0,'Ungültig', t_B,0) { Default für den Notfall } End End; { Procedure CreateStruct } Function FindWBScreen:Ptr; { liefert Zeiger auf den Workbench-Screen } Var scr: ^Screen; Begin scr:=Ptr(PeekL(Long(IntBase)+60)); { Das ist der Melmac-Trick: Auf diese Weise bekommt man den Zeiger "FirstScreen" der IntuitionBase-Struktur, ohne dazu das include- File "intuition/intuitionbase.h" laden zu müssen- spart immerhin 17 KByte Includes und ca. 1.5 Sekunden Compilezeit. } While (scr^.Title<>'Workbench Screen')and(scr^.NextScreen<>Nil) Do scr:=scr^.NextScreen; { WB-Screen aus Liste suchen } FindWBScreen:=scr End; Procedure Initialise; { Window öffen und so weiter } Var WBscr: ^Screen; Begin { Am Anfang "ExecBase" } Adr:=Long(SysBase); CursorAdr:=Adr; LineSize:=IntArrMod(16,16,16,64); Fieldsize:=IntArrMod(1,2,4,1); Zeile:=0; Spalte:=0; RemAnz:=0; Mode:=Structure; CreateStruct(1); { Libraries öffnen } OpenLib(Intbase,'intuition.library',0); OpenLib(GfxBase, 'graphics.library',0); WBscr:=FindWBscreen; { Speicher (CHIP-MEM!) für Images anfordern } Bild1:=ptr(Alloc_mem(sizeof(Bild32),2)); Bild2:=ptr(Alloc_mem(sizeof(Bild32),2)); Bild3:=ptr(Alloc_mem(sizeof(Bild32),2)); Bild4:=ptr(Alloc_mem(sizeof(Bild32),2)); Bild5:=ptr(Alloc_mem(sizeof(Bild32),2)); Bild6:=ptr(Alloc_mem(sizeof(Bild32),2)); { Dimensionen vom "ActiveScreen" (im allg. der Workbench-Screen) übernehmen } Breite:= WBscr^.Width; Hoehe := WBscr^.Height; { Screen und Window öffnen, Initialisierungen } MyScreen:=Open_Screen(0,0,Breite,Hoehe,2,0,1,HIRES or GENLOCK_VIDEO,'Himpelmon'); MyWindow:=Open_Window(0,10,Breite,Hoehe-10,1,MOUSEBUTTONS or GADGETDOWN or GADGETUP or MENUPICK, ACTIVATE or BORDERLESS,Nil,MyScreen,100,100,640,200); MyRast:=MyWindow^.RPort; MyUPt:=MyWindow^.UserPort; Con:=OpenConsole(MyWindow); WriteCon(Con,''\e'0 p'); { Cursor unsichtbar } { Menüs initialisieren und setzen } Menu0:=Menu(^Menu1,10,0,63,10,1,'Project',^Men00,0,0,0,0); Men00:=MenuItem(^Men01,0, 0,80,12,ITEMTEXT or HIGHCOMP or ITEMENABLED,0,^Men00t,Nil,' ',Nil,0); Men01:=MenuItem(^Men02,0,12,80,12,ITEMTEXT or HIGHCOMP or ITEMENABLED,0,^Men01t,Nil,' ',Nil,0); Men02:=MenuItem( Nil, 0,24,80,12,ITEMTEXT or HIGHCOMP or ITEMENABLED,0,^Men02t,Nil,' ',Nil,0); Men00t:=IntuiText(0,1,1,5,3,Nil,'About',Nil); Men01t:=IntuiText(0,1,1,5,3,Nil,'Help',Nil); Men02t:=IntuiText(0,1,1,5,3,Nil,'Quit',Nil); Menu1:=Menu(^Menu2,100,0,39,10,1,'Mode',^Men10,0,0,0,0); Men10:=MenuItem(^Men11,0, 0,120,12,ITEMTEXT+HIGHCOMP+ITEMENABLED+COMMSEQ,0,^Men10t,Nil,'B',Nil,0); Men11:=MenuItem(^Men12,0,12,120,12,ITEMTEXT+HIGHCOMP+ITEMENABLED+COMMSEQ,0,^Men11t,Nil,'W',Nil,0); Men12:=MenuItem(^Men13,0,24,120,12,ITEMTEXT+HIGHCOMP+ITEMENABLED+COMMSEQ,0,^Men12t,Nil,'L',Nil,0); Men13:=MenuItem(^Men14,0,36,120,12,ITEMTEXT+HIGHCOMP+ITEMENABLED+COMMSEQ,0,^Men13t,Nil,'A',Nil,0); Men14:=MenuItem(^Men15,0,48,120,12,ITEMTEXT+HIGHCOMP+ITEMENABLED ,0,^Men14t,Nil,' ',^Men140,0); Men140:=MenuItem(^Men141,100, 0,120,10,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men140t,Nil,' ',Nil,0); Men141:=MenuItem(^Men142,100,10,120,10,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men141t,Nil,' ',Nil,0); Men142:=MenuItem(^Men143,100,20,120,10,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men142t,Nil,' ',Nil,0); Men143:=MenuItem(^Men144,100,30,120,10,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men143t,Nil,' ',Nil,0); Men144:=MenuItem(^Men145,100,40,120,10,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men144t,Nil,' ',Nil,0); Men145:=MenuItem(^Men146,100,50,120,10,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men145t,Nil,' ',Nil,0); Men146:=MenuItem( Nil ,100,60,120,10,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men146t,Nil,' ',Nil,0); Men15:=MenuItem( Nil, 0,60,120,12,ITEMTEXT+HIGHCOMP+ITEMENABLED ,0,^Men15t,Nil,' ',^Men150,0); Men150:=MenuItem(^Men151,100, 0,120,10,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men150t,Nil,' ',Nil,0); Men151:=MenuItem(^Men152,100,10,120,10,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men151t,Nil,' ',Nil,0); Men152:=MenuItem( Nil ,100,20,120,10,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men152t,Nil,' ',Nil,0); Men10t:=IntuiText(0,1,1,4,2,Nil,'Bytes',Nil); Men11t:=IntuiText(0,1,1,4,2,Nil,'Words',Nil); Men12t:=IntuiText(0,1,1,4,2,Nil,'Longwords',Nil); Men13t:=IntuiText(0,1,1,4,2,Nil,'Ascii',Nil); Men14t:=IntuiText(0,1,1,4,2,Nil,'Exec',Nil); Men140t:=IntuiText(0,1,1,4,1,Nil,'ExecBase',Nil); Men141t:=IntuiText(0,1,1,4,1,Nil,'Node',Nil); Men142t:=IntuiText(0,1,1,4,1,Nil,'Library',Nil); Men143t:=IntuiText(0,1,1,4,1,Nil,'List',Nil); Men144t:=IntuiText(0,1,1,4,1,Nil,'Task',Nil) Men145t:=Intuitext(0,1,1,4,1,Nil,'?',Nil); Men146t:=Intuitext(0,1,1,4,1,Nil,'IntVector',Nil); Men15t:=IntuiText(0,1,1,4,2,Nil,'Intuition',Nil); Men150t:=IntuiText(0,1,1,4,1,Nil,'IntuitionBase',Nil); Men151t:=IntuiText(0,1,1,4,1,Nil,'Window',Nil); Men152t:=IntuiText(0,1,1,4,1,Nil,'Screen',Nil); Menu2:=Menu(Nil,200,0,63,10,1,'Address',^Men20,0,0,0,0); Men20:=MenuItem(^Men21,0, 0,120,12,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men20t,Nil,' ',Nil,0); Men21:=MenuItem(^Men22,0,12,120,12,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men21t,Nil,' ',Nil,0); Men22:=MenuItem( Nil, 0,24,120,12,ITEMTEXT+HIGHCOMP+ITEMENABLED,0,^Men22t,Nil,' ',Nil,0); Men20t:=IntuiText(0,1,1,4,2,Nil,'MemBase',Nil); Men21t:=IntuiText(0,1,1,4,2,Nil,'SysBase',Nil); Men22t:=IntuiText(0,1,1,4,2,Nil,'IntBase',Nil); SetMenuStrip(MyWindow,^Menu0); { Gadgets und deren Images initialisieren } Bild1^:=Bild32( %00011111111111111111111111111000, %01110000000000000000000000001110, %11100000000000111100000000000111, %11000000000001111110000000000011, %11000000000011100111000000000011, %11000000000111000011100000000011, %11000000001110000001110000000011, %11000000011100000000111000000011, %11000000111000000000011100000011, %11000001110000000000001110000011, %11000011100000000000000111000011, %11000011100000000000000111000011, %11000001111111111111111110000011, %11100000000000000000000000000111, %01110000000000000000000000001110, %00011111111111111111111111111000); Bild2^:=Bild32( %00011111111111111111111111111000, %01110000000000000000000000001110, %11100000000000000000000000000111, %11000001111111111111111110000011, %11000011100000000000000111000011, %11000011100000000000000111000011, %11000001110000000000001110000011, %11000000111000000000011100000011, %11000000011100000000111000000011, %11000000001110000001110000000011, %11000000000111000011100000000011, %11000000000011100111000000000011, %11000000000001111110000000000011, %11100000000000111100000000000111, %01110000000000000000000000001110, %00011111111111111111111111111000); Bild3^:=Bild32( %00011111111111111111111111111000, %01110000000000000000000000001110, %11100000000001111110000000000111, %11000000000111100111100000000011, %11000000011110000001111000000011, %11000001111000000000011110000011, %11000011111111111111111111000011, %11000000000000000000000000000011, %11000000000001111110000000000011, %11000000000111100111100000000011, %11000000011110000001111000000011, %11000001111000000000011110000011, %11000011111111111111111111000011, %11100000000000000000000000000111, %01110000000000000000000000001110, %00011111111111111111111111111000); Bild4^:=Bild32( %00011111111111111111111111111000, %01110000000000000000000000001110, %11100000000000000000000000000111, %11000011111111111111111111000011, %11000001111000000000011110000011, %11000000011110000001111000000011, %11000000000111100111100000000011, %11000000000001111110000000000011, %11000000000000000000000000000011, %11000011111111111111111111000011, %11000001111000000000011110000011, %11000000011110000001111000000011, %11000000000111100111100000000011, %11100000000001111110000000000111, %01110000000000000000000000001110, %00011111111111111111111111111000); Bild5^:=Bild32( %00011111111111111111111111111000, %01110000000000000000000000001110, %11100000000000000000111100000111, %11000000000000000111111110000011, %11000000000000111110000110000011, %11000000000111110000000110000011, %11000000111110000000000110000011, %11000111110000000000000110000011, %11000111110000000000000110000011, %11000000111110000000000110000011, %11000000000111110000000110000011, %11000000000000111110000110000011, %11000000000000000111111110000011, %11100000000000000000111100000111, %01110000000000000000000000001110, %00011111111111111111111111111000); Bild6^:=Bild32( %00011111111111111111111111111000, %01110000000000000000000000001110, %11100000111100000000000000000111, %11000001111111100000000000000011, %11000001100001111100000000000011, %11000001100000001111100000000011, %11000001100000000001111100000011, %11000001100000000000001111100011, %11000001100000000000001111100011, %11000001100000000001111100000011, %11000001100000001111100000000011, %11000001100001111100000000000011, %11000001111111100000000000000011, %11100000111100000000000000000111, %01110000000000000000000000001110, %00011111111111111111111111111000); Image1:=Image(0,0,32,16,1,Bild1,1,0,Nil); Image2:=Image(0,0,32,16,1,Bild2,1,0,Nil); Image3:=Image(0,0,32,16,1,Bild3,1,0,Nil); Image4:=Image(0,0,32,16,1,Bild4,1,0,Nil); Image5:=Image(0,0,32,16,1,Bild5,1,0,Nil); Image6:=Image(0,0,32,16,1,Bild6,1,0,Nil); Knopf1:=Gadget(Nil, 40,140,32,12,GADGHNONE+GADGIMAGE,GADGIMMEDIATE,BOOLGADGET,^Image1,Nil,Nil,0,Nil,1,0); Knopf2:=Gadget(Nil, 40,160,32,12,GADGHNONE+GADGIMAGE,GADGIMMEDIATE,BOOLGADGET,^Image2,Nil,Nil,0,Nil,2,0); Knopf3:=Gadget(Nil, 80,140,32,12,GADGHNONE+GADGIMAGE,GADGIMMEDIATE,BOOLGADGET,^Image3,Nil,Nil,0,Nil,3,0); Knopf4:=Gadget(Nil, 80,160,32,12,GADGHNONE+GADGIMAGE,GADGIMMEDIATE,BOOLGADGET,^Image4,Nil,Nil,0,Nil,4,0); Knopf5:=Gadget(Nil, 0,150,32,12,GADGHNONE+GADGIMAGE,GADGIMMEDIATE,BOOLGADGET,^Image5,Nil,Nil,0,Nil,5,0); Knopf6:=Gadget(Nil,120,150,32,12,GADGHNONE+GADGIMAGE,GADGIMMEDIATE,BOOLGADGET,^Image6,Nil,Nil,0,Nil,6,0); AddGadget(MyWindow,^Knopf1,Nil); AddGadget(MyWindow,^Knopf2,Nil); AddGadget(MyWindow,^Knopf3,Nil); AddGadget(MyWindow,^Knopf4,Nil); AddGadget(MyWindow,^Knopf5,Nil); AddGadget(MyWindow,^Knopf6,Nil); RefreshGadgets(MyWindow^.FirstGadget,MyWindow,Nil); End; Procedure CloseEverything; { alles schließen } Begin CloseConsole(Con); Close_Window(MyWindow); Close_Screen(MyScreen); CloseLib(intbase); CloseLib(gfxbase) End; Procedure Erinnere; { Daten in Remember-buffer übernehmen } Var i:Integer; Begin If RemAnz=MaxRem Then { Array ist voll, also "scrollen" } Begin For i:=1 to MaxRem-1 Do Remembers[i]:=Remembers[i+1] End Else RemAnz:=RemAnz+1; { noch nicht voll, also ein Element hinzufügen } Remembers[RemAnz]:=Remem(Adr,Zeile,Spalte,StrNum,Mode); End; Procedure CalcZ0; { "Zeile0" berechnen } Begin If Zeile<=8 Then Zeile0:=1 Else If Zeile>=FeldAnz-8 Then Begin If FeldAnz>=16 Then Zeile0:=Feldanz-15 Else Zeile0:=1 End Else Zeile0:=Zeile-7; End; Procedure SetCursor; Var Cursort: Intuitext; Begin Case Mode of ByteDump:Begin Cursort:=Intuitext(2,0,6,0,0,Nil,' ',Nil); PrintIText(MyRast,^Cursort,8*(8+3*Spalte),2+8*Zeile) End; WordDump:Begin Cursort:=IntuiText(2,0,6,0,0,Nil,' ',Nil); PrintIText(MyRast,^Cursort,8*(8+5*(Spalte div 2)),2+8*Zeile) End; LongDump:Begin Cursort:=IntuiText(2,0,6,0,0,Nil,' ',Nil); PrintIText(MyRast,^Cursort,8*(8+9*(Spalte div 4)),2+8*Zeile) End; AsciiDump:Begin Cursort:=IntuiText(2,0,6,0,0,Nil,' ',Nil); PrintIText(MyRast,^Cursort,8*(8+Spalte),2+8*Zeile) End; Structure:Begin CalcZ0; Cursort:=IntuiText(2,0,6,0,0,Nil,' ',Nil); PrintIText(MyRast,^Cursort,8*31,2+8*(Zeile-Zeile0)) End; Else; End End; Procedure DecodeHex(p:ptr; Zahl:Long; Len:integer); { "Zahl" als hex in String p ablegen, Länge "Len" } Var i,z:integer; pp:^Array[0..7] of char; Begin pp:=p; For i:=Len-1 Downto 0 Do Begin z:=Zahl and 15; If Zahl>=0 Then Zahl:= Zahl div 16 Else Zahl:=(Zahl and $7fffffff) div 16 + $8000000; If z<10 Then pp^[i]:=chr(ord('0')+z) Else pp^[i]:=chr(ord('A')+z-10) End End; Procedure StructZeileAus(i,z: integer); { Zeile i einer Struktur in NBildschirmzeile z ausgeben } Var j: integer; nam: ^String[80]; a: Long; Buffer: string[80]; Outputt: Intuitext; Begin Outputt:=Intuitext(1,0,1,0,0,Nil,^Buffer,Nil); For j:=1 to 76 do Buffer[j]:=' '; Buffer[77]:=chr(0) If i<=FeldAnz Then Begin a:=Adr+Struct[i].Offset; DecodeHex(^Buffer[1],a,6); Buffer[7]:=' '; j:=1; nam:=Struct[i].Name; While (j<20)and(nam^[j]<>chr(0)) Do Begin Buffer[10+j]:=nam^[j]; j:=j+1 End; Case Struct[i].typ Of t_L:Begin Buffer[9]:='L'; DecodeHex(^Buffer[32],PeekL(a),8) End; t_W:Begin Buffer[9]:='W'; DecodeHex(^Buffer[32],PeekW(a),4) End; t_I:Begin Buffer[9]:='I'; If PeekW(a)>=0 Then DecodeHex(^Buffer[32],PeekW(a),4) Else Begin Buffer[32]:='-'; DecodeHex(^Buffer[33],-PeekW(a),4) End; End; t_S:Begin Buffer[9]:='S'; If Short(PeekB(a))>=0 Then DecodeHex(^Buffer[32],PeekB(a),2) Else Begin Buffer[32]:='-'; DecodeHex(^Buffer[33],-Short(PeekB(a)),2) End End; t_B:Begin Buffer[9]:='B'; DecodeHex(^Buffer[32],PeekB(a),2) End; t_str:Begin Buffer[9]:='"'; DecodeHex(^Buffer[32],a,6); j:=1; nam:=ptr(PeekL(a)); While (j<25)and(nam^[j]<>chr(0)) Do Begin Buffer[40+j]:=nam^[j]; j:=j+1 End End; t_Sub:Begin If Struct[i].SubNum=0 Then Buffer[9]:='?' Else Buffer[9]:='*'; Buffer[32]:='.' End; Otherwise End; End; PrintIText(MyRast,^Outputt,0,2+8*z); End; Procedure Ausgabe(m:Modes); Var Buffer: string[80]; Outputt: Intuitext; Procedure HexdumpAus(m:modes); Var a:Long; bpuf:^array[0..15]of Byte; wpuf:^array[0..7] of Word; lpuf:^array[0..3] of Long; i,j,k,step:integer; Begin If m=Bytedump then a:=Adr Else a:=Adr and $fffffe; Case m of Bytedump: step:=1; WordDump: step:=2; LongDump: step:=4 End; For i:=0 to 15 do { 16 Zeilen } Begin DecodeHex(^Buffer[1],a,6); Buffer[7]:=':'; Buffer[8]:=' '; bpuf:=ptr(a); wpuf:=ptr(a); lpuf:=ptr(a); j:=0; k:=9; While j<16 do Begin Case m of ByteDump:DecodeHex(^Buffer[k],bpuf^[j],2); Worddump:DecodeHex(^Buffer[k],wpuf^[j div 2],4); LongDump:DecodeHex(^Buffer[k],lpuf^[j div 4],8) End; k:=k+2*step+1; Buffer[k-1]:=' '; j:=j+step; End; For j:=0 to 15 Do If (bpuf^[j]>=ord(' ')) and (bpuf^[j]<128) Then Buffer[k+j]:=chr(bpuf^[j]) Else Buffer[k+j]:='.'; Buffer[k+16]:=chr(0); PrintIText(MyRast,^Outputt,0,2+8*i); If i=Zeile Then SetCursor; a:=a+16 End; End; Procedure AscDumpAus; Var a:Long; cpuf:^Char; i,j:integer; Begin a:=Adr; For i:=0 to 15 do { 16 Zeilen } Begin DecodeHex(^Buffer[1],a,6); Buffer[7]:=':'; Buffer[8]:=' '; For j:=0 to 63 do Begin cpuf:=ptr(a+j); If (cpuf^>=' ') and (cpuf^chr($a0)) Then Buffer[9+j]:=Cpuf^ Else Buffer[9+j]:='.' End; Buffer[73]:=chr(0); PrintIText(MyRast,^Outputt,0,2+8*i); If i=Zeile Then SetCursor; a:=a+64 End; End; Procedure InfoAus; Procedure ia(s:str; x,y,pen,md:integer); Var it:IntuiText; Begin it:=IntuiText(pen,0,md,0,0,Nil,s,Nil); PrintIText(MyRast,^it,x,y) End; Begin If TextPage=0 Then Begin ia('H I M P E L M O N',252,10,3,1); ia('Der System-Analytiker',236,20,1,1); ia('Geschreiben von:',50,50,1,1); ia('Jens "Himpelsoft" Gelhar',50,70,3,1); ia('Alderichstraße 19',50,80,3,1); ia('4790 Paderborn',50,90,3,1) End Else Begin ia('Hilfe',20,10,3,1); ia('Folgende Tasten sind in der vorliegenden Version belegt:',20,30,1,1); ia('J ("Jump")',20,50,1,1); ia('B ("Back")',20,60,1,1); ia('Esc (Ende)',20,70,1,1); ia('Cursortasten',20,80,1,1) End End; Procedure StructAus; Var i:integer; Begin CalcZ0; For i:=Zeile0 to Zeile0+15 Do Begin StructZeileAus(i,i-Zeile0); If i=Zeile Then SetCursor; End End; Begin { Ausgabe } Outputt:=Intuitext(1,0,1,0,0,Nil,^Buffer,Nil); Case M of ByteDump,WordDump,LongDump: HexdumpAus(M); AsciiDump: AscDumpAus; Structure: StructAus; Nix: InfoAus; End End; Procedure Scroll1Up; Begin If Mode<=AsciiDump Then Begin If Mode=Asciidump Then Adr:=Adr-64 Else Adr:=Adr-16; Scrollraster(MyRast,0,-ChH,0,0,Breite,16*ChH); Ausgabe(Mode) End Else If Mode=Structure Then Begin Scrollraster(MyRast,0,-ChH,0,0,Breite,16*ChH); CalcZ0; StructZeileAus(Zeile0,0) End End; Procedure Scroll1Down; Begin If Mode<=AsciiDump Then Begin If Mode=Asciidump Then Adr:=Adr+64 Else Adr:=Adr+16; Scrollraster(MyRast,0,ChH,0,2,Breite,17*ChH); Ausgabe(Mode) End Else If Mode=Structure Then Begin Scrollraster(MyRast,0,ChH,0,2,Breite,17*ChH); CalcZ0; StructZeileAus(Zeile0+15,15); End End; Procedure Scroll16Up; Begin If Mode<=AsciiDump Then Begin If Mode=Asciidump Then Adr:=Adr-16*64 Else Adr:=Adr-256; Ausgabe(Mode) End End; Procedure Scroll16Down; Begin If Mode<=AsciiDump Then Begin If Mode=Asciidump Then Adr:=Adr+16*64 Else Adr:=Adr+256; Ausgabe(Mode) End End; Procedure CursorUp; Var zz: integer; Begin If Mode=Structure Then Begin SetCursor; zz:=Zeile0; Zeile:=Zeile-1; CalcZ0; CursorAdr:=Adr+Struct[Zeile].Offset; If zz<>Zeile0 Then Scroll1Up; StructZeileAus(Zeile,Zeile-Zeile0); SetCursor End Else If Zeile>0 Then Begin SetCursor; Zeile:=Zeile-1; SetCursor End Else Begin Case Mode Of Asciidump: Adr:=Adr-64; ByteDump,WordDump,LongDump: Adr:=Adr-16 Else End; Scroll1Up End End; Procedure CursorDown; Var zz: integer; Begin If Mode=Structure Then Begin SetCursor; zz:=Zeile0; Zeile:=Zeile+1; CalcZ0; CursorAdr:=Adr+Struct[Zeile].Offset; If Zeile0<>zz Then Scroll1Down; StructZeileAus(Zeile,Zeile-Zeile0); SetCursor End Else If Zeile<15 Then Begin SetCursor; Zeile:=Zeile+1; SetCursor End Else Begin Case Mode Of Asciidump: Adr:=Adr+64; ByteDump,WordDump,LongDump: Adr:=Adr+16 Else End; Scroll1Down End End; Procedure CursorLeft; Begin If Mode<=AsciiDump Then If Spalte>=FieldSize[Mode] Then Begin SetCursor; Spalte:=(Spalte and (64-Fieldsize[Mode]))-Fieldsize[Mode]; SetCursor End Else Begin CursorUp; SetCursor; Spalte:=LineSize[Mode]-Fieldsize[Mode]; SetCursor End; End; Procedure CursorRight; Begin If Mode<=AsciiDump Then If Spalte < LineSize[Mode]-Fieldsize[Mode] Then Begin SetCursor; Spalte:=(Spalte and (64-Fieldsize[Mode]))+Fieldsize[Mode]; SetCursor End Else Begin CursorDown; SetCursor; Spalte:=0; SetCursor End End; Procedure CalcCursorAdr; { CursorAdr stezen } Begin If mode<=Asciidump Then Cursoradr:=Adr+Zeile*Linesize[mode]+Spalte Else If mode=Structure Then CursorAdr:=Adr+struct[Zeile].Offset Else CursorAdr:=Adr End; Procedure Jump; Begin Erinnere; If Mode0 Then Begin Adr:= Remembers[RemAnz].Adr; Zeile:= Remembers[RemAnz].Zeile; Spalte:=Remembers[RemAnz].Spalte; StrNum:=Remembers[RemAnz].StrNum; Mode:= Remembers[RemAnz].Mode RemAnz:=RemAnz-1 CalcCursorAdr; Clear; If Mode=Structure Then CreateStruct(StrNum); Ausgabe(Mode) End Else DisplayBeep(MyScreen) { Remember-Buffer ist leer } End; Procedure ReadFromKeyboard; Var c1: Char; Begin ch:=ReadCon(Con); { Zeichen von Tastatur? } If ch=chr($9b) Then Begin c1:=ReadCon(Con); { erstes Zeichen der Escape-Sequenz } Case c1 Of 'A': ch:=CrsrUKey; 'B': ch:=CrsrDKey; 'C': ch:=CrsrRKey; 'D': ch:=CrsrLKey; Else ch:=chr(0) End; { unbekannte Sequenz } End End; Procedure MenuHandling(item:Cardinal); { Menu-Handhabung } Var menue,menitem,subitem:integer; Begin If item<>$ffff Then Begin { in "item" sind Menü-, Menüpunkt- unt Untermenü-nummer enthalten. } menue:=item and $1f; menitem:=(item and $7e0) div 32; subitem:=(item and $f800) div 2048; Case menue of 0:Case menitem of { Menu "Project" } 0: Begin Mode:=Nix; TextPage:=0; Clear; Ausgabe(Mode) End; 1: Begin Mode:=Nix; TextPage:=1; Clear; Ausgabe(Mode) End; 2: ende:=true End; 1:If menitem<4 Then { Menu "Mode" } Begin If menitem<>ord(Mode) Then Begin If Mode<=AsciiDump Then CursorAdr:=Adr+Linesize[Mode]*Zeile+Spalte; Mode:=Modes(menitem); If Mode<=AsciiDump Then Begin Zeile :=(CursorAdr-Adr)div LineSize[Mode]; Spalte:=(CursorAdr-Adr)mod LineSize[Mode]; Adr:=Adr+16*LineSize[Mode]*(Zeile div 16); Zeile:=Zeile mod 16 End; Clear; Ausgabe(Mode) End End Else If menitem=4 Then Begin Adr:=Adr and $fffffe; If Mode<=AsciiDump Then CursorAdr:=Adr+Linesize[Mode]*Zeile+Spalte; CreateStruct(subitem+1); Mode:=Structure; Clear; Ausgabe(Mode) End Else If Menitem=5 Then Begin Adr:=Adr and $fffffe; If Mode<=AsciiDump Then CursorAdr:=Adr+Linesize[Mode]*Zeile+Spalte; CreateStruct(subitem+100); Mode:=Structure; Clear; Ausgabe(Mode) End; 2:Begin { Menu "Adress" } Case Menitem Of 0: Begin Erinnere; Mode:=LongDump; Adr:=0; CursorAdr:=0; Zeile:=0; Spalte:=0; Clear; Ausgabe(Mode) End; 1: Begin Erinnere; Mode:=Structure; Adr:=Long(SysBase); CursorAdr:=Adr; CreateStruct(1); Clear; Ausgabe(Mode) End; 2: Begin Erinnere; Mode:=Structure; Adr:=Long(IntBase); CursorAdr:=Adr; CreateStruct(100); Clear; Ausgabe(Mode) End; Otherwise End; End End; End End; Procedure GadgetHandling(g:p_Gadget); Var i:integer; Begin If g<>Nil Then Case g^.GadgetID of 1:Scroll1Up; 2:Scroll1Down; 3:Scroll16Up; 4:Scroll16Down; 5:If Mode<=Asciidump Then Begin Case Mode Of ByteDump,Asciidump: Adr:=Adr+1; WordDump: Adr:=(Adr and $fffffe)+2; LongDump: Adr:=(Adr and $fffffe)+4; End; Ausgabe(Mode) End; 6:If Mode<=Asciidump Then Begin Case Mode Of ByteDump,Asciidump: Adr:=Adr-1; WordDump: Adr:=(Adr and $fffffe)-2; LongDump: Adr:=(Adr and $fffffe)-4; End; Ausgabe(Mode) End; Otherwise; End; End; Begin {***** Hauptprogramm *****} Initialise; ende:=false; Ausgabe(Mode); { Hauptschleife (Achtung: lang!) } Repeat { Message-Management } Mess:=Get_Msg(MyUPt); { Nachricht am Userport? } While Mess<>Nil Do Begin Klasse:=Mess^.Class; { ja, Typ ermitteln } If Klasse and MENUPICK<>0 Then Menuhandling(Mess^.Code); If Klasse and GADGETDOWN<>0 Then Gadgethandling(Mess^.IAddress);; Reply_Msg(Mess); Mess:=Get_Msg(MyUPt); End; ReadFromKeyboard; Case ch Of EscKey: ende:=true; { Esc-Taste } CrsrUKey:If (mode<=AsciiDump) or ((mode=Structure) and (Zeile>1)) Then CursorUp; CrsrDKey:If (mode<=AsciiDump) or ((mode=structure) and (Zeile