{$IFDEF ENABLE_X11_EXTENSION_XF86DGA1} Constructor TX11DGA1Display.Create(ADisplay : PDisplay; AScreen : Integer; Const AFlags : TX11Flags); Var dummy1, dummy2 : Integer; Begin Inherited; LOG('trying to create a DGA 1.0 display'); FInDirect := False; FInMode := False; FModeInfo := Nil; { Check if we are root } If fpgeteuid <> 0 Then Raise TPTCError.Create('Have to be root to switch to DGA mode'); { Check if the DGA extension and VidMode extension can be used } If Not XF86DGAQueryExtension(FDisplay, @dummy1, @dummy2) Then Raise TPTCError.Create('DGA extension not available'); If Not XF86VidModeQueryExtension(FDisplay, @dummy1, @dummy2) Then Raise TPTCError.Create('VidMode extension not available'); End; Destructor TX11DGA1Display.Destroy; Begin Close; Inherited Destroy; End; Procedure TX11DGA1Display.Open(ATitle : String; AWidth, AHeight : Integer; Const AFormat : TPTCFormat); Var vml : PXF86VidModeModeLine; dotclock : Integer; i : Integer; root : TWindow; e : TXEvent; found : Boolean; tmpArea : TPTCArea; r, g, b : Single; found_mode : Integer; min_diff : Integer; d_x, d_y : Integer; Begin FWidth := AWidth; FHeight := AHeight; { Get all availabe video modes } XF86VidModeGetAllModeLines(FDisplay, FScreen, @FModeInfoNum, @FModeInfo); FPreviousMode := -1; { Save previous mode } New(vml); Try XF86VidModeGetModeLine(FDisplay, FScreen, @dotclock, vml); Try For i := 0 To FModeInfoNum - 1 Do Begin If (vml^.hdisplay = FModeInfo[i]^.hdisplay) And (vml^.vdisplay = FModeInfo[i]^.vdisplay) Then Begin FPreviousMode := i; Break; End; End; Finally If vml^.privsize <> 0 Then XFree(vml^.c_private); End; Finally Dispose(vml); End; If FPreviousMode = -1 Then Raise TPTCError.Create('Current mode not found in modelist?! Err, this shouldn''t happen :)'); { Find a video mode to set } { Normal modesetting first, find exactly matching mode } found_mode := -1; For i := 0 To FModeInfoNum - 1 Do If (FModeInfo[i]^.hdisplay = AWidth) And (FModeInfo[i]^.vdisplay = AHeight) Then Begin found_mode := i; Break; End; { Try to find a mode that matches the width first } If found_mode = -1 Then For i := 0 To FModeInfoNum - 1 Do If (FModeInfo[i]^.hdisplay = AWidth) And (FModeInfo[i]^.vdisplay >= AHeight) Then Begin found_mode := i; Break; End; { Next try to match the height } If found_mode = -1 Then For i := 0 To FModeInfoNum - 1 Do If (FModeInfo[i]^.hdisplay >= AWidth) And (FModeInfo[i]^.vdisplay = AHeight) Then Begin found_mode := i; Break; End; If found_mode = -1 Then Begin { Finally, find the mode that is bigger than the requested one and makes } { the least difference } min_diff := 987654321; For i := 0 To FModeInfoNum - 1 Do If (FModeInfo[i]^.hdisplay >= AWidth) And (FModeInfo[i]^.vdisplay >= AHeight) Then Begin d_x := Sqr(FModeInfo[i]^.hdisplay - AWidth); d_y := Sqr(FModeInfo[i]^.vdisplay - AHeight); If (d_x + d_y) < min_diff Then Begin min_diff := d_x + d_y; found_mode := i; End; End; End; If found_mode = -1 Then Raise TPTCError.Create('Cannot find a video mode to use'); If Not XF86VidModeSwitchToMode(FDisplay, FScreen, FModeInfo[found_mode]) Then Raise TPTCError.Create('Error switching to requested video mode'); FDestX := (FModeInfo[found_mode]^.hdisplay Div 2) - (AWidth Div 2); FDestY := (FModeInfo[found_mode]^.vdisplay Div 2) - (AHeight Div 2); XFlush(FDisplay); FInMode := True; { Check if the requested colour mode is available } FFormat := GetX11Format(AFormat); { Grab exclusive control over the keyboard and mouse } root := XRootWindow(FDisplay, FScreen); XGrabKeyboard(FDisplay, root, True, GrabModeAsync, GrabModeAsync, CurrentTime); XGrabPointer(FDisplay, root, True, PointerMotionMask Or ButtonPressMask Or ButtonReleaseMask, GrabModeAsync, GrabModeAsync, None, None, CurrentTime); XFlush(FDisplay); { Get Display information } XF86DGAGetVideo(FDisplay, FScreen, @FDGAAddr, @FDGALineWidth, @FDGABankSize, @FDGAMemSize); { Don't have to be root anymore } { fpsetuid(fpgetuid);...} XF86DGAGetViewPortSize(FDisplay, FScreen, @FDGAWidth, @FDGAHeight); If XF86DGAForkApp(FScreen) <> 0 Then Raise TPTCError.Create('cannot do safety fork'); If XF86DGADirectVideo(FDisplay, FScreen, XF86DGADirectGraphics Or XF86DGADirectKeyb Or XF86DGADirectMouse) = 0 Then Raise TPTCError.Create('cannot switch to DGA mode'); FInDirect := True; FillChar(FDGAAddr^, FDGALineWidth * FDGAHeight * (FFormat.Bits Div 8), 0); XSelectInput(FDisplay, DefaultRootWindow(FDisplay), KeyPressMask Or KeyReleaseMask); XF86DGASetViewPort(FDisplay, FScreen, 0, 0); { Important.. sort of =) } found := False; Repeat { Stupid loop. The key } { events were causing } { problems.. } found := XCheckMaskEvent(FDisplay, KeyPressMask Or KeyReleaseMask, @e); Until Not found; { Create colour map in 8 bit mode } If FFormat.Bits = 8 Then Begin FColours := GetMem(256 * SizeOf(TXColor)); If FColours = Nil Then Raise TPTCError.Create('Cannot allocate colour map cells'); FCMap := XCreateColormap(FDisplay, RootWindow(FDisplay, FScreen), DefaultVisual(FDisplay, FScreen), AllocAll); If FCMap = 0 Then Raise TPTCError.Create('Cannot create colour map'); End Else FCMap := 0; { Set 332 palette, for now } If (FFormat.Bits = 8) And FFormat.Direct Then Begin {Taken from PTC 0.72, i hope it's fine} For i := 0 To 255 Do Begin r := ((i And $E0) Shr 5) * 255 / 7; g := ((i And $1C) Shr 2) * 255 / 7; b := (i And $03) * 255 / 3; FColours[i].pixel := i; FColours[i].red := Round(r) Shl 8; FColours[i].green := Round(g) Shl 8; FColours[i].blue := Round(b) Shl 8; Byte(FColours[i].flags) := DoRed Or DoGreen Or DoBlue; End; XStoreColors(FDisplay, FCMap, FColours, 256); XF86DGAInstallColormap(FDisplay, FScreen, FCMap); End; { Set clipping area } tmpArea := TPTCArea.Create(0, 0, FWidth, FHeight); Try FClip.Assign(tmpArea); Finally tmpArea.Free; End; End; { Not in DGA mode } Procedure TX11DGA1Display.Open(AWindow : TWindow; Const AFormat : TPTCFormat); Begin If AWindow = 0 Then; { Prevent warnings } If AFormat = Nil Then; End; Procedure TX11DGA1Display.Open(AWindow : TWindow; Const AFormat : TPTCFormat; AX, AY, AWidth, AHeight : Integer); Begin If (AWindow = 0) Or (AFormat = Nil) Or (AX = 0) Or (AY = 0) Or (AWidth = 0) Or (AHeight = 0) Then; End; Procedure TX11DGA1Display.Close; Begin If FInDirect Then Begin FInDirect := False; XF86DGADirectVideo(FDisplay, FScreen, 0); End; If FInMode Then Begin FInMode := False; XF86VidModeSwitchToMode(FDisplay, FScreen, FModeInfo[FPreviousMode]); XUngrabKeyboard(FDisplay, CurrentTime); XUngrabPointer(FDisplay, CurrentTime); End; If FDisplay <> Nil Then XFlush(FDisplay); If FCMap <> 0 Then Begin XFreeColormap(FDisplay, FCMap); FCMap := 0; End; FreeMemAndNil(FColours); If FModeInfo <> Nil Then Begin XFree(FModeInfo); FModeInfo := Nil; End; End; Procedure TX11DGA1Display.GetModes(Var AModes : TPTCModeDynArray); Begin SetLength(AModes, 1); AModes[0] := TPTCMode.Create; {todo...} End; Procedure TX11DGA1Display.Update; Begin End; Procedure TX11DGA1Display.Update(Const AArea : TPTCArea); Begin End; Procedure TX11DGA1Display.HandleEvents; Var e : TXEvent; NewFocus : Boolean; NewFocusSpecified : Boolean; Function UsefulEventsPending : Boolean; Var tmpEvent : TXEvent; Begin If XCheckTypedEvent(FDisplay, ClientMessage, @tmpEvent) Then Begin Result := True; XPutBackEvent(FDisplay, @tmpEvent); Exit; End; If XCheckMaskEvent(FDisplay, FocusChangeMask Or KeyPressMask Or KeyReleaseMask Or ButtonPressMask Or ButtonReleaseMask Or PointerMotionMask Or ExposureMask, @tmpEvent) Then Begin Result := True; XPutBackEvent(FDisplay, @tmpEvent); Exit; End; Result := False; End; Procedure HandleKeyEvent; Var sym : TKeySym; sym_modded : TKeySym; { modifiers like shift are taken into account here } press : Boolean; alt, shift, ctrl : Boolean; uni : Integer; key : TPTCKeyEvent; buf : Array[1..16] Of Char; Begin sym := XLookupKeySym(@e.xkey, 0); XLookupString(@e.xkey, @buf, SizeOf(buf), @sym_modded, Nil); uni := X11ConvertKeySymToUnicode(sym_modded); alt := (e.xkey.state And Mod1Mask) <> 0; shift := (e.xkey.state And ShiftMask) <> 0; ctrl := (e.xkey.state And ControlMask) <> 0; If e._type = KeyPress Then press := True Else press := False; key := Nil; Case sym Shr 8 Of 0 : key := TPTCKeyEvent.Create(FNormalKeys[sym And $FF], uni, alt, shift, ctrl, press); $FF : key := TPTCKeyEvent.Create(FFunctionKeys[sym And $FF], uni, alt, shift, ctrl, press); Else key := TPTCKeyEvent.Create; End; FEventQueue.AddEvent(key); End; Begin NewFocusSpecified := False; While UsefulEventsPending Do Begin XNextEvent(FDisplay, @e); Case e._type Of FocusIn : Begin NewFocus := True; NewFocusSpecified := True; End; FocusOut : Begin NewFocus := False; NewFocusSpecified := True; End; ClientMessage : Begin { If (e.xclient.format = 32) And (TAtom(e.xclient.data.l[0]) = m_atom_close) Then Halt(0);} End; Expose : Begin {...} End; KeyPress, KeyRelease : HandleKeyEvent; ButtonPress, ButtonRelease : Begin {...} End; MotionNotify : Begin {...} End; End; End; // HandleChangeFocus(NewFocus); End; Function TX11DGA1Display.NextEvent(Var AEvent : TPTCEvent; AWait : Boolean; Const AEventMask : TPTCEventMask) : Boolean; Var tmpEvent : TXEvent; Begin FreeAndNil(AEvent); Repeat { process all events from the X queue and put them on our FEventQueue } HandleEvents; { try to find an event that matches the EventMask } AEvent := FEventQueue.NextEvent(AEventMask); If AWait And (AEvent = Nil) Then Begin { if the X event queue is empty, block until an event is received } XPeekEvent(FDisplay, @tmpEvent); End; Until (Not AWait) Or (AEvent <> Nil); Result := AEvent <> Nil; End; Function TX11DGA1Display.PeekEvent(AWait : Boolean; Const AEventMask : TPTCEventMask) : TPTCEvent; Var tmpEvent : TXEvent; Begin Repeat { process all events from the X queue and put them on our FEventQueue } HandleEvents; { try to find an event that matches the EventMask } Result := FEventQueue.PeekEvent(AEventMask); If AWait And (Result = Nil) Then Begin { if the X event queue is empty, block until an event is received } XPeekEvent(FDisplay, @tmpEvent); End; Until (Not AWait) Or (Result <> Nil); End; Function TX11DGA1Display.Lock : Pointer; Begin Result := FDGAAddr + FDGALineWidth * FDestY * (FFormat.Bits Div 8) + FDestX * (FFormat.Bits Div 8); End; Procedure TX11DGA1Display.Unlock; Begin End; Procedure TX11DGA1Display.Palette(Const APalette : TPTCPalette); Var pal : PUint32; i : Integer; Begin pal := APalette.data; If Not FFormat.Indexed Then Exit; For i := 0 To 255 Do Begin FColours[i].pixel := i; FColours[i].red := ((pal[i] Shr 16) And $FF) Shl 8; FColours[i].green := ((pal[i] Shr 8) And $FF) Shl 8; FColours[i].blue := (pal[i] And $FF) Shl 8; Byte(FColours[i].flags) := DoRed Or DoGreen Or DoBlue; End; XStoreColors(FDisplay, FCMap, FColours, 256); XF86DGAInstallColormap(FDisplay, FScreen, FCMap); End; Function TX11DGA1Display.GetPitch : Integer; Begin Result := FDGALineWidth * (FFormat.Bits Div 8); End; Function TX11DGA1Display.GetX11Window : TWindow; Begin Result := DefaultRootWindow(FDisplay); End; Function TX11DGA1Display.IsFullScreen : Boolean; Begin { DGA is always fullscreen } Result := True; End; Procedure TX11DGA1Display.SetCursor(AVisible : Boolean); Begin {nothing... raise exception if visible=true?} End; {$ENDIF ENABLE_X11_EXTENSION_XF86DGA1}