home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tvision / gtmous / dark.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-09-30  |  13.2 KB  |  483 lines
  1. {$F+,O+}
  2. unit dark;
  3.  
  4. interface
  5. uses GTMouse;
  6. const
  7.  SleepType      : integer = 0;
  8.  SleepSpeed     : integer = 3;
  9.  
  10. procedure InitSleeper( SType,   TimeDelay,
  11.                         LeftUpX,  LeftUpY,
  12.                         RightDnX, RightDnY : integer);
  13. {    Init "Sleep" coordinates and time (sec) without event to sleep Screen   }
  14. {    By Default:   InitSleeper(4,30,80,1,80,1);                              }
  15. {    Example:                                                                }
  16. {                        ...                                                 }
  17. {    InitSleeper(4,10,1,25,80,25);                                           }
  18.  
  19. procedure DarkScreen;
  20. procedure Sleeper;
  21. procedure JumpToOldIsr(OldIsr : Pointer);
  22.   {-Jump to previous ISR from an interrupt procedure.}
  23.   inline(
  24.     $5B/                     {pop bx          }
  25.     $58/                     {pop ax          }
  26.     $87/$5E/$0E/             {xchg bx,[bp+14] }
  27.     $87/$46/$10/             {xchg ax,[bp+16] }
  28.     $89/$EC/                 {mov sp,bp       }
  29.     $5D/                     {pop bp          }
  30.     $07/                     {pop es          }
  31.     $1F/                     {pop ds          }
  32.     $5F/                     {pop di          }
  33.     $5E/                     {pop si          }
  34.     $5A/                     {pop dx          }
  35.     $59/                     {pop cx          }
  36.     $CB);                    {retf            }
  37.  
  38.  
  39. implementation
  40.  
  41. const
  42.   MAX_STARS        = 50;
  43.   SleeperOff       : boolean = false;    { if true Wake Up                    }
  44.   XYEvent          : boolean =false;     { if true time sleep ignore          }
  45.   showundersleep   : boolean =false;
  46. type
  47.   star_record = record
  48.      x,y,nx,ny,maxn,mx,my,dx,dy,bf,col : longint;
  49.      end;
  50.   stars_table = array [1..MAX_STARS] of star_record;
  51.   pST = ^stars_table;
  52.   Scr  = array [0..12999] of byte;
  53.   pScr = ^Scr;
  54.   CharIm   = array[0..16] of byte;
  55. var
  56.    OldInt09       : pointer;              { Save Old interrupt vector          }
  57.    oldScreen      : pScr;
  58.    pScreen        : pScr;
  59.    prTimer        : longint;
  60.    VertSize,MaxY  : integer;
  61.    TimeDelay      : integer;
  62.    Stars          : pST;
  63.    EndDark        : boolean;
  64.    lScreen        : integer;
  65.    SleepOn        : boolean;
  66.  SleeperLx,SleeperLy,SleeperRx,SleeperRy : integer;
  67. const
  68.   chlng    =6;
  69.   chmap    : array [0..3,0..chlng] of charIm = (
  70. ((1,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
  71.  (2,$00,$00,$00,$00,$00,$00,$10,$00,$00,$00,$00,$00,$00,$00,$00,$00),
  72.  (3,$00,$00,$00,$00,$00,$10,$38,$10,$00,$00,$00,$00,$00,$00,$00,$00),
  73.  (4,$00,$00,$00,$10,$10,$10,$38,$10,$10,$10,$00,$00,$00,$00,$00,$00),
  74.  (5,$00,$00,$10,$10,$10,$38,$7C,$38,$10,$10,$10,$00,$00,$00,$00,$00),
  75.  (6,$00,$10,$10,$10,$38,$38,$7C,$38,$38,$10,$10,$10,$00,$00,$00,$00),
  76.  (7,$10,$10,$10,$38,$38,$7C,$FE,$7C,$38,$38,$10,$10,$10,$00,$00,$00)),
  77. ((1,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
  78.  (2,$00,$00,$00,$00,$00,$10,$38,$10,$00,$00,$00,$00,$00,$00,$00,$00),
  79.  (3,$00,$00,$00,$00,$10,$38,$6C,$38,$10,$00,$00,$00,$00,$00,$00,$00),
  80.  (4,$00,$00,$10,$38,$38,$38,$6C,$38,$38,$10,$00,$00,$00,$00,$00,$00),
  81.  (5,$00,$10,$38,$28,$28,$6C,$C6,$6C,$28,$28,$38,$10,$00,$00,$00,$00),
  82.  (6,$10,$38,$28,$28,$6C,$44,$C6,$44,$6C,$28,$28,$38,$10,$00,$00,$00),
  83.  (7,$38,$28,$6C,$44,$44,$C6,$82,$C6,$44,$44,$44,$6C,$38,$00,$00,$00)),
  84. ((1,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
  85.  (2,$00,$00,$00,$00,$00,$10,$38,$10,$00,$00,$00,$00,$00,$00,$00,$00),
  86.  (3,$00,$00,$00,$00,$10,$38,$7C,$38,$10,$00,$00,$00,$00,$00,$00,$00),
  87.  (4,$00,$00,$00,$44,$38,$7C,$7C,$38,$44,$00,$00,$00,$00,$00,$00,$00),
  88.  (5,$00,$00,$10,$54,$38,$7C,$7C,$38,$54,$10,$00,$00,$00,$00,$00,$00),
  89.  (6,$00,$10,$54,$38,$BA,$7C,$7C,$BA,$38,$54,$10,$00,$00,$00,$00,$00),
  90.  (7,$18,$99,$5A,$3C,$BD,$7E,$7E,$BD,$3C,$7E,$99,$18,$18,$00,$00,$00)),
  91. ((1,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00),
  92.  (2,$00,$00,$00,$00,$00,$00,$10,$00,$00,$00,$00,$00,$00,$00,$00,$00),
  93.  (3,$00,$00,$00,$00,$00,$18,$18,$18,$00,$00,$00,$00,$00,$00,$00,$00),
  94.  (4,$00,$00,$00,$00,$38,$38,$38,$38,$38,$00,$00,$00,$00,$00,$00,$00),
  95.  (5,$00,$00,$00,$7C,$7C,$7C,$7C,$7C,$7C,$7C,$7C,$00,$00,$00,$00,$00),
  96.  (6,$00,$7E,$7E,$7E,$7E,$7E,$7E,$7E,$7E,$7E,$7E,$7E,$00,$00,$00,$00),
  97.  (7,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$00,$00)));
  98.  
  99. type
  100.  ChArray = array [0..31] of charIm;
  101.  pCharIm = ^ChArray;
  102. var
  103.   pChSave : pCharIm;
  104.  
  105. procedure MoveCharImage(Sourse, Dest:pointer);
  106. var
  107.    i     : integer;
  108.    ofset : word;
  109.   begin
  110.     inline($fa);       
  111.     portw[$3c4]:=$0402;
  112.     portw[$3c4]:=$0704;
  113.     portw[$3ce]:=$0204;
  114.     portw[$3ce]:=$0005;
  115.     portw[$3ce]:=$0006;
  116.     move(Sourse^,Dest^,16);
  117.     portw[$3c4]:=$0302;
  118.     portw[$3c4]:=$0304;
  119.     portw[$3ce]:=$0004;
  120.     portw[$3ce]:=$1005;
  121.     portw[$3ce]:=$0E06;
  122.     inline($fb);       
  123.   end;
  124.  
  125. procedure Setfont;
  126. var
  127.    i     : integer;
  128.    ofset : word;
  129.   begin
  130.     for i:=0 to chlng do
  131.       begin
  132.         ofset :=ord(ChMap[SleepType,i][0])*32;
  133.         moveCharImage(addr(ChMap[SleepType,i][1]),ptr(SEGA000,ofset));
  134.       end;
  135.   end;
  136.  
  137. procedure Savefont;
  138. var
  139.    i     : integer;
  140.    ofset : word;
  141.   begin
  142.    for i:=0 to chlng do
  143.      begin
  144.        ofset :=ord(ChMap[SleepType][i][0])*32;
  145.        moveCharImage(ptr(SEGA000,ofset),addr(pChSave^[i][1]));
  146.      end;
  147.   end;
  148.  
  149. procedure RestoreFont;
  150. var
  151.    i     : integer;
  152.    ofset : word;
  153.   begin
  154.    for i:=0 to chlng do
  155.    begin
  156.        ofset :=ord(ChMap[SleepType,i][0])*32;
  157.        moveCharImage(addr(pChSave^[i][1]),ptr(SEGA000,ofset));
  158.    end;
  159.   end;
  160.  
  161. procedure SavefontDark;
  162. var
  163.    i     : integer;
  164.    ofset : word;
  165.   begin
  166.    for i:=224 to 255 do
  167.      begin
  168.        ofset :=i*32;
  169.        moveCharImage(ptr(SEGA000,ofset),addr(pChSave^[i-224][1]));
  170.      end;
  171.   end;
  172.  
  173. procedure RestoreFontDark;
  174. var
  175.    i     : integer;
  176.    ofset : word;
  177.   begin
  178.    for i:=224 to 255 do
  179.    begin
  180.        ofset :=i*32;
  181.        moveCharImage(addr(pChSave^[i-224][1]),ptr(SEGA000,ofset));
  182.    end;
  183.   end;
  184.  
  185.  
  186.  
  187.  
  188. procedure ChangeSymbols;
  189. var
  190.   b : byte;
  191.   i,j,k,h : integer;
  192.   chb : array [1..512] of byte;
  193.   charbuf : array [1..32] of byte;
  194.   ofset : word;
  195.  
  196. begin
  197.   for i:=1 to 512 do chb[i]:=0;
  198.   for i:=1 to 32 do charbuf[i]:=0;
  199.   h := VertSize div 2;
  200.   for i:=1 to h do
  201.     for j:=1 to 4 do
  202.     begin
  203.       k:=(4*(i-1)+j-1)*VertSize;
  204.       k:=k+(i-1)*2+1;
  205.       chb[k]:=$c0 shr (2*(j-1));
  206.       chb[k+1]:=chb[k];
  207.     end;
  208.     SaveFontDark;
  209.     for i :=224 to 224+vertsize*2 do
  210.     begin
  211.       move(chb[(i-224)*vertsize+1],charbuf,vertsize);
  212.       ofset :=i*32;
  213.       moveCharImage(addr(charbuf),ptr($a000,ofset));
  214.     end;
  215. end;
  216.  
  217.  
  218. procedure NewStar;
  219. var
  220.   i,j : integer;
  221. begin
  222.   i:=MAX_STARS+1;
  223.   for j:=1 to MAX_STARS do
  224.     if Stars^[j].col=0 then i:=j;
  225.   if i<=MAX_STARS then
  226.     with Stars^[i] do
  227.     repeat
  228.       x:=320;
  229.       y:=MaxY div 2;
  230.       nx:=random(200); ny:=200-nx;
  231.       if nx>ny then maxn:=nx else maxn:=ny;
  232.       mx:=0; my:=0;
  233.       j:=random(10);
  234.       if random(2)=0 then dx:=2 else dx:=-2;
  235.       if random(2)=0 then dy:=2 else dy:=-2;
  236.       col:=random(15)+1;
  237.       x:=((x + (nx * dx * j) div 10) shl 1) shr 1;
  238.       y:=((y + (ny * dy * j) div 10) shl 1) shr 1;
  239.       bf:=(y div VertSize)*_ScreenWidth*2 + ((x shr 3) shl 1);
  240.     until (bf < lScreen) and (bf >= 0);
  241. end;
  242.  
  243.  
  244. procedure DelStar(i:integer);
  245. begin
  246.   Stars^[i].col:=0;
  247.   pScreen^[Stars^[i].bf]:=$20;
  248. end;
  249.  
  250.  
  251. procedure SetVertSize;
  252. begin
  253.  asm
  254.    MOV     AH,$11
  255.    MOV     AL,$30
  256.    MOV     BH,0
  257.    MOV     CX,$FFFF
  258.    MOV     DL,$FF
  259.    INT     $10
  260.    mov     VertSize,cx
  261. end;
  262. end;
  263.  
  264. Function SaveScr: boolean;
  265. begin
  266.   SaveScr:=false;
  267.   lScreen:=_ScreenWidth*_ScreenHeight*2;
  268.   if MemAvail < lScreen+SizeOf(Stars_table)+16*16 then Exit;
  269.   if grMouse and grShow then begin HideGtMouse;showundersleep:=true;end;
  270.   GetMem(oldScreen,lScreen);
  271.   move(pScreen^,oldScreen^,lScreen);
  272.   SaveScr:=true;
  273. end;
  274.  
  275. procedure RestoreScr;
  276. begin
  277.   move(OldScreen^,pScreen^,lScreen);
  278.   FreeMem(OldScreen,lScreen);
  279.   if grMouse and ShowUnderSleep then begin ShowGtMouse;ShowUnderSleep:=false;end;
  280. end;
  281.  
  282.  
  283. {$F+}
  284. Procedure NewKBD(Flags, CSi, IPi, AXi, BXi,CXi, DXi, SIi, DIi, DSi, ESi, BPi: Word);interrupt;
  285. begin
  286.  lsTimer:=crTimer^;
  287.  AnyEvent:=true;
  288.  JumpToOldIsr(OldInt09);
  289. end;
  290. procedure testMouseRect;
  291. begin
  292.      if grMouse then
  293.      begin
  294.      if  ( SleeperLx<=_MouseWhere.X) and ( SleeperLy<=_MouseWhere.Y ) and ( SleeperRy>=_MouseWhere.Y)
  295.      and ( SleeperRx>=_MouseWhere.X ) then begin if not XYEvent then begin anyEvent:=false;XYEvent:=true;end;end
  296.      else begin XYEvent:=false;anyEvent:=true;end;
  297.       MickyToXY;
  298.       _MouseWhere:=grMouseWhere;
  299.      end;
  300.      if crTimer^ - lsTimer >dlTimer then begin AnyEvent:=false;end;
  301. end;
  302. procedure DarkScreen;
  303. var
  304.   i,j,k : integer;
  305. begin
  306.    if not SaveScr then Exit;
  307.    if DisplayType in [ega,vga] then SetVertSize
  308.    else VertSize:=0;
  309.    new(Stars);
  310.    GetVector($09,OldInt09);
  311.    SetVector($09,addr(NewKBD));
  312.    for i:=0 to lScreen div 2 do pScreen^[i*2+1]:=0;
  313.    if VertSize>0 then
  314.      begin
  315.        MaxY:=_ScreenHeight*VertSize;
  316.        ChangeSymbols;
  317.        for i:=1 to MAX_STARS do begin Stars^[i].col:=0;Stars^[i].bf:=0;end;
  318.        NewStar;
  319.        prTimer:=crTimer^;
  320.        EndDark:=false;
  321.        TimeDelay:=SleepSpeed;
  322.        while not AnyEvent do
  323.        begin
  324.          while prTimer=crTimer^ do;
  325.          testMouseRect;
  326.          prTimer:=crTimer^;
  327.          Dec(TimeDelay);
  328.          if TimeDelay=0 then begin NewStar; TimeDelay:=SleepSpeed; end;
  329.          for i:=1 to MAX_STARS do
  330.           if Stars^[i].col <> 0 then
  331.            with Stars^[i] do
  332.            begin
  333.              mx:=mx+nx;
  334.              if mx>=maxn then begin x:=x+dx; mx:=mx-maxn; end;
  335.              my:=my+ny;
  336.              if my>=maxn then begin y:=y+dy; my:=my-maxn; end;
  337.              if (x<=0) or (x>=640) or (y<=0) or (y>=MaxY)
  338.                then DelStar(i)
  339.                else
  340.                begin
  341.                  j:=(y div VertSize)*_ScreenWidth*2 + ((x shr 3) shl 1);
  342.                  pScreen^[bf]:=$20;
  343.                  k:=(((y mod VertSize) shr 1) shl 2) + ((x and $07) shr 1)+224;
  344.                  pScreen^[j]:=k;
  345.                  pScreen^[j+1]:=col;
  346.                  bf:=j;
  347.                end;
  348.            end;
  349.        end;
  350.        for i:=0 to lScreen div 2 do pScreen^[i*2+1]:=0;
  351.        RestoreFontDark;
  352.        RestoreScr;
  353.        dispose(Stars);
  354.      end
  355.    else
  356.      begin
  357.        repeat
  358.        until not AnyEvent;
  359.        RestoreScr;
  360.      end;
  361.    setVector($09,OldInt09);
  362. end;
  363.  
  364.  
  365. Procedure DoneSleeper;
  366. var ofset,i : word;
  367. begin
  368.   SetVector($09,OldInt09);
  369.   SleeperOff:=false;
  370.   RestoreFont;
  371.   RestoreScr;
  372.   ShowGtMouse;
  373. end;
  374.  
  375.  
  376. procedure Sleep;
  377.  
  378. var
  379. i,xy : word;
  380. ichar,attr : byte;
  381.  
  382. PROCEDURE Galaxy;
  383. var i : integer;
  384. begin
  385.   olTimer:=crTimer^;
  386.   for i:=0 to _ScreenWidth*_ScreenHeight-1 do
  387.   begin
  388.    ichar:=mem[SegB800 : i*2];
  389.    if ichar<32 then
  390.       if (mem[SegB800 : i*2+1] AND $0F)>7 then
  391.       begin
  392.         inc(ichar);
  393.         if ichar>7 then
  394.         begin
  395.           ichar:=6;
  396.           mem[SegB800:i*2]:=ichar;
  397.           mem[SegB800:i*2+1]:=mem[SegB800:i*2+1] AND $f7;
  398.         end
  399.         else mem[SegB800:i*2]:=ichar;
  400.       end
  401.       else
  402.       begin
  403.         dec(ichar);
  404.         if ichar<1 then
  405.         begin
  406.           mem[SegB800:i*2+1]:=0;
  407.           mem[SegB800:i*2]:=32;
  408.           repeat
  409.             xy:=random(_ScreenWidth*_ScreenHeight);
  410.           until mem[SegB800 : xy*2]=32;
  411.           ichar:=1;
  412.           attr:=Random(8)+8;
  413.           mem[SegB800:xy*2+1]:=attr;
  414.           mem[SegB800:xy*2]:=ichar;
  415.         end
  416.         else mem[SegB800:i*2]:=ichar;
  417.      end;
  418.   end;
  419. end;
  420.  
  421. begin
  422.  HideGtMouse;
  423.  LScreen:=_ScreenHeight*_ScreenWidth*2;
  424.  IF not SleeperOff then
  425.  begin
  426.    if not SaveScr then Exit;
  427.    savefont;
  428.    setfont;
  429.    Randomize;
  430.    GetVector($09,OldInt09);
  431.    SetVector($09,addr(NewKBD));
  432.    SleeperOff:=true;
  433.    for i:=0 to LScreen div 2 do begin mem[SegB800:i*2]:=32;mem[SegB800:i*2+1]:=0;end;
  434.    for i:=1 to 10 do
  435.        begin
  436.          xy:=Random(_ScreenWidth*_ScreenHeight);
  437.          ichar:=Random(7)+1;
  438.          attr:=Random(16);
  439.          mem[SegB800:xy*2+1]:=attr;
  440.          mem[SegB800:xy*2]:=ichar;
  441.        end;
  442.    end;
  443.    repeat
  444.      testMouseRect;
  445.      if (olTimer<>crTimer^) and (crTimer^ mod 4 = 0) then gALAXY;
  446.    until AnyEvent;
  447.    doneSleeper;
  448. end;
  449.  
  450. Procedure Sleeper;
  451. begin
  452.   if SleepOn then
  453.   begin
  454.    if  ( SleeperLx<=_MouseWhere.X) and ( SleeperLy<=_MouseWhere.Y ) and ( SleeperRy>=_MouseWhere.Y)
  455.    and ( SleeperRx>=_MouseWhere.X ) then begin if not XYEvent then begin anyEvent:=false;XYEvent:=true;end;end
  456.    else begin XYEvent:=false;anyEvent:=true;end;
  457.    if crTimer^ - lsTimer >dlTimer then begin AnyEvent:=false;end;
  458.    if not AnyEvent then
  459.    begin
  460.     if SleepType=4 then DarkScreen
  461.     else Sleep;
  462.    end;
  463.   end;
  464. end;
  465.  
  466. procedure InitSleeper(SType,TimeDelay, LeftUpX, LeftUpY, RightDnX, RightDnY : integer);
  467.  
  468. begin
  469.   SleeperLx := LeftUpX-1;
  470.   SleeperLy := LeftUpY-1;
  471.   SleeperRx := RightDnX-1;
  472.   SleeperRy := RightDnY-1;
  473.   dlTimer:=TimeDelay*18;
  474.   SleepOn:=true;
  475.   SleepType:=SType;
  476. end;
  477.  
  478. begin
  479.  pScreen:=ptr(SegB800,0);
  480.  new(pChSave);
  481.  InitSleeper(4,30,80,1,80,1);
  482. end.
  483.