+ Huge video unit rework for Amiga/MorphOS

  * removed tons of Win32 unit leftovers, and other cleanups
  * cursor handling fixes, additions (like changing cursor shapes)
  * added initial support for sysmsgs

git-svn-id: trunk@11982 -

rtl/morphos/video.pp

@@ -22,9 +22,16 @@ uses
 
 {$i videoh.inc}
 
+
+{ Amiga specific calls, to help interaction between Keyboard, Mouse and
+  Video units, and Free Vision }
+procedure GotCloseWindow;
+function HasCloseWindow: boolean;
+
 var
    videoWindow   : pWindow; 
 
+
 implementation
 
 uses
@@ -45,57 +52,36 @@ var
    videoPens     : array[0..15] of longint;
 
    oldCursorX, oldCursorY: longint;
-   visibleCursor: boolean;
-   oldvisibleCursor: boolean;
+   cursorType: word;
+   oldcursorType: word;
+
+   gotCloseWindowMsg: boolean;
 
 procedure SysInitVideo;
 var counter: longint;
 begin
-//   writeln('sysinitvideo');
    InitGraphicsLibrary;
    InitIntuitionLibrary;
-{
-  ScreenColor:=true;
-  GetConsoleScreenBufferInfo(TextRec(Output).Handle, OrigConsoleInfo);
-  GetConsoleCursorInfo(TextRec(Output).Handle, OrigConsoleCursorInfo);
-  OrigCP := GetConsoleCP;
-  ConsoleInfo:=OrigConsoleInfo;
-  ConsoleCursorInfo:=OrigConsoleCursorInfo;
-  {
-    About the ConsoleCursorInfo record: There are 3 possible
-    structures in it that can be regarded as the 'screen':
-    - dwsize   : contains the cols & row in current screen buffer.
-    - srwindow : Coordinates (relative to buffer) of upper left
-                 & lower right corners of visible console.
-    - dmMaximumWindowSize : Maximal size of Screen buffer.
-    The first implementation of video used srWindow. After some
-    bug-reports, this was switched to dwMaximumWindowSize.
-  }
-  with ConsoleInfo.dwMaximumWindowSize do
-    begin
-    ScreenWidth:=X;
-    ScreenHeight:=Y;
-    end;
-  { TDrawBuffer only has FVMaxWidth elements
-    larger values lead to crashes }
-  if ScreenWidth> FVMaxWidth then
-    ScreenWidth:=FVMaxWidth;
-  CursorX:=ConsoleInfo.dwCursorPosition.x;
-  CursorY:=ConsoleInfo.dwCursorPosition.y;
-  if not ConsoleCursorInfo.bvisible then
-    CursorLines:=0
-  else
-    CursorLines:=ConsoleCursorInfo.dwSize;
-}
+
+   // fill videobuf and oldvideobuf with different bytes, to allow proper first draw
+   FillDword(VideoBuf^,VideoBufSize Div 4,$1234D3AD);
+   FillDword(OldVideoBuf^,VideoBufSize Div 4,$4321BEEF);
+
    videoWindow:=OpenWindowTags(Nil, [
       WA_Left,50,
       WA_Top,50,
       WA_InnerWidth,80*8,
       WA_InnerHeight,25*16,
+      WA_MaxWidth,32768,
+      WA_MaxHeight,32768,
 //      WA_IDCMP,IDCMP_MOUSEBUTTONS Or IDCMP_RAWKEYS,
-      WA_IDCMP,IDCMP_VANILLAKEY Or IDCMP_RAWKEY,
+      WA_IDCMP,IDCMP_VANILLAKEY Or IDCMP_RAWKEY Or
+               IDCMP_CLOSEWINDOW,
       WA_Title,DWord(PChar('Free Pascal Video Output')),
-      WA_Flags,(WFLG_GIMMEZEROZERO Or WFLG_SMART_REFRESH Or WFLG_NOCAREREFRESH Or WFLG_ACTIVATE Or WFLG_DRAGBAR Or WFLG_DEPTHGADGET)
+      WA_Flags,(WFLG_GIMMEZEROZERO Or WFLG_SMART_REFRESH Or WFLG_NOCAREREFRESH Or 
+                WFLG_ACTIVATE Or WFLG_DRAGBAR Or WFLG_DEPTHGADGET Or
+//                WFLG_SIZEGADGET Or WFLG_SIZEBBOTTOM Or
+                WFLG_CLOSEGADGET)
    ]);
 
    ScreenWidth := 80;
@@ -115,8 +101,10 @@ begin
    CursorY:=0;
    oldCursorX:=0;
    oldCursorY:=0;
-   visibleCursor:=true;
-   oldvisibleCursor:=true;
+   cursorType:=crHidden;
+   oldcursorType:=crHidden;
+
+   gotCloseWindowMsg:=false;
 end;
 
 
@@ -125,101 +113,18 @@ var counter: longint;
 begin
    if videoWindow<>nil then CloseWindow(videoWindow);
    for counter:=0 to 15 do ReleasePen(videoColorMap,videoPens[counter]);
- 
-{
-  SetConsoleScreenBufferSize (TextRec (Output).Handle, OrigConsoleInfo.dwSize);
-  SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, OrigConsoleInfo.srWindow);
-  SetConsoleCursorInfo(TextRec(Output).Handle, OrigConsoleCursorInfo);
-  SetConsoleCP(OrigCP);
-}
 end;
 
 
 
-function SysVideoModeSelector (const VideoMode: TVideoMode): boolean;
+function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
 
-{
-var MI: Console_Screen_Buffer_Info;
-    C: Coord;
-    SR: Small_Rect;
-}
-begin
-{
-  if not (GetConsoleScreenBufferInfo (TextRec (Output).Handle, MI)) then
-    SysVideoModeSelector := false
-  else
-    begin
-      with MI do
-        begin
-          C.X := VideoMode.Col;
-          C.Y := VideoMode.Row;
-        end;
-      with SR do
-        begin
-          Top := 0;
-          Left := 0;
-          { First, we need to make sure we reach the minimum window size
-            to always fit in the new buffer after changing buffer size. }
-          Right := MI.srWindow.Right - MI.srWindow.Left;
-          if VideoMode.Col <= Right then
-            Right := Pred (VideoMode.Col);
-          Bottom := MI.srWindow.Bottom - MI.srWindow.Top;
-          if VideoMode.Row <= Bottom then
-            Bottom := Pred (VideoMode.Row);
-        end;
-      if SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, SR) then
-        if SetConsoleScreenBufferSize (TextRec (Output).Handle, C) then
-          begin
-            with SR do
-              begin
-                { Now, we can resize the window to the final size. }
-                Right := Pred (VideoMode.Col);
-                Bottom := Pred (VideoMode.Row);
-              end;
-            if SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, SR) then
-              begin
-                SysVideoModeSelector := true;
-                SetCursorType (LastCursorType);
-                ClearScreen;
-              end
-            else
-              begin
-                SysVideoModeSelector := false;
-                SetConsoleScreenBufferSize (TextRec (Output).Handle, MI.dwSize);
-                SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, MI.srWindow);
-                SetCursorType (LastCursorType);
-              end
-          end
-        else
-          begin
-            SysVideoModeSelector := false;
-            SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, MI.srWindow);
-            SetCursorType (LastCursorType);
-          end
-      else
-        SysVideoModeSelector := false;
-    end;
-}
-end;
-
-Const
-  SysVideoModeCount = 6;
-  SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = (
-   (Col: 40; Row: 25; Color: True),
-   (Col: 80; Row: 25; Color: True),
-   (Col: 80; Row: 30; Color: True),
-   (Col: 80; Row: 43; Color: True),
-   (Col: 80; Row: 50; Color: True),
-   (Col: 80; Row: 25; Color: True) // Reserved for TargetEntry
-  );
-
-
-Function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
-
-Var
+var
   I : Integer;
 
 begin
+
+{
   I:=SysVideoModeCount-1;
   SysSetVideoMode:=False;
   While (I>=0) and Not SysSetVideoMode do
@@ -238,21 +143,9 @@ begin
       ScreenColor:=SysVMD[I].Color;
       end else SysSetVideoMode := false;
     end;
+}
 end;
 
-Function SysGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
-
-begin
-  SysGetVideoModeData:=(Index<=high(SysVMD));
-  If SysGetVideoModeData then
-    Data:=SysVMD[Index];
-end;
-
-Function SysGetVideoModeCount : Word;
-
-begin
-  SysGetVideoModeCount:=SysVideoModeCount;
-end;
 
 procedure SysClearScreen;
 begin
@@ -260,7 +153,7 @@ begin
 end;
 
 
-procedure DrawChar(x,y: longint; bitmap: pBitmap; drawCursor: boolean);
+procedure DrawChar(x,y: longint; crType: word);
 var tmpCharData: word;
     tmpChar    : byte;
     tmpFGColor : byte;
@@ -273,17 +166,24 @@ begin
   tmpChar    :=tmpCharData and $0ff;
   tmpFGColor :=(tmpCharData shr 8) and %00001111;
   tmpBGColor :=(tmpCharData shr 12) and %00000111;
-  
+
   sX:=x*8;
   sY:=y*16;
-  
-  SetAPen(videoWindow^.Rport,videoPens[tmpFGColor]);
-  SetBPen(videoWindow^.RPort,videoPens[tmpBGColor]);
+
+  if crType <> crBlock then begin
+    SetABPenDrMd(videoWindow^.RPort,videoPens[tmpFGColor],videoPens[tmpBGColor],JAM2);
+  end else begin
+    { in case of block cursor, swap fg/bg colors 
+      and BltTemplate() below will take care of everything }
+    SetABPenDrMd(videoWindow^.RPort,videoPens[tmpBGColor],videoPens[tmpFGColor],JAM2);
+  end;
+
   BltTemplate(@vgafont[tmpChar,0],0,1,videoWindow^.RPort,sX,sY,8,16);
-  
-  if drawCursor then begin
-     gfxMove(videoWindow^.RPort,sX,sY+14); Draw(videoWindow^.RPort,sX+7,sY+14);
-     gfxMove(videoWindow^.RPort,sX,sY+15); Draw(videoWindow^.RPort,sX+7,sY+15);
+
+  if crType = crUnderLine then begin
+    { draw two lines at the bottom of the char, in case of underline cursor }
+    gfxMove(videoWindow^.RPort,sX,sY+14); Draw(videoWindow^.RPort,sX+7,sY+14);
+    gfxMove(videoWindow^.RPort,sX,sY+15); Draw(videoWindow^.RPort,sX+7,sY+15);
   end;
 end;
 
@@ -292,11 +192,12 @@ procedure SysUpdateScreen(force: boolean);
 var
    BufCounter  : Longint;
    smallforce  : boolean;
-
+   cursormoved : boolean;
    counter, counterX, counterY: longint;
-var
-   tmpBitmap   : tBitmap;
 begin
+  smallforce:=false;
+  cursormoved:=false;
+
   if force then
     smallforce:=true
   else begin
@@ -312,21 +213,23 @@ begin
     for counterY:=0 to ScreenHeight-1 do begin
       for counterX:=0 to ScreenWidth-1 do begin
         if VideoBuf^[BufCounter]<>OldVideoBuf^[BufCounter] then
-          DrawChar(counterX,counterY,@tmpBitmap,false);
+          DrawChar(counterX,counterY,crHidden);
         Inc(BufCounter);
       end;
     end;
     move(VideoBuf^,OldVideoBuf^,VideoBufSize);
   end;
 
-  if (oldvisibleCursor<>visibleCursor) or (CursorX<>oldCursorX) or (CursorY<>oldCursorY) then begin
-    writeln('kurzor:',cursorx,' ',cursory);
-    DrawChar(oldCursorY,oldCursorX,@tmpBitmap,false);
-    DrawChar(CursorY,CursorX,@tmpBitmap,visibleCursor);
+  if (cursorType<>oldcursorType) or 
+     (CursorX<>oldCursorX) or (CursorY<>oldCursorY) or
+     smallforce then begin
+    DrawChar(oldCursorY,oldCursorX,crHidden);
+    DrawChar(CursorY,CursorX,cursorType);
     oldCursorX:=CursorX;
     oldCursorY:=CursorY;
-    oldVisibleCursor:=visibleCursor;
+    oldcursorType:=cursorType;
   end;
+
 end;
 
 
@@ -344,54 +247,33 @@ end;
 
 function SysGetCursorType: Word;
 begin
-  if not visibleCursor then SysGetCursorType:=crHidden 
-                       else SysGetCursorType:=crUnderline;
- 
-{
-   GetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
-   if not ConsoleCursorInfo.bvisible then
-     SysGetCursorType:=crHidden
-   else
-     case ConsoleCursorInfo.dwSize of
-        1..30:
-          SysGetCursorType:=crUnderline;
-        31..70:
-          SysGetCursorType:=crHalfBlock;
-        71..100:
-          SysGetCursorType:=crBlock;
-     end;
-}
+  SysGetCursorType:=cursorType;
 end;
 
 
 procedure SysSetCursorType(NewType: Word);
 begin
-  if newType=crHidden then visibleCursor:=false
-                      else visibleCursor:=true;
+  cursorType:=newType;
+  { FIXME: halfBlock cursors are not supported for now 
+           by the rendering code }
+  if cursorType = crHalfBlock then cursorType:=crBlock;
+
   SysUpdateScreen(false);
-{
-   GetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
-   if newType=crHidden then
-     ConsoleCursorInfo.bvisible:=false
-   else
-     begin
-        ConsoleCursorInfo.bvisible:=true;
-        case NewType of
-           crUnderline:
-             ConsoleCursorInfo.dwSize:=10;
-
-           crHalfBlock:
-             ConsoleCursorInfo.dwSize:=50;
-
-           crBlock:
-             ConsoleCursorInfo.dwSize:=99;
-        end
-     end;
-   SetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
-}
 end;
 
 
+// Amiga specific calls
+procedure GotCloseWindow;
+begin
+  gotCloseWindowMsg:=true;
+end;
+
+function HasCloseWindow: boolean;
+begin
+  HasCloseWindow:=gotCloseWindowMsg;
+  gotCloseWindowMsg:=false;
+end;
+
 
 const
   SysVideoDriver : TVideoDriver = (
@@ -400,13 +282,12 @@ const
     UpdateScreen : @SysUpdateScreen;
     ClearScreen : @SysClearScreen;
     SetVideoMode : @SysSetVideoMode;
-    GetVideoModeCount : @SysGetVideoModeCount;
-    GetVideoModeData : @SysGetVideoModeData;
+    GetVideoModeCount : nil;
+    GetVideoModeData : nil;
     SetCursorPos : @SysSetCursorPos;
     GetCursorType : @SysGetCursorType;
     SetCursorType : @SysSetCursorType;
     GetCapabilities : @SysGetCapabilities
-
   );