⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 vswap.pas

📁 Turbo Pascal 6.0编译器源码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
        JZ      @@1
        TEST    ES:87H.Byte,60H
        JNZ     @@1
        INC     BX
@@1:    CLC
@@2:
end;

procedure MoveFromScreen; near; assembler;
asm
        MOV     CX,4096
        CLD
@@1:    MOVSB
        ADD     SI,BX
        LOOP    @@1
end;

procedure SaveEgaGraphics; near; assembler;
asm
        CALL    CalcStep
        JC      @@2
        PUSH    DS
        MOV     DX,3CEH
        MOV     AX,204H
        OUT     DX,AX
        MOV     AX,5
        OUT     DX,AX
        LES     DI,EgaSwapArea
        MOV     SI,0A000H
        MOV     DS,SI
        XOR     SI,SI
        CALL    MoveFromScreen
        OR      BX,BX
        JZ      @@1
        MOV     SI,4000H
@@1:    CALL    MoveFromScreen
        POP     DS
@@2:
end;

procedure MoveToScreen; near; assembler;
asm
        MOV     CX,4096
        CLD
@@1:    MOVSB
        ADD     DI,BX
        LOOP    @@1
end;

procedure RestoreEgaGraphics; near; assembler;
asm
        CALL    CalcStep
        JC      @@2
        PUSH    DS
        MOV     DX,3C4H
        MOV     AX,402H
        OUT     DX,AX
        LDS     SI,EgaSwapArea
        MOV     DI,0A000H
        MOV     ES,DI
        XOR     DI,DI
        CALL    MoveToScreen
        OR      BX,BX
        JZ      @@1
        MOV     DI,4000H
@@1:    CALL    MoveToScreen
        MOV     AX,0F02H
        OUT     DX,AX
        POP     DS
@@2:
end;

procedure SaveMouseState(MS: Pointer); assembler;
asm
        CMP     ButtonCount,0
        JE      @@1
        MOV     AX,14H
        XOR     CX,CX
        XOR     DX,DX
        MOV     ES,DX
        INT     33H
        MOV     AX,ES
        LES     DI,MS
        CLD
        STOSW
        XCHG    AX,DX
        STOSW
        XCHG    AX,CX
        STOSW
        MOV     DX,DI
        MOV     AX,16H
        INT     33H
@@1:
end;

procedure RestoreMouseState(MS: Pointer); assembler;
asm
        CMP     ButtonCount,0
        JE      @@1
        LES     DX,MS
        ADD     DX,6
        MOV     AX,17H
        INT     33H
        PUSH    DS
        LDS     SI,MS
        CLD
        LODSW
        MOV     ES,AX
        LODSW
        XCHG    AX,DX
        LODSW
        XCHG    AX,CX
        POP     DS
        MOV     AX,14H
        INT     33H
@@1:
end;

procedure TurnCga(State: Boolean); near; assembler;
asm
        MOV     DX,40H
        MOV     ES,DX
        MOV     DX,MonitorTypes
        CMP     ES:49H.Byte,smMono
        JNE     @@1
        XCHG    DL,DH
@@1:    TEST    DL,Cga
        JZ      @@3
        CMP     SnowCheck,0
        JE      @@3
        MOV     DX,ES:Addr6845
        ADD     DX,4
        MOV     AL,ES:65H
        CMP     State,0
        JNE     @@2
        AND     AL,0F7H
@@2:    OUT     DX,AL
@@3:
end;

procedure DoSwapText; near; assembler;
var
  P1, P2: Pointer;
  Buf: array[0..1023] of Byte;
asm
        PUSH    DS
        LES     DI,CgaSwapArea
        MOV     DX,CgaSwapAreaSize
        MOV     AX,40H
        MOV     DS,AX
        MOV     AX,0B800H
        CMP     DS:49H.Byte,smMono
        JNE     @@1
        MOV     AX,0B000H
@@1:    MOV     P1.Word[0],DI
        MOV     P1.Word[2],ES
        MOV     P2.Word[0],0
        MOV     P2.Word[2],AX
        CLD
@@2:    MOV     CX,1024
        CMP     CX,DX
        JB      @@3
        MOV     CX,DX
@@3:    LDS     SI,P2
        LEA     DI,Buf
        PUSH    SS
        POP     ES
        PUSH    CX
        REP     MOVSB
        POP     CX
        LDS     SI,P1
        LES     DI,P2
        PUSH    CX
        REP     MOVSB
        POP     CX
        LEA     SI,Buf
        PUSH    SS
        POP     DS
        LES     DI,P1
        PUSH    CX
        REP     MOVSB
        POP     CX
        ADD     P1.Word[0],CX
        ADD     P2.Word[0],CX
        SUB     DX,CX
        JNZ     @@2
        POP     DS
end;

procedure SwapText; near;
begin
  TurnCga(False);
  DoSwapText;
  TurnCga(True);
end;

procedure CalcScreenSize; near; assembler;
asm
        XOR     BX,BX
        XOR     CX,CX
        CMP     DualMonitor,0
        JNE     @@3
        MOV     AX,40H
        MOV     ES,AX
        MOV     AL,ES:49H
        MOV     DX,MonitorTypes
        CMP     AL,smCO80+1
        JB      @@1
        CMP     AL,smMono
        JNE     @@3
        XCHG    DL,DH
@@1:    MOV     BL,ES:4AH
        MOV     BH,25
        TEST    DL,Ega+Vga
        JZ      @@2
        MOV     BH,ES:84H
        INC     BH
@@2:    MOV     CX,ES:50H
@@3:    MOV     ScreenSize,BX
        MOV     CursorPos,CX
end;

procedure GetUserScreen(X, Y: Word; var Buf; Size: Word); assembler;
asm
        LES     DI,Buf
        CLD
        MOV     DX,Size
        MOV     AX,Y
        CMP     AL,ScreenSize.Byte[1]
        JAE     @@2
        MOV     CL,ScreenSize.Byte[0]
        XOR     CH,CH
        MUL     CL
        ADD     AX,X
        SHL     AX,1
        SUB     CX,X
        JBE     @@2
        CMP     CX,DX
        JBE     @@1
        MOV     CX,DX
@@1:    SUB     DX,CX
        PUSH    DS
        LDS     SI,CgaSwapArea
        ADD     SI,AX
        REP     MOVSW
        POP     DS
@@2:    MOV     CX,DX
        MOV     AX,0720H
        REP     STOSW
end;

procedure ResetMouse; near; assembler;
asm
        CMP     ButtonCount,0
        JE      @@1
        XOR     AX,AX
        INT     33H
@@1:
end;

procedure SwapScreen(Screen: ScreenType; SaveMouse: Boolean);
begin
  if Screen <> CurrentScreen then
  begin
    with Screens[CurrentScreen] do
    begin
      Mode := GetMode;
      SaveVideoState(VideoState);
      SaveEgaPalette(Palette);
      if SaveMouse or (CurrentScreen = scTurbo) then
      begin
        SaveMouseState(MouseState);
        if not FirstOn then
          HideMouse;
      end;
      if not DualMonitor then
        if CurrentScreen = scUser then
          SaveEgaGraphics
        else
          SwapText;
      CalcScreenSize;
    end;
    CurrentScreen := Screen;
    with Screens[CurrentScreen] do
    begin
      if ModeChanged then
        SetMode(Mode)
      else
      begin
        if (VideoState.Addr6845 = Addr6845) and (GetMode <> Mode) then
          SetMode(Mode or smNoClearScreen);
        if not DualMonitor then
          if CurrentScreen = scUser then
            RestoreEgaGraphics
          else
            SwapText;
      end;
      if FirstOn then
      begin
        if DualMonitor then
          ResetMouse
      end else
      begin
        RestoreVideoState(VideoState);
        RestoreEgaPalette(Palette);
        if SaveMouse or (CurrentScreen = scTurbo) then
          RestoreMouseState(MouseState);
      end;
      ModeChanged := False;
      FirstOn := False;
    end;
  end;
end;

procedure ClearCgaSwapArea; near; assembler;
asm
        LES     DI,CgaSwapArea
        MOV     CX,CgaSwapAreaSize
        SHR     CX,1
        MOV     AX,0720H
        CLD
        REP     STOSW
end;

procedure CopyStatus(var S1, S2: TSavedScreen); near;
begin
  Move(S1, S2, Sizeof(S1) - Sizeof(Pointer));
  Move(S1.MouseState^, S2.MouseState^, MouseSaveSize);
end;

procedure CheckUserScreen;
begin
  if Screens[scUser].Mode <> Screens[scCheck].Mode then
  begin
    ModeChanged := True;
    FillChar(Screens[scCheck].VideoState.CursorPos, 8 * Sizeof(Word), 0);
  end else
    Move(Screens[scUser].VideoState.CursorPos,
      Screens[scCheck].VideoState.CursorPos, 8 * Sizeof(Word));
  CopyStatus(Screens[scCheck], Screens[scUser]);
end;

procedure RestoreCursorLines; assembler;
asm
        MOV     AH,1
        MOV     CX,CursorLines
        INT     10H
end;

function GetMemory(Amount: Word): Pointer;
begin
  GetMemory:=Ptr(AllocMem((Amount + 15) shr 4, VUseEms), 0);
end;

procedure ShowTurboScreen;
begin
  CgaSwapArea := GetMemory(CgaSwapAreaSize);
  EgaSwapArea := GetMemory(EgaSwapAreaSize);
  ClearCgaSwapArea;
  SwapScreen(scTurbo, True);
  CopyStatus(Screens[scUser], Screens[scCheck]);
  ScreenMode := Screens[scTurbo].Mode;
  InitVideo;
end;

procedure ShowUserScreen;
begin
  if DualMonitor then
    DoneVideo
  else
    RestoreCursorLines;
  CheckUserScreen;
  SwapScreen(scUser, True);
end;

procedure CalcMouseSaveStateSize; near; assembler;
asm
        XOR     BX,BX
        CMP     BL,ButtonCount
        JE      @@1
        MOV     AX,15H
        INT     33H
        ADD     BX,6
@@1:    MOV     MouseSaveSize,BX
end;

procedure InitVSwap;
var
  CurMonitor: Byte;
  CurMode: Word;
  VS: TVideoState;
begin
  DetectMonitors;
  CurMode := GetMode;
  if DualMonitor and (Hi(GetMonitorTypes) <> 0) then
  begin
    if Lo(CurMode) = smMono then
      CurMode := smCO80
    else
      CurMode := smMono;
    EgaPaletteSave := False;
    GraphicsSwap := False;
    ModeChanged := True;
  end else
  begin
    if InitMode <> 0 then
      CurMode := InitMode
    else
      CurMode := Lo(CurMode);
    if (CurMode <> smBW80) and (CurMode <> smCO80) and (CurMode <> smMono) then
      CurMode := smCO80;
    DualMonitor := False;
  end;
  if CurMode = smMono then
    CurMonitor := Hi(MonitorTypes)
  else
    CurMonitor := Lo(MonitorTypes);
  if not DualMonitor then
    case CurMonitor of
      Ega:
        CgaSwapAreaSize := 6880;
      Vga:
        CgaSwapAreaSize := 8000;
    else
      CgaSwapAreaSize := 4000;
    end;
  if GraphicsSwap and (CurMonitor and (Ega + MCga + Vga) <> 0) then
    EgaSwapAreaSize := 8192
  else
    GraphicsSwap := False;
  if Ega43Lines and (CurMonitor and (Ega + Vga) <> 0) then
    Screens[scTurbo].Mode := CurMode or smFont8x8
  else
    Screens[scTurbo].Mode := CurMode;
  if EgaPaletteSave and (CurMonitor and Ega <> 0) and (EgaPtrs^[1] = nil) then
  begin
    SaveEgaPtrs := EgaPtrs;
    NewEgaPtrs := EgaPtrs^;
    NewEgaPtrs[1] := @NewArea;
    EgaPtrs := @NewEgaPtrs;
    NewArea[0] := $FF;
    SaveVideoState(VS);
    SetMode(GetMode or smNoClearScreen);
    RestoreVideoState(VS);
    if NewArea[0] = $FF then
      DoneVSwap;
  end;
  CalcMouseSaveStateSize;
  if ButtonCount <> 0 then
  begin
    GetMem(Screens[scTurbo].MouseState, MouseSaveSize);
    GetMem(Screens[scUser].MouseState, MouseSaveSize);
    GetMem(Screens[scCheck].MouseState, MouseSaveSize);
  end;
end;

procedure DoneVSwap;
begin
  if SaveEgaPtrs <> nil then
  begin
    EgaPtrs := SaveEgaPtrs;
    SaveEgaPtrs := nil;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -