home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 08_09 / copycurs.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-17  |  7.4 KB  |  255 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   COPYCURS.PAS                         *)
  3. (*         Speicherresidente Copy-Cursor-Funktion         *)
  4. (* (c) 1988  Karsten Gieselmann  &  PASCAL International  *)
  5. (* ------------------------------------------------------ *)
  6.  
  7. {$R-,S-,I-,V-,B-,N-}    (* größtmögliche Geschwindigkeit! *)
  8. {$M 1024,0,0}                  (* wenig Stack, kein Heap! *)
  9.  
  10. PROGRAM CopyCursor;
  11.  
  12. USES
  13.   Crt, Dos;                            (* benötigte Units *)
  14.  
  15. CONST
  16.   Version    = 'COPYCURS v1.0';
  17.   Hotkey     = $7100;                (* Aktivierungstaste *)
  18.   CopyKey    = $4400;        (* Einfügetaste, hier: <F10> *)
  19.   Escape     = $011B;
  20.   Return     = $1C0D;
  21.   HotkeyName = '<Alt><F10>';         (* Aktivierungstaste *)
  22.   MaxCol     = 80;                   (* Bildschirmausmaße *)
  23.   MaxRow     = 25;
  24.  
  25. TYPE
  26.   ScreenType = ARRAY [1..MaxRow, 1..MaxCol] of WORD;
  27.  
  28. VAR
  29.   Screen         : ^ScreenType;     (* Bildschirmspeicher *)
  30.   SaveInt16      : POINTER;
  31.   SaveSS,SaveSP,                (* Speicher für Stacktops *)
  32.   ProgSS,ProgSP,
  33.   VideoSegment,         (* Basissegment des Bildspeichers *)
  34.   Ch             : WORD;
  35.   Active,                            (* Schaltervariablen *)
  36.   CopyMode       : BOOLEAN;
  37.  
  38. (* --- einen Tastencode von der alten Int16-ISR holen --- *)
  39.  
  40. FUNCTION GetKey : WORD;
  41.   INLINE ($31/$C0/$9C/$FF/$1E/SaveInt16);
  42.  
  43. (* ----------- die Copy-Cursor-Routine ------------------ *)
  44.  
  45. PROCEDURE GetCopyCursorChar (VAR Key : WORD);
  46.  
  47. TYPE
  48.   Direction = (_Left, _Right, _Up, _Down,
  49.                _Home, _End, _Top, _Bottom);
  50. VAR
  51.   Quit,Moved : BOOLEAN;
  52.   Col,Row    : BYTE;
  53.   Command    : WORD;
  54.   PageOffset : WORD ABSOLUTE $0040:$004E;
  55.  
  56. PROCEDURE ReverseAttribute;
  57.              (* invertiert das Farbattribut bei (Col,Row) *)
  58.  
  59. VAR VideoWord : RECORD CASE BYTE OF
  60.                  1: (v   : WORD);
  61.                  2: (c,a : BYTE);
  62.                END;
  63. BEGIN
  64.   WITH VideoWord DO BEGIN
  65.     v := Screen^[Row,Col];
  66.     a := (a MOD 16)*16 + a SHR 4;
  67.     Screen^[Row,Col] := v
  68.   END
  69. END;
  70.  
  71.  
  72. PROCEDURE MoveCopyCursor (d : Direction);
  73.  
  74. BEGIN
  75.   Moved := TRUE;
  76.   ReverseAttribute;
  77.   CASE d OF
  78.     _Left:    IF Col > 1 THEN
  79.                 Dec(Col)
  80.               ELSE IF Row > 1 THEN BEGIN
  81.                 Col:=80; Dec(Row);
  82.               END;
  83.     _Right:   IF Col < 80 THEN
  84.                 Inc (Col)
  85.               ELSE IF Row < 25 THEN BEGIN
  86.                 Col:=1; Inc(Row);
  87.               END;
  88.     _Up:      IF Row > 1 THEN
  89.                 Dec (Row)
  90.               ELSE
  91.                 Row:=25;
  92.     _Down:    IF Row < 25 THEN
  93.                 Inc (Row)
  94.               ELSE
  95.                 Row:=1;
  96.     _Home:    Col:= 1;
  97.     _End:     Col:=80;
  98.     _Top:     Row:= 1;
  99.     _Bottom:  Row:=25;
  100.   END;
  101.   ReverseAttribute;
  102. END;
  103.  
  104.  
  105. PROCEDURE InitCopyCursor;
  106.  
  107. VAR
  108.   Regs : Registers;
  109.  
  110. BEGIN
  111.   CopyMode := TRUE;
  112.   Moved := FALSE;
  113.   WITH Regs DO BEGIN
  114.     AH := $0F;
  115.     Intr ($10, Regs);            (* Bildschirmmodus holen *)
  116.     IF AL = 7 THEN
  117.       VideoSegment := $B000       (* Monochrome, Hercules *)
  118.     ELSE
  119.       VideoSegment := $B800;                (* Farbgrafik *)
  120.     Screen := Ptr (VideoSegment + PageOffset SHR 4, 0);
  121.     AH := $03;
  122.     Intr ($10, Regs);             (* Cursorposition holen *)
  123.     Col := Succ (DL);
  124.     Row := Succ (DH);
  125.   END;
  126.   ReverseAttribute;
  127. END;
  128.  
  129.  
  130. BEGIN
  131.   IF NOT CopyMode THEN   (* Copy-Cursor noch nicht aktiv? *)
  132.     InitCopyCursor;    (* dann erst einmal initialisieren *)
  133.   Quit := FALSE;
  134.   REPEAT
  135.     Command := GetKey;
  136.     IF NOT Moved THEN BEGIN
  137.       Moved := Hi(Command) IN [$47,$48,$49,$4B,
  138.                                $4D,$4F,$50,$51];
  139.       IF NOT Moved THEN
  140.         Command := Escape
  141.                   (* erste Taste muß Copy-Cursor bewegen! *)
  142.       END;
  143.     CASE Command OF
  144.       $4B00:   MoveCopyCursor (_Left);
  145.       $4D00:   MoveCopyCursor (_Right);
  146.       $4800:   MoveCopyCursor (_Up);
  147.       $5000:   MoveCopyCursor (_Down);
  148.       $4700:   MoveCopyCursor (_Home);
  149.       $4F00:   MoveCopyCursor (_End);
  150.       $4900:   MoveCopyCursor (_Top);
  151.       $5100:   MoveCopyCursor (_Bottom);
  152.       CopyKey: BEGIN      (* Bildschirm-Zeichen übergeben *)
  153.                  Key := Lo(Screen^[Row,Col]);
  154.                  MoveCopyCursor (_Right);
  155.                  Quit := TRUE;
  156.                END;
  157.                 (* Copy-Cursor vorübergehend deaktivieren *)
  158.       Hotkey:  BEGIN
  159.  
  160.                  Key := GetKey;
  161.                  Active := FALSE;
  162.                  Quit := TRUE;
  163.                END;
  164.                         (* Copy-Cursor-Funktion verlassen *)
  165.       Return,
  166.       Escape:  BEGIN
  167.                  ReverseAttribute;
  168.                  IF Command = Return THEN
  169.                    Key := Return
  170.                         (* Ende, das <Return> zurückgeben *)
  171.                  ELSE
  172.                    Key := GetKey;
  173.                         (* Ende, auf weitere Taste warten *)
  174.                  IF Key <> Hotkey THEN BEGIN
  175.                    Active := FALSE;
  176.                    CopyMode := FALSE;
  177.                    Quit := TRUE;
  178.                    END
  179.                  ELSE
  180.                   (* Taste war Hotkey, doch weiter machen *)
  181.                    InitCopyCursor;
  182.                END;
  183.                              (* gedrückte Taste übergeben *)
  184.       ELSE     BEGIN
  185.                  Key := Command;
  186.                  Quit := TRUE
  187.                END;
  188.       END;
  189.   UNTIL Quit;
  190. END;
  191.  
  192.  
  193. (* --- die neue ISR für den Tastatur-Interrupt 16h ------ *)
  194.  
  195. {$F+}
  196.  
  197. PROCEDURE Int16 (Flags,CS,IP,AX,BX,CX,DX,SI,
  198.                  DI,DS,ES,BP : WORD); INTERRUPT;
  199.  
  200. PROCEDURE ChainInt (Address : POINTER);
  201.                           (* Sprung zur ISR bei "Address" *)
  202.   INLINE ($5B/$58/$87/$5E/$0E/$87/$46/$10/$89/
  203.           $EC/$5D/$07/$1F/$5F/$5E/$5A/$59/$CB);
  204.  
  205. PROCEDURE SwitchStack;
  206.                     (* auf den Programm-Stapel umschalten *)
  207.   INLINE ($8C/$16/SaveSS/$89/$26/SaveSP/$FA/
  208.           $8E/$16/ProgSS/$8B/$26/ProgSP/$FB);
  209.  
  210. PROCEDURE SwitchBack;
  211.                      (* vom Programmstapel zurückschalten *)
  212.   INLINE ($FA/$8E/$16/SaveSS/$8B/$26/SaveSP/$FB);
  213.  
  214. BEGIN
  215.   IF Hi(AX) = 0 THEN BEGIN
  216.                         (* soll Tastencode geholt werden? *)
  217.     IF not Active THEN BEGIN
  218.       AX := GetKey;
  219.       Active := (AX = Hotkey);
  220.                                (* Copy-Cursor aktivieren? *)
  221.     END;
  222.     IF Active THEN BEGIN
  223.       SwitchStack;
  224.       GetCopyCursorChar (Ch);
  225.       SwitchBack;
  226.       AX := Ch
  227.              (* Übergabe erst nach Stapel-Rückschaltung!! *)
  228.     END
  229.   END ELSE
  230.     ChainInt (SaveInt16)
  231.          (* keinen Tastencode holen, weiter mit alter ISR *)
  232. END;
  233.  
  234. {$F-}
  235.  
  236.  
  237. (* --- der Installationsteil von COPYCURS --------------- *)
  238.  
  239. BEGIN
  240.   ProgSS := SSeg;     (* Werte für Programm-Stapel merken *)
  241.   ProgSP := SPtr;
  242.   WriteLn (^M^J, Version, ' installiert,',
  243.            ^M^J'aktivieren mit ', HotKeyName, '.');
  244.   Active := FALSE;             (* Schalter initialisieren *)
  245.   CopyMode := FALSE;
  246.                           (* alten Int16-Vektor merken... *)
  247.   GetIntVec ($16, SaveInt16);
  248.                         (* ...eigene Routine einsetzen... *)
  249.   SetIntVec ($16, @Int16);
  250.                        (* ...Break-Vektor zurücksetzen... *)
  251.   SetIntVec ($1B, SaveInt1B);
  252.   Keep (0);                    (* ...und resident machen! *)
  253. END.
  254. (* ------------------------------------------------------ *)
  255. (*              Ende von COPYCURS.PAS                     *)