home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 17 / ascii.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-01-29  |  11.3 KB  |  335 lines
  1. (* ------------------------------------------------------ *)
  2. (*                       ASCII.PAS                        *)
  3. (*            Speicherresidente ASCII-Tabelle             *)
  4. (*    Benutzung von Extended/Expanded Memory in TSR's     *)
  5. (*           Turbo Pascal Versionen 4.0 und 5.x           *)
  6. (*    Copyright (c) 1989  Karsten Gieselmann & TOOLBOX    *)
  7. (* ------------------------------------------------------ *)
  8.  
  9. PROGRAM Ascii;
  10.  
  11. {B-,I-,R-,S-,V-}              (* keine Laufzeitprüfungen! *)
  12. {$M 1024, 0, 0}                (* wenig Stack, kein Heap! *)
  13.  
  14. {.$DEFINE UseEMS} (* welcher Speicher soll benutzt werden? *)
  15. {.$DEFINE UseXMS}
  16. {.$DEFINE UseHMA}
  17. {$DEFINE UseRAM}
  18.  
  19. USES                                   (* benutzte Module *)
  20.   {$IFDEF UseEMS} EMS, {$ENDIF}
  21.   {$IFDEF UseXMS} XMS, {$ENDIF}
  22.   {$IFDEF UseHMA} XMS, {$ENDIF}
  23.                   DOS, Utility;
  24.  
  25. CONST                        (* Farbattribut für....      *)
  26.   Normal  = $07;             (* ....normale Zeichen       *)
  27.   Bright  = $0F;             (* ....für Zeichencodes      *)
  28.   Select  = $DF;             (* ....das gewählte Zeichen  *)
  29.   Help    = $1F;             (* ....Kopf- und Fußzeile    *)
  30.   Frame   = $0F;             (* ....den Fensterrahmen     *)
  31.   ColSize =  35;             (* Ausdehnung des Fensters   *)
  32.   RowSize =  24;
  33.   XOfs    =  46;             (* linke oberen Fensterecke  *)
  34.   YOfs    =   1;
  35.  
  36.   Hotkey     = $7100;          (* Aufruftaste: <Alt><F10> *)
  37.   HotkeyName = '<Alt><F10>';
  38.  
  39. TYPE
  40.   Screen    = ARRAY[1..25,1..80] OF WORD;
  41.   Window    = ARRAY[1..RowSize, 1..ColSize] OF WORD;
  42.   ScreenPtr = ^Screen;
  43. VAR
  44.   KbdBuffer : STRING[3];            (* zur Datenübernahme *)
  45.   SaveInt16 : POINTER;
  46.   PopupSS, PopupSP : WORD;   (* Popup-Stapelkonfiguration *)
  47.  
  48. (* ------- vom Speichermedium abhängige Routinen -------- *)
  49.  
  50. {$IFDEF UseEMS} {$I ASCII.EMS} {$ENDIF}
  51. {$IFDEF UseXMS} {$I ASCII.XMS} {$ENDIF}
  52. {$IFDEF UseHMA} {$I ASCII.HMA} {$ENDIF}
  53. {$IFDEF UseRAM} {$I ASCII.RAM} {$ENDIF}
  54.  
  55. (* ----------------- Interrupt-Handling ----------------- *)
  56.  
  57. CONST
  58.   InUse : BOOLEAN = FALSE;      (* Interrupt schon aktiv? *)
  59.   Unloaded : BOOLEAN = FALSE;     (* TSR wieder entfernt? *)
  60.   RecallPopup : BOOLEAN = FALSE;     (* nochmal aufrufen? *)
  61. VAR
  62.   SaveSS, SaveSP : WORD;           (* Stapelkonfiguration *)
  63.  
  64. FUNCTION ReadKeyWord : WORD;
  65.   (* holt Tastencode von alter Interruptroutine           *)
  66. INLINE($31/$C0/$9C/$FF/$1E/SaveInt16);
  67.  
  68. PROCEDURE Popup; FORWARD;
  69.  
  70. PROCEDURE Int16(BP : WORD); INTERRUPT;
  71.   (* eigene Behandlungsroutine für den Tastatur-Interrupt *)
  72. TYPE
  73.   IntRegisters =          (* Registerbelegung beim Aufruf *)
  74.     RECORD CASE BYTE OF
  75.       1 : (BP,ES,DS,DI,SI,DX,CX,BX,AX,IP,CS,Flags : WORD);
  76.       2 : (Dummy : ARRAY[1..5] of WORD;
  77.                           DL,DH,CL,CH,BL,BH,AL,AH : BYTE);
  78.     END;
  79. VAR
  80.   Regs : IntRegisters ABSOLUTE BP;
  81.  
  82.   PROCEDURE Chain(Regs : IntRegisters; Address : POINTER);
  83.     (* setzt Interrupt-Ausführung bei "Address" fort.     *)
  84.   INLINE($5B/$58/$5E/$1F/$87/$5C/$0E/$87/$44/$10/$8B/
  85.          $54/$16/$52/$9D/$8C/$DA/$FA/$8E/$D2/$89/$F4/
  86.          $FB/$5D/$07/$1F/$5F/$5E/$5A/$59/$CB);
  87.  
  88.   PROCEDURE SwitchStack;
  89.     (* schaltet auf programmeigenen Stapel um.            *)
  90.   INLINE($FA/$8C/$16/SaveSS/$89/$26/SaveSP/
  91.              $8E/$16/PopupSS/$8B/$26/PopupSP/$FB);
  92.  
  93.   PROCEDURE RestoreStack;
  94.     (* schaltet auf ursprünglichen Stapel zurück.         *)
  95.   INLINE($FA/$8E/$16/SaveSS/$8B/$26/SaveSP);
  96.  
  97. BEGIN
  98.   WITH Regs DO BEGIN
  99.     IF (AH AND $EF = 1) AND (KbdBuffer <> '') THEN BEGIN
  100.       AX := Ord(KbdBuffer[1]);
  101.       Flags := Flags AND NOT FZero;
  102.     END ELSE IF (AH AND $EF = 1) AND RecallPopup THEN BEGIN
  103.       AX := Hotkey;
  104.       Flags := Flags AND NOT FZero;
  105.     END ELSE IF (AH AND $EF = 0) AND NOT InUse THEN BEGIN
  106.       REPEAT
  107.         IF KbdBuffer <> '' THEN BEGIN   (* noch Daten da? *)
  108.           AX := Ord(KbdBuffer[1]);
  109.           Delete(KbdBuffer, 1, 1);
  110.         END ELSE BEGIN
  111.           IF RecallPopup THEN BEGIN
  112.             AX := Hotkey;
  113.             RecallPopup := FALSE;
  114.           END ELSE BEGIN             (* sonst Taste holen *)
  115.             AX := ReadKeyWord;
  116.           END;
  117.           IF (AX = Hotkey) AND NOT Unloaded THEN BEGIN
  118.             InUse := TRUE;
  119.             SwitchStack;             (* Stapel umschalten *)
  120.             Popup;                    (* Pop-Up ausführen *)
  121.             RestoreStack;          (* Stapel restaurieren *)
  122.             InUse := FALSE;    (* Aufrufe wieder zulassen *)
  123.           END;
  124.         END;
  125.       UNTIL (AX <> Hotkey) OR Unloaded;
  126.       IF Unloaded THEN BEGIN       (* Vektor zurücksetzen *)
  127.         SetIntVec($16, SaveInt16);
  128.       END;
  129.     END ELSE BEGIN
  130.       Chain(Regs, SaveInt16); (* weiter mit alter Routine *)
  131.     END;
  132.   END;
  133. END;
  134.  
  135. (* ------------------- Pop-Up-Routine ------------------- *)
  136.  
  137. PROCEDURE Popup;
  138.   (* zeigt Ascii-Tabelle an, läßt einen Eintrag auswählen
  139.      und übernimmt das Zeichen bzw. den zugehörigen Code
  140.      in das gerade laufende Programm.                     *)
  141. CONST
  142.   Left    = #$CB;  Right   = #$CD;  Up     = #$C8;
  143.   Down    = #$D0;  Home    = #$C7;  End_   = #$CF;
  144.   PgUp    = #$C9;  PgDn    = #$D1;
  145.   Code    : BYTE = 196;            (* Blockgrafik-Zeichen *)
  146. VAR
  147.   Row, Col, Save : BYTE;
  148.   OctStr, DecStr, HexStr : STRING[3];
  149.   Command : CHAR;
  150.   CurrentPage : ScreenPtr;
  151.  
  152.   FUNCTION CurrentPageAddress : POINTER;
  153.     (* ermittelt die Adresse der aktuellen Videoseite.    *)
  154.   VAR
  155.     Regs : Registers;
  156.   BEGIN
  157.     Regs.AH := $0F;
  158.     Intr($10, Regs);
  159.     IF Regs.AL = 7 THEN BEGIN
  160.       CurrentPageAddress := Ptr($B000, Regs.BH*1000);
  161.     END ELSE BEGIN
  162.       CurrentPageAddress := Ptr($B800, Regs.BH*1000);
  163.     END;
  164.   END;
  165.  
  166.   FUNCTION GetKey : CHAR;
  167.     (* holt Tastencode; bei erweiterten Tasten (z.B. Funk-
  168.        tions- oder Cursortasten, erster Code ist Nullzei-
  169.        chen) wird das 8.Bit im Code gesetzt.              *)
  170.   VAR
  171.     Key : WORD;
  172.   BEGIN
  173.     Key := ReadKeyWord;
  174.     IF Lo(Key) = 0 THEN BEGIN        (* erweiterter Code? *)
  175.       GetKey := Chr(Hi(Key) or $80);
  176.     END ELSE BEGIN
  177.       GetKey := Chr(Lo(Key));
  178.     END;
  179.   END;
  180.  
  181. PROCEDURE Num2Str(Num, Base : BYTE; VAR St : STRING);
  182.   (* bewerkstelligt die Umwandlung des Codes in eine Zei-
  183.      chenkette; die Auslegung als Prozedur mit Ergebnis-
  184.      übergabe in einer VARiable spart Stapelspeicher ein. *)
  185. CONST
  186.   Digit : ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
  187. VAR
  188.   d : BYTE;
  189. BEGIN
  190.   St[0] := #3;
  191.   FOR d:=3 DOWNTO 1 DO BEGIN
  192.     St[d] := Digit[Num MOD Base];
  193.     Num := Num DIV Base;
  194.   END;
  195. END;
  196.  
  197. PROCEDURE Poke(Col, Row : BYTE; VAR St : STRING);
  198.   (* schreibt den aktuellen Zeichencode direkt in den
  199.      Bildschimspeicher; um Stack zu sparen, wird "St" als
  200.      Call-by-Reference-Parameter übergeben.               *)
  201. VAR
  202.   i, v : WORD;
  203. BEGIN
  204.   FOR i:=1 TO Length(St) DO BEGIN
  205.     v := Word(Bright)*256 + Ord(St[i]);
  206.     CurrentPage^[YOfs+Row, XOfs+Col+i] := v;
  207.   END;
  208. END;
  209.  
  210. PROCEDURE ReleaseRAM(Segment : WORD);
  211.   (* gibt den RAM-Speicherblock bei Segment:0 wieder frei *)
  212. VAR
  213.   Regs : Registers;
  214. BEGIN
  215.   Regs.AH := $49;
  216.   Regs.ES := Segment;
  217.   MsDos(Regs);
  218. END;
  219.  
  220. PROCEDURE UnInstall;
  221.   (* entfernt das Programm wieder aus dem Speicher.       *)
  222. VAR
  223.   CurrInt16 : POINTER;
  224. BEGIN
  225.   GetIntVec($16, CurrInt16);
  226.   IF CurrInt16 = @Int16 THEN BEGIN
  227.     Unloaded := TRUE;
  228.     DeallocateBuffers;
  229.     ReleaseRAM(MemW[PrefixSeg:$2C]);
  230.     ReleaseRAM(PrefixSeg);
  231.   END ELSE BEGIN
  232.     Write(^G);
  233.   END;
  234. END;
  235.  
  236. BEGIN
  237.   CurrentPage := CurrentPageAddress; (* Bildschirmadresse *)
  238.   SaveScreen(CurrentPage);              (* Inhalt sichern *)
  239.   DisplayAsciiTable(CurrentPage);     (* Tabelle anzeigen *)
  240.   Save := 0;
  241.   REPEAT                                     (* auswählen *)
  242.     Col := XOfs + (Code mod 16 + 1)*2;
  243.     Row := YOfs + (Code shr  4 + 3);
  244.     Num2Str(Code,  8, OctStr); Poke( 7, 20, OctStr);
  245.     Num2Str(Code, 10, DecStr); Poke(17, 20, DecStr);
  246.     Num2Str(Code, 16, HexStr); Poke(28, 20, HexStr);
  247.     CurrentPage^[Row,Col] := Word(Select)*256 + Code;
  248.     Save := Code;
  249.     Command := UpCase(GetKey);
  250.     CASE Command OF                     (* Cursor bewegen *)
  251.       Left  : Dec(Code);
  252.       Right : Inc(Code);
  253.       Up    : Dec(Code, 16);
  254.       Down  : Inc(Code, 16);
  255.       Home  : Code := (Code shr 4) shl 4;
  256.       End_  : Code := (Code shr 4) shl 4 + 15;
  257.       PgUp  : Code :=  Code mod 16;
  258.       PgDn  : Code :=  Code mod 16 + 240;
  259.       ^U    : { Hier noch nichts machen! };
  260.     END;
  261.     CurrentPage^[Row,Col] := Word(Normal)*256 + Save;
  262.   UNTIL Pos(Command, ^[^M^J^U^O^D^H'ODH') > 0;
  263.   RestoreScreen(CurrentPage);   (* alter Bildschirminhalt *)
  264.   CASE Command OF                      (* Daten übergeben *)
  265.      ^J, ^M : KbdBuffer := Chr(Code);
  266.      ^D, 'D': KbdBuffer := DecStr;
  267.      ^H, 'H': KbdBuffer := HexStr;
  268.      ^O, 'O': KbdBuffer := OctStr;
  269.      ^U     : UnInstall;
  270.   END;
  271.   RecallPopup := (Pos(Command, ^J^O^D^H) > 0);
  272. END;
  273.  
  274. (* ----------------- Installationsteil ------------------ *)
  275.  
  276. PROCEDURE SetupAsciiTable;
  277.   (* Aufbau der später anzuzeigenden Ascii-Tabelle.       *)
  278. CONST
  279.   UpperLeft  = #218;  Horizontal = #196; (* Rahmenzeichen *)
  280.   UpperRight = #191;  LowerLeft  = #192;
  281.   Vertical   = #179;  LowerRight = #217;
  282.   Header : String[33] = '     Anwahl mit Cursortasten     ';
  283.   Footer : String[33] = '   Return:Zeichen   O,D,H:Code   ';
  284.   Codes  : String[33] = '   Okt:      Dez:       Hex:     ';
  285. VAR
  286.   Row, Col : BYTE;                  (* Schleifenvariablen *)
  287. BEGIN
  288.   FOR Row:=3 TO RowSize-2 DO BEGIN     (* Inneres löschen *)
  289.     FOR Col:=2 TO ColSize-1 DO BEGIN
  290.       SetTable(Col, Row, Normal, ' ');
  291.     END;
  292.   END;
  293.   SetTable(      1,       1, Frame, UpperLeft); (* Rahmen *)
  294.   SetTable(ColSize,       1, Frame, UpperRight);
  295.   SetTable(      1, RowSize, Frame, LowerLeft);
  296.   SetTable(ColSize, RowSize, Frame, LowerRight);
  297.   FOR Col:=2 TO ColSize-1 DO BEGIN
  298.     SetTable(Col,         1, Frame, Horizontal);
  299.     SetTable(Col,   RowSize, Frame, Horizontal);
  300.     SetTable(Col,         2, Help,  Header[Col-1]);
  301.     SetTable(Col, RowSize-3, Normal,Codes[Col-1]);
  302.     SetTable(Col, RowSize-1, Help,  Footer[Col-1]);
  303.   END;
  304.   FOR Row:=2 TO RowSize-1 DO BEGIN
  305.     SetTable(     1, Row, Frame, Vertical);
  306.     SetTable(ColSize, Row, Frame, Vertical);
  307.   END;
  308.   FOR Row:=0 TO 15 DO BEGIN          (* Zeichen eintragen *)
  309.     FOR Col:=0 TO 15 DO BEGIN
  310.       SetTable(Col*2+3, Row+4, Normal, Chr(Row*16+Col));
  311.     END;
  312.   END;
  313. END;
  314.  
  315. BEGIN
  316.   StartUp('ASCII - Speicherresidente Ascii-Tabelle');
  317.   AllocateBuffers;          (* Speicherplatz organisieren *)
  318.   SetupAsciiTable;                    (* Tabelle aufbauen *)
  319.   PopupSS := SSeg;          (* Stapelkonfiguration merken *)
  320.   PopupSP := SPtr;
  321.   KbdBuffer := '';   (* Tastaturverwaltung initialisieren *)
  322.   GetIntVec($16, SaveInt16);      (* Int16-Vektor sichern *)
  323.   SetIntVec($16, @Int16);   (* eigenen Handler aktivieren *)
  324.   SetIntVec($00, SaveInt00);     (* Vektoren restaurieren *)
  325.   {$IFNDEF Ver40}
  326.     SetIntVec($3F, SaveInt3F);
  327.   {$ENDIF}
  328.   Write('Aufruf mit ', HotkeyName);
  329.   WriteLn(', Entfernen mit <Ctrl><U>.');
  330.   PrepareExit;
  331.   Keep(0);                             (* resident machen *)
  332. END.
  333. (* ------------------------------------------------------ *)
  334. (*                  Ende von ASCII.PAS                    *)
  335.