Browse Source

+ graph unit for Mac OS X. Note that you have to change one thing in graph
programs to use it: put the main program code in a function with signature
"function graphprog(p: pointer): longint;" and then start the program
by calling "StartGraphProgram(@graphprog);"
* compilation not yet enabled because graph needs to be moved to
packages/extra first (since this graph unit depends on packages/extra/
univint), and it's also not yet really polished (e.g. hardcoded to
640x480x256 colors)
* Something which will probably never work correctly:
* getpixel (and therefore also and/or/xorput), because you cannot
completely disable anti-aliasing in quartz. Further, the quartz api
requires floating point color component values when drawing, while
the bitmap from which we read the pixels back represents the colors
component values as bytes (which causes extra rounding errors).
Only solvable if we manually duplicate all drawing in a separate
buffer (although then you still won't erase the anti-aliasing pixels
in the real bitmap). An upside of the automatic anti-aliasing is that
all drawing looks nicer.

git-svn-id: trunk@7700 -

Jonas Maebe 18 years ago
parent
commit
b6f4e26631
2 changed files with 1077 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 1076 0
      packages/base/graph/macosx/graph.pp

+ 1 - 0
.gitattributes

@@ -800,6 +800,7 @@ packages/base/graph/inc/gtext.inc svneol=native#text/plain
 packages/base/graph/inc/makefile.inc svneol=native#text/plain
 packages/base/graph/inc/modes.inc svneol=native#text/plain
 packages/base/graph/inc/palette.inc svneol=native#text/plain
+packages/base/graph/macosx/graph.pp svneol=native#text/plain
 packages/base/graph/ptcgraph.pp svneol=native#text/x-pascal
 packages/base/graph/unix/ggigraph.pp svneol=native#text/plain
 packages/base/graph/unix/graph.pp svneol=native#text/plain

+ 1076 - 0
packages/base/graph/macosx/graph.pp

@@ -0,0 +1,1076 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl
+
+    This file implements the linux GGI support for the graph unit
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Graph;
+interface
+
+uses
+  { in the interface so the graphh definitions of moveto etc override }
+  { the ones in the universal interfaces                              }
+  cthreads, FPCMacOSAll;
+
+
+type
+  TGraphProgram = function(p: pointer): longint;
+
+  procedure StartGraphProgram(p: TGraphProgram);
+
+{$i graphh.inc}
+
+Const
+  { Supported modes }
+  {(sg) GTEXT deactivated because we need mode #0 as default mode}
+  {GTEXT             = 0;                 Compatible with VGAlib v1.2 }
+  G320x200x16       = 1;
+  G640x200x16       = 2;
+  G640x350x16       = 3;
+  G640x480x16       = 4;
+  G320x200x256      = 5;
+  G320x240x256      = 6;
+  G320x400x256      = 7;
+  G360x480x256      = 8;
+  G640x480x2        = 9;
+
+  G640x480x256      = 10;
+  G800x600x256      = 11;
+  G1024x768x256     = 12;
+
+  G1280x1024x256    = 13;   { Additional modes. }
+
+  G320x200x32K      = 14;
+  G320x200x64K      = 15;
+  G320x200x16M      = 16;
+  G640x480x32K      = 17;
+  G640x480x64K      = 18;
+  G640x480x16M      = 19;
+  G800x600x32K      = 20;
+  G800x600x64K      = 21;
+  G800x600x16M      = 22;
+  G1024x768x32K     = 23;
+  G1024x768x64K     = 24;
+  G1024x768x16M     = 25;
+  G1280x1024x32K    = 26;
+  G1280x1024x64K    = 27;
+  G1280x1024x16M    = 28;
+
+  G800x600x16       = 29;
+  G1024x768x16      = 30;
+  G1280x1024x16     = 31;
+
+  G720x348x2        = 32;               { Hercules emulation mode }
+
+  G320x200x16M32    = 33;       { 32-bit per pixel modes. }
+  G640x480x16M32    = 34;
+  G800x600x16M32    = 35;
+  G1024x768x16M32   = 36;
+  G1280x1024x16M32  = 37;
+
+  { additional resolutions }
+  G1152x864x16      = 38;
+  G1152x864x256     = 39;
+  G1152x864x32K     = 40;
+  G1152x864x64K     = 41;
+  G1152x864x16M     = 42;
+  G1152x864x16M32   = 43;
+
+  G1600x1200x16     = 44;
+  G1600x1200x256    = 45;
+  G1600x1200x32K    = 46;
+  G1600x1200x64K    = 47;
+  G1600x1200x16M    = 48;
+  G1600x1200x16M32  = 49;
+
+
+implementation
+
+uses
+  { for FOUR_CHAR_CODE }
+  macpas;
+
+const
+  InternalDriverName = 'Quartz';
+
+  kEventClassFPCGraph = $46504367; // 'FPCg'
+  kEventInitGraph     = $496E6974; // 'Init'
+  kEventFlush         = $466c7368; // 'Flsh'
+  kEventCloseGraph     = $446f6e65; // 'Done'
+  
+  kEventGraphInited   = $49746564 ; // Ited;
+  kEventGraphClosed   = $436c6564 ; // Cled;
+
+//  initGraphSpec  : EventTypeSpec = (eventClass: kEventClassFPCGraph; eventKind: kEventInitGraph);
+//  flushGraphSpec : EventTypeSpec = (eventClass: kEventClassFPCGraph; eventKind: kEventFlush);
+//  closeGraphSpec  : EventTypeSpec = (eventClass: kEventClassFPCGraph; eventKind: kEventCloseGraph);
+  allGraphSpec: array[0..2] of EventTypeSpec = ((eventClass: kEventClassFPCGraph; eventKind: kEventInitGraph),
+                                                (eventClass: kEventClassFPCGraph; eventKind: kEventFlush),
+                                                (eventClass: kEventClassFPCGraph; eventKind: kEventCloseGraph));
+
+  GraphInitedSpec: array[0..0] of EventTypeSpec = ((eventClass: kEventClassFPCGraph; eventKind: kEventGraphInited));
+  GraphClosedSpec: array[0..0] of EventTypeSpec = ((eventClass: kEventClassFPCGraph; eventKind: kEventGraphClosed));
+
+{$i graph.inc}
+
+  type
+    PByte = ^Byte;
+    PLongInt = ^LongInt;
+
+    PByteArray = ^TByteArray;
+    TByteArray = array [0..MAXINT - 1] of Byte;
+
+  var
+    graphdrawing: TRTLCriticalSection;
+
+{ ---------------------------------------------------------------------
+   SVGA bindings.
+
+  ---------------------------------------------------------------------}
+
+Const
+  { Text }
+
+  WRITEMODE_OVERWRITE = 0;
+  WRITEMODE_MASKED    = 1;
+  FONT_EXPANDED       = 0;
+  FONT_COMPRESSED     = 2;
+
+ { Types }
+ type
+  PGraphicsContext = ^TGraphicsContext;
+  TGraphicsContext = record
+                       ModeType: Byte;
+                       ModeFlags: Byte;
+                       Dummy: Byte;
+                       FlipPage: Byte;
+                       Width: LongInt;
+                       Height: LongInt;
+                       BytesPerPixel: LongInt;
+                       Colors: LongInt;
+                       BitsPerPixel: LongInt;
+                       ByteWidth: LongInt;
+                       VBuf: pointer;
+                       Clip: LongInt;
+                       ClipX1: LongInt;
+                       ClipY1: LongInt;
+                       ClipX2: LongInt;
+                       ClipY2: LongInt;
+                       ff: pointer;
+                     end;
+
+Const
+  GLASTMODE         = 49;
+  ModeNames : Array[0..GLastMode] of string [18] =
+   ('Text',
+    'G320x200x16',
+    'G640x200x16',
+    'G640x350x16',
+    'G640x480x16',
+    'G320x200x256',
+    'G320x240x256',
+    'G320x400x256',
+    'G360x480x256',
+    'G640x480x2',
+    'G640x480x256',
+    'G800x600x256',
+    'G1024x768x256',
+    'G1280x1024x256',
+    'G320x200x32K',
+    'G320x200x64K',
+    'G320x200x16M',
+    'G640x480x32K',
+    'G640x480x64K',
+    'G640x480x16M',
+    'G800x600x32K',
+    'G800x600x64K',
+    'G800x600x16M',
+    'G1024x768x32K',
+    'G1024x768x64K',
+    'G1024x768x16M',
+    'G1280x1024x32K',
+    'G1280x1024x64K',
+    'G1280x1024x16M',
+    'G800x600x16',
+    '1024x768x16',
+    '1280x1024x16',
+    'G720x348x2',
+    'G320x200x16M32',
+    'G640x480x16M32',
+    'G800x600x16M32',
+    'G1024x768x16M32',
+    'G1280x1024x16M32',
+    'G1152x864x16',
+    'G1152x864x256',
+    'G1152x864x32K',
+    'G1152x864x64K',
+    'G1152x864x16M',
+    'G1152x864x16M32',
+    'G1600x1200x16',
+    'G1600x1200x256',
+    'G1600x1200x32K',
+    'G1600x1200x64K',
+    'G1600x1200x16M',
+    'G1600x1200x16M32');
+
+
+{ ---------------------------------------------------------------------
+    Mac OS X - specific stuff
+  ---------------------------------------------------------------------}
+
+
+var
+  { where all the drawing occurs }
+  offscreen: CGContextRef;
+  { the drawing window's contents to which offscreen is flushed }
+  graphHIView: HIViewRef;
+  { the drawing window itself }
+  myMainWindow: WindowRef;
+  maineventqueue: EventQueueRef;
+  updatepending: boolean;
+
+  colorpalette: array[0..255,1..3] of single;
+
+
+{ create a new offscreen bitmap context in which we can draw (and from }
+{ which we can read again)                                             }
+function CreateBitmapContext (pixelsWide, pixelsHigh: SInt32) : CGContextRef;
+var
+    colorSpace        : CGColorSpaceRef;
+    bitmapData        : Pointer;
+    bitmapByteCount   : SInt32;
+    bitmapBytesPerRow : SInt32;
+begin
+  CreateBitmapContext := nil;
+
+  bitmapBytesPerRow   := (pixelsWide * 4);// always draw in 24 bit colour (+ 8 bit alpha)
+  bitmapByteCount     := (bitmapBytesPerRow * pixelsHigh);
+
+  colorSpace := CGColorSpaceCreateWithName(kCGColorSpaceGenericRGB);// 2
+  bitmapData := getmem ( bitmapByteCount );// 3
+  if (bitmapData = nil) then
+    exit;
+
+  CreateBitmapContext := CGBitmapContextCreate (bitmapData,
+                                  pixelsWide,
+                                  pixelsHigh,
+                                  8,      // bits per component
+                                  bitmapBytesPerRow,
+                                  colorSpace,
+                                  kCGImageAlphaPremultipliedLast);
+  if (CreateBitmapContext = nil) then
+    begin
+      system.freemem (bitmapData);
+      writeln (stderr, 'Could not create graphics context!');
+      exit;
+    end;
+    CGColorSpaceRelease( colorSpace );
+end;
+
+
+{ dispose the offscreen bitmap context }
+procedure DisposeBitmapContext(var bmContext: CGContextRef);
+begin
+  system.freemem(CGBitmapContextGetData(bmContext));
+  CGContextRelease(bmContext);
+  bmContext:=nil;
+end;
+
+
+{ create a HIView to add to a window, in which we can then draw }
+function CreateHIView (inWindow: WindowRef; const inBounds: Rect; var outControl: HIObjectRef): OSStatus;
+  var
+    root  : ControlRef;
+    event : EventRef;
+    contentView: HIViewRef;
+    err   : OSStatus;
+  label
+    CantCreate, CantGetRootControl, CantSetParameter, CantCreateEvent{, CantRegister};
+  begin
+    // Make an initialization event
+    err := CreateEvent( nil, kEventClassHIObject, kEventHIObjectInitialize,
+                        GetCurrentEventTime(), 0, event );
+    if (err <> noErr) then
+      goto CantCreateEvent;
+ 
+    // If bounds were specified, push the them into the initialization event
+    // so that they can be used in the initialization handler.
+    err := SetEventParameter( event, FOUR_CHAR_CODE('boun'), typeQDRectangle,
+           sizeof( Rect ), @inBounds );
+    if (err <> noErr) then
+      goto CantSetParameter;
+
+    err := HIObjectCreate( { kHIViewClassID } CFSTR('com.apple.hiview'), event, outControl );
+    assert(err = noErr);
+ 
+    // If a parent window was specified, place the new view into the
+    // parent window.
+    err := GetRootControl( inWindow, root );
+    if (err <> noErr) then
+      goto CantGetRootControl;
+    err := HIViewAddSubview( root, outControl );
+    if (err <> noErr) then
+      goto CantGetRootControl;
+
+    err := HIViewSetVisible(outControl, true);
+ 
+CantCreate:
+CantGetRootControl:
+CantSetParameter:
+CantCreateEvent:
+    ReleaseEvent( event );
+ 
+    CreateHIView := err;
+  end;
+
+
+{ Event handler which does the actual drawing by copying the offscreen to }
+{ the HIView of the drawing window                                        }
+function MyDrawEventHandler (myHandler: EventHandlerCallRef; 
+                        event: EventRef; userData: pointer): OSStatus; mwpascal;
+  var
+    myContext: CGContextRef;
+    bounds: HIRect;
+    
+  begin
+//      writeln('event');
+      MyDrawEventHandler := GetEventParameter (event, // 1
+                              kEventParamCGContextRef, 
+                              typeCGContextRef, 
+                              nil, 
+                              sizeof (CGContextRef),
+                              nil,
+                              @myContext);
+    if (MyDrawEventHandler <> noErr) then
+      exit;
+    MyDrawEventHandler := HIViewGetBounds (HIViewRef(userData), bounds);
+    if (MyDrawEventHandler <> noErr) then
+      exit;
+    EnterCriticalSection(graphdrawing);
+    CGContextDrawImage(myContext,
+                       bounds,
+                       CGBitmapContextCreateImage(offscreen));
+    updatepending:=false;
+    LeaveCriticalSection(graphdrawing);
+end;
+
+
+{ force the draw event handler to fire }
+procedure UpdateScreen;
+var
+  event : EventRef;
+begin
+  EnterCriticalSection(graphdrawing);
+  if (updatepending) then
+    begin
+      LeaveCriticalSection(graphdrawing);
+      exit;
+    end;
+
+  if (CreateEvent(nil, kEventClassFPCGraph, kEventFlush, GetCurrentEventTime(), 0, event) <> noErr) then
+    begin
+      LeaveCriticalSection(graphdrawing);
+      exit;
+    end;
+
+  if (PostEventToQueue(MainEventQueue,event,kEventPriorityLow) <> noErr) then
+    begin
+      LeaveCriticalSection(graphdrawing);
+      ReleaseEvent(event);
+      exit;
+    end;
+  updatepending:=true;
+  LeaveCriticalSection(graphdrawing);
+end;
+
+
+{ ---------------------------------------------------------------------
+    Required procedures
+  ---------------------------------------------------------------------}
+var
+  LastColor: smallint;   {Cache the last set color to improve speed}
+
+procedure q_SetColor(color: smallint);
+begin
+  if color <> LastColor then
+    begin
+//      writeln('setting color to ',color);
+      EnterCriticalSection(graphdrawing);
+      case maxcolor of
+        16:
+          begin
+            CGContextSetRGBFillColor(offscreen,colorpalette[color,1],colorpalette[color,2],colorpalette[color,3],1);
+            CGContextSetRGBStrokeColor(offscreen,colorpalette[color,1],colorpalette[color,2],colorpalette[color,3],1);
+          end;
+        256:
+          begin
+            CGContextSetRGBFillColor(offscreen,colorpalette[color,1],colorpalette[color,2],colorpalette[color,3],1);
+            CGContextSetRGBStrokeColor(offscreen,colorpalette[color,1],colorpalette[color,2],colorpalette[color,3],1);
+          end;
+        32678:
+          begin
+            CGContextSetRGBFillColor(offscreen,((color and $7ffff) shr 10) shl 3,((color shr 5) and 31) shl 3,(color and 31) shl 3,1);
+            CGContextSetRGBStrokeColor(offscreen,((color and $7ffff) shr 10) shl 3,((color shr 5) and 31) shl 3,(color and 31) shl 3,1);
+          end;
+        65536:
+          begin
+            CGContextSetRGBFillColor(offscreen,(word(color) shr 11) shl 3,((word(color) shr 5) and 63) shl 2,(color and 31) shl 3,1);
+            CGContextSetRGBStrokeColor(offscreen,(word(color) shr 11) shl 3,((word(color) shr 5) and 63) shl 2,(color and 31) shl 3,1);
+          end;
+        else
+          runerror(218);
+      end;
+      LeaveCriticalSection(graphdrawing);
+      lastcolor:=color;
+    end
+//  else
+//    writeln('color was already set: ',color);
+end;
+
+
+procedure q_savevideostate;
+begin
+end;
+
+procedure q_restorevideostate;
+begin
+end;
+
+
+function CGRectMake(x,y, width, height: single): CGRect; inline;
+begin
+  CGRectMake.origin.x:=x;
+  CGRectMake.origin.y:=y;
+  CGRectMake.size.width:=width;
+  CGRectMake.size.height:=height;
+end;
+
+
+Function ClipCoords (Var X,Y : smallint) : Boolean;
+{ Adapt to viewport, return TRUE if still in viewport,
+  false if outside viewport}
+
+begin
+  X:= X + StartXViewPort;
+  Y:= Y + StartYViewPort;
+  ClipCoords:=Not ClipPixels;
+  if ClipPixels then
+    Begin
+    ClipCoords:=(X < StartXViewPort) or (X > (StartXViewPort + ViewWidth));
+    ClipCoords:=ClipCoords or
+               ((Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)));
+    ClipCoords:=Not ClipCoords;
+    end;
+end;
+
+
+procedure q_directpixelproc(X,Y: smallint);
+
+Var Color : Word;
+
+begin
+  case CurrentWriteMode of
+    XORPut:
+      begin
+        { getpixel wants local/relative coordinates }
+        Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
+        Color := CurrentColor Xor Color;
+      end;
+    OrPut:
+      begin
+        { getpixel wants local/relative coordinates }
+        Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
+        Color := CurrentColor Or Color;
+      end;
+    AndPut:
+      begin
+        { getpixel wants local/relative coordinates }
+        Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
+        Color := CurrentColor And Color;
+      end;
+    NotPut:
+      begin
+        Color := Not CurrentColor;
+      end
+  else
+    Color:=CurrentColor;
+  end;
+  q_SetColor(Color);
+//  writeln('direct: (',x,',',y,') := ',color);
+  EnterCriticalSection(graphdrawing);
+  CGContextStrokeRect(offscreen,CGRectMake(x-0.5,y-0.5,0.5,0.5));
+  LeaveCriticalSection(graphdrawing);
+  UpdateScreen;
+end;
+
+procedure q_putpixelproc(X,Y: smallint; Color: Word);
+begin
+  if Not ClipCoords(X,Y) Then
+    exit;
+  q_setcolor(Color);
+//  writeln('regular: (',x,',',y,') := ',color);
+  EnterCriticalSection(graphdrawing);
+  CGContextStrokeRect(offscreen,CGRectMake(x-0.5,y-0.5,0.5,0.5));
+  LeaveCriticalSection(graphdrawing);
+  UpdateScreen;
+end;
+
+function q_getpixelproc (X,Y: smallint): word;
+type
+  pbyte = ^byte;
+var
+  p: pbyte;
+  rsingle, gsingle, bsingle: single;
+  count: longint;
+  red, green, blue: byte;
+begin
+ if not ClipCoords(X,Y) then
+   exit;
+ p := pbyte(CGBitmapContextGetData(offscreen));
+ y:=maxy-y-1;
+ inc(p,(y*(maxx+1)+x)*4);
+ red:=p^;
+ green:=(p+1)^;
+ blue:=(p+2)^;
+ case maxcolor of
+   16, 256:
+     begin
+       rsingle:=red/252.0;
+       gsingle:=green/252.0;
+       bsingle:=blue/252.0;
+       for count := 0 to maxcolor-1 do
+         if (abs(colorpalette[count,1]-rsingle) < 1/64.0) and
+            (abs(colorpalette[count,2]-gsingle) < 1/64.0) and
+            (abs(colorpalette[count,3]-bsingle) < 1/64.0) then
+           begin
+             q_getpixelproc:=count;
+             exit;
+           end;
+       q_getpixelproc:=0;
+     end;
+   32678:
+     q_getpixelproc:=(red shl 7) or (green shl 2) or (blue shr 3);
+   65536:
+     q_getpixelproc:=(red shl 8) or (green shl 3) or (blue shr 3);
+ end;
+end;
+
+procedure q_clrviewproc;
+
+begin
+  q_SetColor(CurrentBkColor);
+  EnterCriticalSection(graphdrawing);
+  CGContextFillRect(offscreen,CGRectMake(StartXViewPort,StartYViewPort,ViewWidth,ViewHeight));
+  LeaveCriticalSection(graphdrawing);
+  UpdateScreen;
+  { reset coordinates }
+  CurrentX := 0;
+  CurrentY := 0;
+end;
+
+procedure q_putimageproc (X,Y: smallint; var Bitmap; BitBlt: Word);
+begin
+{
+  With TBitMap(BitMap) do
+    gl_putbox(x, y, width, height, @Data);
+}
+end;
+
+procedure q_getimageproc (X1,Y1,X2,Y2: smallint; Var Bitmap);
+begin
+{  with TBitmap(Bitmap) do
+    begin
+    Width := x2 - x1 + 1;
+    Height := y2 - y1 + 1;
+    gl_getbox(x1,y1, x2 - x1 + 1, y2 - y1 + 1, @Data);
+    end;
+}
+end;
+
+{
+function  q_imagesizeproc (X1,Y1,X2,Y2: smallint): longint;
+begin
+ q_imagesizeproc := SizeOf(TBitmap) + (x2 - x1 + 1) * (y2 - y1 + 1) * PhysicalScreen^.BytesPerPixel;
+
+end;
+}
+
+procedure q_lineproc_intern (X1, Y1, X2, Y2 : smallint);
+begin
+  if (CurrentWriteMode in [OrPut,AndPut,XorPut]) then
+    begin
+      LineDefault(X1,Y1,X2,Y2);
+      exit
+    end
+  else
+    begin
+      { Convert to global coordinates. }
+      x1 := x1 + StartXViewPort;
+      x2 := x2 + StartXViewPort;
+      y1 := y1 + StartYViewPort;
+      y2 := y2 + StartYViewPort;
+      if ClipPixels then
+        if LineClipped(x1,y2,x2,y2,StartXViewPort,StartYViewPort,
+                       StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+           exit;
+      if (CurrentWriteMode = NotPut) then
+        q_SetColor(not(currentcolor))
+      else
+        q_SetColor(currentcolor);
+    end;
+  EnterCriticalSection(graphdrawing);
+  CGContextBeginPath(offscreen);
+  CGContextMoveToPoint(offscreen,x1,y1);
+  CGContextAddLineToPoint(offscreen,x2,y2);
+  CGContextClosePath(offscreen);
+  CGContextStrokePath(offscreen);
+  LeaveCriticalSection(graphdrawing);
+  UpdateScreen;
+end;
+
+
+procedure q_lineproc (X1, Y1, X2, Y2 : smallint);
+begin
+  if (CurrentWriteMode in [OrPut,AndPut,XorPut]) or
+     (lineinfo.LineStyle <> SolidLn) or
+     (lineinfo.Thickness<>NormWidth) then
+    begin
+      LineDefault(X1,Y1,X2,Y2);
+      exit
+    end
+  else
+    begin
+      { Convert to global coordinates. }
+      x1 := x1 + StartXViewPort;
+      x2 := x2 + StartXViewPort;
+      y1 := y1 + StartYViewPort;
+      y2 := y2 + StartYViewPort;
+      if ClipPixels then
+        if LineClipped(x1,y2,x2,y2,StartXViewPort,StartYViewPort,
+                       StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
+           exit;
+      if (CurrentWriteMode = NotPut) then
+        q_SetColor(not(currentcolor))
+      else
+        q_SetColor(currentcolor);
+    end;
+  EnterCriticalSection(graphdrawing);
+  CGContextBeginPath(offscreen);
+  CGContextMoveToPoint(offscreen,x1,y1);
+  CGContextAddLineToPoint(offscreen,x2,y2);
+  CGContextClosePath(offscreen);
+  CGContextStrokePath(offscreen);
+  LeaveCriticalSection(graphdrawing);
+  UpdateScreen;
+end;
+
+
+procedure q_hlineproc (x, x2,y : smallint);
+begin
+  if (CurrentWriteMode in [OrPut,AndPut,XorPut]) then
+    HLineDefault(X,X2,Y)
+  else
+    q_lineproc_intern(x,y,x2,y);
+end;
+
+procedure q_vlineproc (x,y,y2: smallint);
+begin
+  if (CurrentWriteMode in [OrPut,AndPut,XorPut]) then
+    VLineDefault(x,y,y2)
+  else
+    q_lineproc_intern(x,y,x,y2);
+end;
+
+procedure q_patternlineproc (x1,x2,y: smallint);
+begin
+end;
+
+procedure q_ellipseproc  (X,Y: smallint;XRadius: word;
+  YRadius:word; stAngle,EndAngle: word; fp: PatternLineProc);
+begin
+end;
+
+procedure q_getscanlineproc (X1,X2,Y : smallint; var data);
+begin
+end;
+
+procedure q_setactivepageproc (page: word);
+begin
+end;
+
+procedure q_setvisualpageproc (page: word);
+begin
+end;
+
+
+procedure q_savestateproc;
+begin
+end;
+
+procedure q_restorestateproc;
+begin
+end;
+
+procedure q_setrgbpaletteproc(ColorNum, RedValue, GreenValue, BlueValue: smallint);
+begin
+  { vga is only 6 bits per channel, palette values go from 0 to 252 }
+  { the anti-aliasing darkens most stuff though, so pump up brightness a bit }
+  colorpalette[ColorNum,1]:=RedValue * (1.0/249.0);
+  colorpalette[ColorNum,2]:=GreenValue * (1.0/249.0);
+  colorpalette[ColorNum,3]:=BlueValue * (1.0/249.0);
+end;
+
+procedure q_getrgbpaletteproc (ColorNum: smallint; var RedValue, GreenValue, BlueValue: smallint);
+begin
+  RedValue:=trunc(colorpalette[ColorNum,1]*249.0);
+  GreenValue:=trunc(colorpalette[ColorNum,2]*249.0);
+  BlueValue:=trunc(colorpalette[ColorNum,3]*249.0);
+end;
+
+
+procedure InitColors(nrColors: longint);
+
+var
+  i: smallint;
+begin
+  for i:=0 to nrColors-1 do
+    q_setrgbpaletteproc(I,DefaultColors[i].red,
+      DefaultColors[i].green,DefaultColors[i].blue)
+end;
+
+procedure q_initmodeproc;
+const
+  myHIViewSpec  : EventTypeSpec = (eventClass: kEventClassControl; eventKind: kEventControlDraw);
+var
+ windowAttrs:   WindowAttributes;
+ contentRect:   Rect; 
+ titleKey:      CFStringRef;
+ windowTitle:   CFStringRef; 
+ err:           OSStatus;
+ hiviewbounds : HIRect;
+ b: boolean;
+begin
+  windowAttrs := kWindowStandardDocumentAttributes // 1
+                        or kWindowStandardHandlerAttribute 
+                        or kWindowInWindowMenuAttribute
+                        or kWindowCompositingAttribute
+                        or kWindowLiveResizeAttribute
+                        or kWindowInWindowMenuAttribute
+                        or kWindowNoUpdatesAttribute; 
+
+  SetRect (contentRect, 0,  0,
+                         MaxX, MaxY);
+  
+  CreateNewWindow (kDocumentWindowClass, windowAttrs,// 3
+                         contentRect, myMainWindow);
+  
+  SetRect (contentRect, 0,  50,
+                         MaxX, 50+MaxY);
+  
+  SetWindowBounds(myMainWindow,kWindowContentRgn,contentrect);
+  titleKey    := CFSTR('Graph Window'); // 4
+  windowTitle := CFCopyLocalizedString(titleKey, nil); // 5
+  err := SetWindowTitleWithCFString (myMainWindow, windowTitle); // 6
+  CFRelease (titleKey); // 7
+  CFRelease (windowTitle);
+
+  with contentRect do
+    begin
+      top:=0;
+      left:=0;
+      bottom:=MaxY;
+      right:=MaxX;
+    end;
+    
+  offscreen:=CreateBitmapContext(MaxX+1,MaxY+1);
+  if (offscreen = nil) then
+    begin
+      _GraphResult:=grNoLoadMem;
+      exit;
+    end;
+//  CGContextSetShouldAntialias(offscreen,0);
+
+  if (CreateHIView(myMainWindow,contentRect,graphHIView) <> noErr) then
+    begin
+      DisposeBitmapContext(offscreen);
+      _GraphResult:=grError;
+      exit;
+    end;
+
+
+//   HIViewFindByID( HIViewGetRoot( myMainWindow ), kHIViewWindowContentID, graphHIView );
+
+  if InstallEventHandler (GetControlEventTarget (graphHIView),
+                          NewEventHandlerUPP (@MyDrawEventHandler), 
+                          { GetEventTypeCount (myHIViewSpec)} 1,
+                          @myHIViewSpec, 
+                          pointer(graphHIView),
+                          Nil) <> noErr then
+    begin
+      DisposeWindow(myMainWindow);
+      DisposeBitmapContext(offscreen);
+      _GraphResult:=grError;
+      exit;
+    end;
+
+  LastColor:=-1;
+  if (maxcolor=16) or (maxcolor=256) then
+    InitColors(maxcolor);
+
+  CGContextSetLineWidth(offscreen,1.0);
+  
+  ShowWindow (myMainWindow);  
+
+
+    write('view is active: ',HIViewIsActive(graphHIView,@b));
+    writeln(', latent: ',b);
+    writeln('compositing enabled: ',HIViewIsCompositingEnabled(graphHIView));
+    writeln('visible before: ',HIViewIsVisible(graphHIView));
+    write('drawing enabled: ',HIViewIsDrawingEnabled(graphHIView));
+    writeln(', latent: ',b);
+    write('view is enabled: ',HIViewIsEnabled(graphHIView,@b));
+    writeln(', latent: ',b);
+
+    err := HIViewGetBounds(graphHIView,hiviewbounds);
+    writeln('err, ',err,' (',hiviewbounds.origin.x:0:2,',',hiviewbounds.origin.y:0:2,'),(',hiviewbounds.size.width:0:2,',',hiviewbounds.size.height:0:2,')');
+
+end;
+
+
+{************************************************************************}
+{*                       General routines                               *}
+{************************************************************************}
+
+procedure q_donegraph;
+begin
+  If not isgraphmode then
+    begin
+      _graphresult := grnoinitgraph;
+      exit
+    end;
+  RestoreVideoState;
+  DisposeWindow(myMainWindow);
+  DisposeBitmapContext(offscreen);
+  isgraphmode := false;
+end;
+
+
+procedure CloseGraph;
+var
+  event : EventRef;
+  myQueue: EventQueueRef;
+begin
+  if (CreateEvent(nil, kEventClassFPCGraph, kEventCloseGraph, GetCurrentEventTime(), 0, event) <> noErr) then
+    begin
+      _GraphResult:=grError;
+      exit;
+    end;
+
+  myQueue := GetCurrentEventQueue;
+  if (SetEventParameter(event, FOUR_CHAR_CODE('Src '), typeVoidPtr, sizeof(EventQueueRef), @myQueue) <> noErr) then
+    begin
+      ReleaseEvent(event);
+      _GraphResult:=grError;
+    end;
+
+  if (PostEventToQueue(MainEventQueue,event,kEventPriorityStandard) <> noErr) then
+    begin
+      ReleaseEvent(event);
+      _GraphResult:=grError;
+      exit;
+    end;
+    
+  if (ReceiveNextEvent(length(GraphClosedSpec),@GraphClosedSpec,kEventDurationForever,true,event) <> noErr) then
+    runerror(218);
+  ReleaseEvent(event);
+end;
+
+
+procedure SendInitGraph;
+var
+  event : EventRef;
+  myQueue: EventQueueRef;
+begin
+  if (CreateEvent(nil, kEventClassFPCGraph, kEventInitGraph, GetCurrentEventTime(), 0, event) <> noErr) then
+    begin
+      _GraphResult:=grError;
+      exit;
+    end;
+
+  myQueue := GetCurrentEventQueue;
+  if (SetEventParameter(event, FOUR_CHAR_CODE('Src '), typeVoidPtr, sizeof(EventQueueRef), @myQueue) <> noErr) then
+    begin
+      ReleaseEvent(event);
+      _GraphResult:=grError;
+      exit;
+    end;
+
+  if (PostEventToQueue(MainEventQueue,event,kEventPriorityStandard) <> noErr) then
+    begin
+      ReleaseEvent(event);
+      _GraphResult:=grError;
+      exit;
+    end;
+
+  if (ReceiveNextEvent(length(GraphInitedSpec),@GraphInitedSpec,kEventDurationForever,true,event) <> noErr) then
+    runerror(218);
+  ReleaseEvent(event);
+end;
+
+
+  function QueryAdapterInfo:PModeInfo;
+  { This routine returns the head pointer to the list }
+  { of supported graphics modes.                      }
+  { Returns nil if no graphics mode supported.        }
+  { This list is READ ONLY!                           }
+   var
+    mode: TModeInfo;
+    i : longint;
+
+   begin
+     QueryAdapterInfo := ModeList;
+     { If the mode listing already exists... }
+     { simply return it, without changing    }
+     { anything...                           }
+     if assigned(ModeList) then
+       exit;
+     SaveVideoState:=@q_savevideostate;
+     RestoreVideoState:=@q_restorevideostate;
+//     For I:=0 to GLastMode do
+     i := 10;
+       begin
+         begin
+         InitMode(Mode);
+         With Mode do
+           begin
+           ModeNumber:=I;
+           ModeName:=ModeNames[i];
+           // Pretend we are VGA always.
+           DriverNumber := VGA;
+           // MaxX is number of pixels in X direction - 1
+           MaxX:=640-1;
+           // same for MaxY
+           MaxY:=480-1;
+           MaxColor := 256;
+           PaletteSize := MaxColor;
+           HardwarePages := 0;
+           // necessary hooks ...
+           DirectPutPixel := @q_DirectPixelProc;
+           GetPixel       := @q_GetPixelProc;
+           PutPixel       := @q_PutPixelProc;
+           { May be implemented later: }
+           HLine          := @q_HLineProc;
+           VLine          := @q_VLineProc;
+{           GetScanLine    := @q_GetScanLineProc;}
+           ClearViewPort  := @q_ClrViewProc;
+           SetRGBPalette  := @q_SetRGBPaletteProc;
+           GetRGBPalette  := @q_GetRGBPaletteProc;
+           { These are not really implemented yet:
+           PutImage       := @q_PutImageProc;
+           GetImage       := @q_GetImageProc;}
+{          If you use the default getimage/putimage, you also need the default
+           imagesize! (JM)
+            ImageSize      := @q_ImageSizeProc; }
+           { Add later maybe ?
+           SetVisualPage  := SetVisualPageProc;
+           SetActivePage  := SetActivePageProc; }
+           Line           := @q_LineProc;
+{
+           InternalEllipse:= @q_EllipseProc;
+           PatternLine    := @q_PatternLineProc;
+           }
+           InitMode       := @SendInitGraph;
+           end;
+         AddMode(Mode);
+         end;
+       end;
+   end;
+
+
+{ ************************************************* }
+
+function GraphEventHandler (myHandler: EventHandlerCallRef; 
+                        event: EventRef; userData: pointer): OSStatus; mwpascal;
+var
+  source: EventQueueRef;
+  newEvent: EventRef;
+begin
+//  writeln('in GraphEventHandler, event: ',FourCharArray(GetEventKind(event)));
+  newEvent := nil;
+  if (GetEventKind(event) = kEventInitGraph) then
+    begin
+      q_initmodeproc;
+      if (GetEventParameter(event,FOUR_CHAR_CODE('Src '), typeVoidPtr, nil, sizeof(EventQueueRef), nil, @source) <> noErr) then
+        runerror(218);
+      if (CreateEvent(nil, kEventClassFPCGraph, kEventGraphInited, GetCurrentEventTime(), 0, newEvent) <> noErr) then
+        runerror(218);
+    end
+  else if (GetEventKind(event) = kEventCloseGraph) then
+    begin
+      q_donegraph;
+      if (GetEventParameter(event,FOUR_CHAR_CODE('Src '), typeVoidPtr, nil, sizeof(EventQueueRef), nil, @source) <> noErr) then
+        runerror(218);
+      if (CreateEvent(nil, kEventClassFPCGraph, kEventGraphClosed, GetCurrentEventTime(), 0, newEvent) <> noErr) then
+        runerror(218);
+    end
+  else if (GetEventKind(event) = kEventFlush) then
+    begin
+      HIViewSetNeedsDisplay(graphHIView, true);
+    end;
+  if assigned(newEvent) then
+    if PostEventToQueue(source,newEvent,kEventPriorityStandard) <> noErr then
+      runerror(218);
+  result := noErr;
+  ReleaseEvent(event);
+end;
+
+
+   var
+     proctorun: TGraphProgram;
+     
+   function wrapper(p: pointer): longint;
+     begin
+       halt(proctorun(nil));
+     end;
+
+
+   procedure StartGraphProgram(p: TGraphProgram);
+     var
+       taskid: mptaskid;
+       eventRec: eventrecord;
+     begin
+      if InstallEventHandler (GetApplicationEventTarget,
+                              NewEventHandlerUPP (@GraphEventHandler), 
+                              length(allGraphSpec),
+                              @allGraphSpec, 
+                              nil,
+                              nil) <> noErr then
+        begin
+          _GraphResult:=grError;
+          exit;
+        end;
+    
+       proctorun:=p;
+       
+       { main program has to be the first one to access the event queue, see }
+       { http://lists.apple.com/archives/carbon-dev/2007/Jun/msg00612.html   }
+       eventavail(0,eventRec);
+       maineventqueue:=GetMainEventQueue;
+       BeginThread(@wrapper);
+       RunApplicationEventLoop;
+     end;
+
+initialization
+  initcriticalsection(graphdrawing);
+  InitializeGraph;
+finalization
+  donecriticalsection(graphdrawing);
+end.