freepascal.compiler/packages/extra/graph/macosx/graph.pp

{
    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;

{$linkframework Carbon}

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'
  kEventQuit          = $51756974; // 'Quit'
  
  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..3] of EventTypeSpec = ((eventClass: kEventClassFPCGraph; eventKind: kEventInitGraph),
                                                (eventClass: kEventClassFPCGraph; eventKind: kEventFlush),
                                                (eventClass: kEventClassFPCGraph; eventKind: kEventCloseGraph),
                                                (eventClass: kEventClassFPCGraph; eventKind: kEventQuit));

  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 := CGColorSpaceCreateDeviceRGB;// 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 );
    { disable anti-aliasing }
    CGContextTranslateCTM(CreateBitmapContext,0.5,0.5);
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;
    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;
    img: CGImageRef;
  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);
    img:=CGBitmapContextCreateImage(offscreen);
    CGContextDrawImage(myContext,
                       bounds,
                       img);
    updatepending:=false;
    LeaveCriticalSection(graphdrawing);
    CGImageRelease(img);
end;


{ force the draw event handler to fire }
procedure UpdateScreen;
var
  event : EventRef;
begin
  if (updatepending) then
    exit;

  if (CreateEvent(nil, kEventClassFPCGraph, kEventFlush, GetCurrentEventTime(), 0, event) <> noErr) then
    exit;

  if (PostEventToQueue(MainEventQueue,event,kEventPriorityLow) <> noErr) then
    begin
      ReleaseEvent(event);
      exit;
    end;
  updatepending:=true;
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)/31.0,((color shr 5) and 31)/31.0,(color and 31)/31.0,1);
            CGContextSetRGBStrokeColor(offscreen,((color and $7ffff) shr 10)/31.0,((color shr 5) and 31)/31.0,(color and 31)/31.0,1);
          end;
        65536:
          begin
            CGContextSetRGBFillColor(offscreen,(word(color) shr 11)/31.0,((word(color) shr 5) and 63)/63.0,(color and 31)/31.0,1);
            CGContextSetRGBStrokeColor(offscreen,(word(color) shr 11)/31.0,((word(color) shr 5) and 63)/63.0,(color and 31)/31.0,1);
          end;
        else
          runerror(218);
      end;
      LeaveCriticalSection(graphdrawing);
      lastcolor:=color;
    end
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);
  EnterCriticalSection(graphdrawing);
  CGContextBeginPath(offscreen);
  CGContextMoveToPoint(offscreen,x,y);
  CGContextAddLineToPoint(offscreen,x,y);
  CGContextClosePath(offscreen);
  CGContextStrokePath(offscreen);
  UpdateScreen;
  LeaveCriticalSection(graphdrawing);
end;

procedure q_putpixelproc(X,Y: smallint; Color: Word);
begin
  if Not ClipCoords(X,Y) Then
    exit;
  q_setcolor(Color);
  EnterCriticalSection(graphdrawing);
  CGContextBeginPath(offscreen);
  CGContextMoveToPoint(offscreen,x,y);
  CGContextAddLineToPoint(offscreen,x,y);
  CGContextClosePath(offscreen);
  CGContextStrokePath(offscreen);
  UpdateScreen;
  LeaveCriticalSection(graphdrawing);
end;

function q_getpixelproc (X,Y: smallint): word;
type
  pbyte = ^byte;
var
  p: pbyte;
  rsingle, gsingle, bsingle, dist, closest: single;
  count: longint;
  red, green, blue: byte;
begin
 if not ClipCoords(X,Y) then
   exit;
 p := pbyte(CGBitmapContextGetData(offscreen));
 y:=maxy-y;
 inc(p,(y*(maxx+1)+x)*4);
 red:=p^;
 green:=(p+1)^;
 blue:=(p+2)^;
 case maxcolor of
   16, 256:
     begin
       { find closest color using least squares }
       rsingle:=red/255.0;
       gsingle:=green/255.0;
       bsingle:=blue/255.0;
       closest:=255.0;
       q_getpixelproc:=0;
       for count := 0 to maxcolor-1 do
         begin
           dist:=sqr(colorpalette[count,1]-rsingle) +
                sqr(colorpalette[count,2]-gsingle) +
                sqr(colorpalette[count,3]-bsingle);
           if (dist < closest) then
             begin
               closest:=dist;
               q_getpixelproc:=count;
             end;
         end;
       exit;
     end;
   32678:
     q_getpixelproc:=((red div 8) shl 7) or ((green div 8) shl 2) or (blue div 8);
   65536:
     q_getpixelproc:=((red div 8) shl 8) or ((green div 4) shl 3) or (blue div 8);
 end;
end;

procedure q_clrviewproc;

begin
  q_SetColor(CurrentBkColor);
  EnterCriticalSection(graphdrawing);
  CGContextFillRect(offscreen,CGRectMake(StartXViewPort,StartYViewPort,ViewWidth+1,ViewHeight+1));
  UpdateScreen;
  LeaveCriticalSection(graphdrawing);
  { 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,y1,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);
  UpdateScreen;
  LeaveCriticalSection(graphdrawing);
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,y1,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);
  UpdateScreen;
  LeaveCriticalSection(graphdrawing);
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 }
  colorpalette[ColorNum,1]:=RedValue * (1.0/252.0);
  colorpalette[ColorNum,2]:=GreenValue * (1.0/252.0);
  colorpalette[ColorNum,3]:=BlueValue * (1.0/252.0);
end;

procedure q_getrgbpaletteproc (ColorNum: smallint; var RedValue, GreenValue, BlueValue: smallint);
begin
  RedValue:=trunc(colorpalette[ColorNum,1]*252.0);
  GreenValue:=trunc(colorpalette[ColorNum,2]*252.0);
  BlueValue:=trunc(colorpalette[ColorNum,3]*252.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+1, MaxY+1);
  
  CreateNewWindow (kDocumentWindowClass, windowAttrs,// 3
                         contentRect, myMainWindow);
  
  SetRect (contentRect, 0,  50,
                         MaxX+1, 51+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+1;
      right:=MaxX+1;
    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);

  { start with a black background }
  CGContextSetRGBStrokeColor(offscreen,0.0,0.0,0.0,1);
  CGContextFillRect(offscreen,CGRectMake(0,0,MaxX+1,MaxY+1));
  HIViewSetNeedsDisplay(graphHIView, true);

  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;
           YAspect:=10000;
           if ((MaxX+1)*35=(MaxY+1)*64) then
             XAspect:=7750
           else if ((MaxX+1)*20=(MaxY+1)*64) then
             XAspect:=4500
           else if ((MaxX+1)*40=(MaxY+1)*64) then
             XAspect:=8333
           else { assume 4:3 }
             XAspect:=10000;
           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;
  case GetEventKind(event) of
    kEventInitGraph:
      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;
    kEventCloseGraph:
      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;
    kEventFlush:
      begin
        HIViewSetNeedsDisplay(graphHIView, true);
      end;
    kEventQuit:
      begin
        QuitApplicationEventLoop;
      end;
  end;
  if assigned(newEvent) then
    if PostEventToQueue(source,newEvent,kEventPriorityStandard) <> noErr then
      runerror(218);
  GraphEventHandler := noErr;
  ReleaseEvent(event);
end;


var
  proctorun: TGraphProgram;
   
function wrapper(p: pointer): longint;
(*
  var
    event : EventRef;
*)
  begin 
    wrapper:=proctorun(nil);
    halt(wrapper);
(*
    if (CreateEvent(nil, kEventClassFPCGraph, kEventQuit, GetCurrentEventTime(), 0, event) <> noErr) then
      exit;

    if (PostEventToQueue(MainEventQueue,event,kEventPriorityLow) <> noErr) then
      begin
        ReleaseEvent(event);
        halt(wrapper);
      end;
*)
  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.