home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyInteruptSafeDebug.p < prev    next >
Encoding:
Text File  |  1995-03-19  |  3.0 KB  |  143 lines  |  [TEXT/CWIE]
  1. unit MyInteruptSafeDebug;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.         
  8.     procedure InitInteruptSafeDebug;
  9.     procedure FinishInteruptSafeDebug;
  10.     procedure InteruptSafeDebug (s: str255);
  11.     procedure InteruptSafeDebugChar (ch: char);
  12.  
  13. implementation
  14.  
  15.     uses
  16.         Fonts,Quickdraw,Memory,Windows,QLowLevel,MyTypes;
  17.  
  18.     const
  19.         ourfont = geneva;
  20.         oursize = 9;
  21.         ourheight = 10;
  22.         ourdescent = 2;
  23.         max_pixelsize = 8;
  24.         ourrows = 12;
  25.         our_magic = $12435687;
  26.         debug = true;
  27.  
  28.     type
  29.         CharArray = packed array[char, 1..ourheight, 1..max_pixelsize] of byte;
  30.  
  31.     const
  32.         WMgrPort = $9DE;
  33.  
  34.     type
  35.         GrafPtrPtr = ^GrafPtr;
  36.  
  37.     var
  38.         baseaddr: Ptr;
  39.         rowbytes: integer;
  40.         pixelsize: integer;
  41.         ourchars: ^CharArray;
  42.         pos, count: integer;
  43.         row: integer;
  44.         magic: longint;
  45.  
  46.     procedure InitInteruptSafeDebug;
  47.         var
  48.             wp: WindowPtr;
  49.             r: rect;
  50.             i, h, c: integer;
  51.             ch: char;
  52.     begin
  53.         if debug then begin
  54.             magic := our_magic;
  55.             ourchars := POINTER(NewPtr(SizeOf(CharArray)));
  56.             SetRect(r, 0, 40, 100, 100);
  57.             wp := NewCWindow(nil, r, '', true, 0, POINTER(-1), false, 0);
  58.             SetPort(wp);
  59.             TextFont(ourfont);
  60.             TextSize(oursize);
  61.             baseaddr := CGrafPtr(wp)^.portPixMap^^.baseAddr;
  62.             pixelsize := CGrafPtr(wp)^.portPixMap^^.pixelsize;
  63.             rowbytes := BAND(CGrafPtr(wp)^.portPixMap^^.rowbytes, $3FFF);
  64.             r := GetQDGlobals^.screenbits.bounds;
  65.             for ch := chr(0) to chr(255) do begin
  66.                 SetRect(r, 0, 0, 100, 100);
  67.                 EraseRect(r);
  68.                 MoveTo(0, ourheight - ourdescent);
  69.                 DrawChar(ch);
  70.                 for h := 1 to ourheight do begin
  71.                     for c := 1 to pixelsize do begin
  72.                         ourchars^[ch, h, c] := BAND(AddPtrLong(baseaddr, longInt(40 + h - 1) * rowbytes + c - 1)^, $FF);
  73.                     end;
  74.                 end;
  75.             end;
  76.             DisposeWindow(wp);
  77.             SetPort(GrafPtrPtr(WMgrPort)^);
  78.             r := GetQDGlobals^.screenbits.bounds;
  79.             OffsetPtr(baseaddr, longInt(r.bottom - r.top - ourheight * ourrows) * rowbytes);
  80.             r.top := r.bottom - ourheight * ourrows;
  81.             EraseRect(r);
  82.             pos := 0;
  83.             row := 0;
  84.             count := (r.right - r.left) div 8 - 2;
  85.             for i := 1 to count * ourrows do begin
  86.                 InteruptSafeDebugChar(' ');
  87.             end;
  88.         end;
  89.     end;
  90.  
  91.     procedure FinishInteruptSafeDebug;
  92.     begin
  93.         if debug then begin
  94.             DisposePtr(POINTER(ourchars));
  95.         end;
  96.     end;
  97.  
  98. {$PUSH}
  99. {$D-}
  100.     procedure InteruptSafeDebugChar (ch: char);
  101.         procedure Plot (ch: char);
  102.             var
  103.                 h, c: integer;
  104.         begin
  105.             for h := 1 to ourheight do begin
  106.                 for c := 1 to pixelsize do begin
  107.                     AddPtrLong(baseaddr, longInt(h - 1 + row * ourheight) * rowbytes + pos * pixelsize + c - 1)^ := ourchars^[ch, h, c];
  108.                 end;
  109.             end;
  110.         end;
  111.     begin
  112.         if debug then begin
  113.             if magic <> our_magic then begin
  114.                 DebugStr('BANG!');
  115.             end;
  116.             Plot(ch);
  117.             pos := (pos + 1) mod count;
  118.             if pos = 0 then begin
  119.                 row := (row + 1) mod ourrows;
  120.             end;
  121.             Plot('•');
  122.         end;
  123.     end;
  124.  
  125.     procedure InteruptSafeDebug (s: str255);
  126.         var
  127.             i: integer;
  128.     begin
  129.         if debug then begin
  130.             if s = '' then begin
  131.                 InteruptSafeDebugChar('*');
  132.             end
  133.             else begin
  134.                 for i := 1 to length(s) do begin
  135.                     InteruptSafeDebugChar(s[i]);
  136.                 end;
  137.                 InteruptSafeDebugChar('.');
  138.             end;
  139.         end;
  140.     end;
  141. {$POP}
  142.  
  143. end.