* adapt to new video unit layout

ide/fpmopts.inc

@@ -688,8 +688,8 @@ type
 
 function TVideoModeCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
 var R: Sw_integer;
-    K1: PVideoModeList absolute Key1;
-    K2: PVideoModeList absolute Key2;
+    K1: PVideoMode absolute Key1;
+    K2: PVideoMode absolute Key2;
 begin
   if K1^.Col<K2^.Col then R:=-1 else
   if K1^.Col>K2^.Col then R:= 1 else
@@ -703,44 +703,32 @@ end;
 
 procedure TVideoModeCollection.FreeItem(Item: Pointer);
 begin
-  { don't do anything here }
+  FreeMem(Item,sizeof(TVideoMode));
 end;
 
 procedure TIDEApp.Preferences;
-function SearchVideoMode(Col,Row: word; Color: boolean): PVideoModeList;
-var I,P: PVideoModeList;
-begin
-  I:=nil; P:=Video.Modes;
-  while (I=nil) and (P<>nil) do
-    begin
-      if (P^.Col=Col) and (P^.Row=Row) and (P^.Color=Color) then
-        I:=P
-      else
-        P:=P^.Next;
-    end;
-  SearchVideoMode:=I;
-end;
 var R,R2: TRect;
     D: PCenterDialog;
     C: PVideoModeCollection;
     VMLB: PVideoModeListBox;
-    VP: PVideoModeList;
     VM: TVideoMode;
+    CurVP,VP: PVideoMode;
     RB1: PPlainRadioButtons;
     CB1,CB2: PPlainCheckBoxes;
-    CurM: PVideoModeList;
     CurIdx: integer;
+    i : word;
 begin
   New(C, Init(10,50));
-  VP:=Video.Modes; CurM:=nil;
-  while VP<>nil do
-    begin
+  for i:=0 to GetVideoModeCount-1 do
+   begin
+      GetVideoModeData(i,VM);
+      GetMem(VP,sizeof(TVideoMode));
+      Move(VM,VP^,sizeof(TVideoMode));
       C^.Insert(VP);
-      if (VP^.Row=ScreenMode.Row) and (VP^.Col=ScreenMode.Col) and
-         (VP^.Color=ScreenMode.Color) then
-       CurM:=VP;
-      VP:=VP^.Next;
-    end;
+      if (VM.Row=ScreenMode.Row) and (VM.Col=ScreenMode.Col) and
+         (VM.Color=ScreenMode.Color) then
+       CurVP:=VP;
+   end;
   R.Assign(0,0,64,15);
   New(D, Init(R, dialog_preferences));
   with D^ do
@@ -752,8 +740,8 @@ begin
     R.B.Y:=R.A.Y+3;
     R2.Copy(R); R2.Grow(-1,-1);
     New(VMLB, Init(R2, Min(4,C^.Count), C));
-    if CurM=nil then CurIdx:=-1 else
-      CurIdx:=C^.IndexOf(CurM);
+    if CurVP=nil then CurIdx:=-1 else
+      CurIdx:=C^.IndexOf(CurVP);
     if CurIdx<>-1 then
       VMLB^.FocusItem(CurIdx);
     Insert(New(PGroupView, Init(R, label_preferences_videomode, VMLB)));
@@ -801,7 +789,7 @@ begin
    begin
      if (C^.count>0) then
        begin
-         with PVideoModeList(C^.At(VMLB^.Focused))^ do
+         with PVideoMode(C^.At(VMLB^.Focused))^ do
            begin
              VM.Col:=Col;
              VM.Row:=Row;
@@ -1285,7 +1273,10 @@ end;
 
 {
   $Log$
-  Revision 1.2  2001-08-05 12:23:00  peter
+  Revision 1.3  2001-10-11 11:35:53  pierre
+   * adapt to new video unit layout
+
+  Revision 1.2  2001/08/05 12:23:00  peter
     * Automatically support for fvision or old fv
 
   Revision 1.1  2001/08/04 11:30:23  peter

ide/fpviews.pas

@@ -3914,7 +3914,7 @@ end;
 {$endif FVISION}
 
 function TVideoModeListBox.GetText(Item: pointer; MaxLen: sw_integer): string;
-var P: PVideoModeList;
+var P: PVideoMode;
     S: string;
 begin
   P:=Item;
@@ -4148,8 +4148,7 @@ begin
       if VESAGetModeInfo(ML.Modes[I],MI) then
       with MI do
         if (Attributes and vesa_vma_GraphicsMode)=0 then
-          RegisterVideoMode(XResolution,YResolution,
-            (Attributes and vesa_vma_ColorMode)<>0,{$ifdef FPC}@{$endif}VESASetVideoModeProc,ML.Modes[I]);
+          RegisterVesaVideoMode(ML.Modes[I]);
     end;
 end;
 {$endif}
@@ -4181,7 +4180,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.7  2001-09-27 22:29:12  pierre
+  Revision 1.8  2001-10-11 11:36:30  pierre
+   * adapt to new video unit layout
+
+  Revision 1.7  2001/09/27 22:29:12  pierre
    * avoid to give the same core to all new files
 
   Revision 1.6  2001/09/25 22:46:50  pierre

ide/vesa.pas

@@ -125,10 +125,37 @@ function VESASetMode(Mode: word): boolean;
 function VESAGetMode(var Mode: word): boolean;
 function VESASelectMemoryWindow(Window: byte; Position: word): boolean;
 function VESAReturnMemoryWindow(Window: byte; var Position: word): boolean;
+function RegisterVesaVideoMode(Mode : word) : boolean;
 
 implementation
 
-uses pmode;
+uses
+{$ifdef FPC}
+  video, mouse,
+{$endif FPC}
+  pmode;
+
+type
+
+       PVesaVideoMode = ^TVesaVideoMode;
+       TVesaVideoMode = record
+         {Col,Row      : word;
+          Color        : boolean;}
+         V            : TVideoMode;
+         Mode         : word;
+         { zero based vesa specific driver count }
+         VideoIndex   : word;
+         Next         : PVesaVideoMode;
+       end;
+
+const
+  VesaVideoModeHead : PVesaVideoMode = nil;
+  VesaRegisteredModes : word = 0;
+Var
+  SysGetVideoModeCount : function : word;
+  SysSetVideoMode : function (Const VideoMode : TVideoMode) : boolean;
+  SysGetVideoModeData : Function (Index : Word; Var Data : TVideoMode) : boolean;
+
 
 function VESAGetInfo(var B: TVESAInfoBlock): boolean;
 var r: registers;
@@ -210,6 +237,39 @@ begin
   VESAGetModeInfo:=OK;
 end;
 
+function RegisterVesaVideoMode(Mode : word) : boolean;
+var B: TVESAModeInfoBlock;
+    VH : PVesaVideoMode;
+    DoAdd : boolean;
+begin
+  if not VESAGetModeInfo(Mode,B) then
+    RegisterVesaVideoMode:=false
+  else
+    begin
+      VH:=VesaVideoModeHead;
+      DoAdd:=true;
+      RegisterVesaVideoMode:=false;
+      while assigned(VH) do
+        begin
+          if VH^.mode=mode then
+            DoAdd:=false;
+          VH:=VH^.next;
+        end;
+      if DoAdd then
+        begin
+          New(VH);
+          VH^.next:=VesaVideoModeHead;
+          VH^.mode:=mode;
+          VH^.v.color:=(B.Attributes and vesa_vma_ColorMode)<>0;
+          VH^.v.col:=B.XResolution;
+          VH^.v.row:=B.YResolution;
+          VH^.VideoIndex:=VesaRegisteredModes;
+          Inc(VesaRegisteredModes);
+          RegisterVesaVideoMode:=true;
+        end;
+    end;
+end;
+
 function VESASetMode(Mode: word): boolean;
 var r: registers;
     OK: boolean;
@@ -257,14 +317,107 @@ var OK: boolean;
     VI: TVESAInfoBlock;
 begin
   OK:=VESAGetInfo(VI);
+  if OK then
+
   VESAInit:=OK;
 end;
 
+{$ifdef FPC}
+Function VesaGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
+Var
+  PrevCount : word;
+  VH : PVesaVideoMode;
+
+begin
+  PrevCount:=SysGetVideoModeCount();
+  VesaGetVideoModeData:=(Index<PrevCount);
+  If VesaGetVideoModeData then
+    begin
+      VesaGetVideoModeData:=SysGetVideoModeData(Index,Data);
+      exit;
+    end;
+  VesaGetVideoModeData:=(Index-PrevCount)<VesaRegisteredModes;
+  If VesaGetVideoModeData then
+    begin
+      VH:=VesaVideoModeHead;
+      while assigned(VH) and (VH^.VideoIndex<>Index-PrevCount) do
+        VH:=VH^.next;
+      if assigned(VH) then
+        Data:=VH^.v
+      else
+        VesaGetVideoModeData:=false;
+    end;
+end;
+
+function SetVESAMode(const VideoMode: TVideoMode): Boolean;
+
+  var
+     w : word;
+     res : boolean;
+     VH : PVesaVideoMode;
+
+  begin
+     res:=false;
+     VH:=VesaVideoModeHead;
+     while assigned(VH) do
+       begin
+         if (VideoMode.col=VH^.v.col) and
+            (VideoMode.row=VH^.v.row) and
+            (VideoMode.color=VH^.v.color) then
+           begin
+             res:=VESASetMode(VH^.mode);
+             if res then
+               begin
+                  ScreenWidth:=VideoMode.Col;
+                  ScreenHeight:=VideoMode.Row;
+                  ScreenColor:=VideoMode.Color;
+                  // cheat to get a correct mouse
+                  {
+                  mem[$40:$84]:=ScreenHeight-1;
+                  mem[$40:$4a]:=ScreenWidth;
+                  memw[$40:$4c]:=ScreenHeight*((ScreenWidth shl 1)-1);
+                  }
+                  DoCustomMouse(true);
+               end;
+           end;
+         if res then
+           exit;
+         VH:=VH^.next;
+       end;
+     SetVESAMode:=SysSetVideoMode(VideoMode);
+  end;
+
+
+Function VesaGetVideoModeCount : Word;
+
+begin
+  VesaGetVideoModeCount:=SysGetVideoModeCount()+VesaRegisteredModes;
+end;
+
+
+Var
+  Driver : TVideoDriver;
+
 BEGIN
+{ Get the videodriver to be used }
+  GetVideoDriver (Driver);
+{ Change needed functions }
+  SysGetVideoModeCount:=Driver.GetVideoModeCount;
+  Driver.GetVideoModeCount:=@VesaGetVideoModeCount;
+  SysGetVideoModeData:=Driver.GetVideoModeData;
+  Driver.GetVideoModeData:=@VesaGetVideoModeData;
+  SysSetVideoMode:=Driver.SetVideoMode;
+  Driver.SetVideoMode:=@SetVESAMode;
+
+  SetVideoDriver (Driver);
+{$endif FPC}
 END.
 {
   $Log$
-  Revision 1.1  2001-08-04 11:30:25  peter
+  Revision 1.2  2001-10-11 11:35:34  pierre
+   * adapt to new video unit layout
+
+  Revision 1.1  2001/08/04 11:30:25  peter
     * ide works now with both compiler versions
 
   Revision 1.1  2000/07/13 09:48:36  michael