home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 11 / ldm / graffiti.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-05  |  14.8 KB  |  434 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    GRAFFITI.PAS                        *)
  3. (*     Blockgrafiken (nicht nur) für Turbo-Editoren       *)
  4. (*           (c) 1990 O. Großklaus & TOOLBOX              *)
  5. (* ------------------------------------------------------ *)
  6. {$M 4096,0,655360} { Heap wird durch TSR-Unit plattgemacht }
  7. {$R-                 No RangeCheck    }
  8. {$S-                 No StackCheck    }
  9. {$D-                 No Debug Info    }
  10. {$B-                 Boolean complete }
  11. PROGRAM Graffiti;
  12.  
  13. USES
  14.   Dos,                                 { Standard DOS-Unit }
  15.   Crt,                                 { Standard CRT-Unit }
  16.   txTsr;  { angepaßte TSR-Unit, ausgehend von toolbox 5'90 }
  17.  
  18. CONST
  19.   GrashID  = 1;                              { Kennung     }
  20.   ZmitALT  = ' Zeichnen mit <Alt>+JKIM';     { Aktivierung }
  21.   LogoSize = 16;                             { Logogröße   }
  22.  
  23.   Logo     : ARRAY [1..LogoSize] OF STRING [54] = (
  24. ('╔════════════════════════════════════════════════════╗'),
  25. ('║                     GRAFFITI                       ║'),
  26. ('║  Zeichnen von Blockgrafiken mit "Cursorbewegungen" ║'),
  27. ('║    ┌─────────────────────────────────────────┐     ║'),
  28. ('║    │ <Alt>+<T> schaltet zwischen │ und ║ um. │     ║'),
  29. ('║    └───────╥─────────────────────────╥───────┘     ║'),
  30. ('║            ║'     +ZmitALT+        ' ║             ║'),
  31. ('║            ╚═════════════════════════╝             ║'),
  32. ('╠═════════ A C H T U N G - A C H T U N G ! ══════════╣'),
  33. ('║ - Nur für Turbo- und kompatible Editoren.          ║'),
  34. ('║ - Vor Gebrauch Platz schaffen (Leerzeile/Text).    ║'),
  35. ('║ - Will ein Zeichen nicht passen, nicht verzweifeln.║'),
  36. ('║   Dieses Zeichen gibt es dann wirklich nicht...    ║'),
  37. ('║ - Immer schön im 25-Zeilen-Modus bleiben!          ║'),
  38. ('║ - Keine "harten" Tabulatoren im Text!              ║'),
  39. ('╚════════════════════════════════════════════════════╝'));
  40.  
  41.   Single                 = 1;
  42.   Double                 = 2;
  43.   All                    = 0;
  44.   DrawMode     : BOOLEAN = TRUE;
  45.   DoubleMode   : BOOLEAN = FALSE;
  46.   LeftRight              = TRUE;
  47.   UpDown                 = FALSE;
  48.   CLeft                  = 75;
  49.   Cup                    = 72;
  50.   CDown                  = 80;
  51.   InsertToggle : WORD    = 82;
  52.   HotKeyLeft   : WORD    = $2400;                { ALT - J }
  53.   HotKeyRight  : WORD    = $2500;                { ALT - K }
  54.   HotKeyUp     : WORD    = $1700;                { ALT - I }
  55.   HotKeyDown   : WORD    = $3200;                { ALT - M }
  56.   HotKeyToggle : WORD    = $1400;                { ALT - T }
  57.  
  58. VAR
  59.   Direct       : BOOLEAN;      { Richtung LeftRight/UpDown }
  60.   I            : BYTE;
  61.   Ok           : BOOLEAN;      { Installation ok ?         }
  62.  
  63.   (* ---------------------------------------------------- *)
  64.   (* Cursorbewegungen auf dem Bildschirm, nicht im Editor *)
  65.  
  66.   PROCEDURE CMoveRight;
  67.   BEGIN
  68.     GotoXY(WhereX+1, WhereY);
  69.   END;
  70.  
  71.   PROCEDURE CMoveLeft;
  72.   BEGIN
  73.     GotoXY(WhereX-1, WhereY);
  74.   END;
  75.  
  76.   PROCEDURE CMoveUp;
  77.   BEGIN
  78.     GotoXY(WhereX, WhereY-1);
  79.   END;
  80.  
  81.   PROCEDURE CMoveDown;
  82.   BEGIN
  83.     GotoXY(WhereX, WhereY+1);
  84.   END;
  85.  
  86.   PROCEDURE Beep;
  87.   BEGIN
  88.     Sound(7000);  Delay(1);  NoSound;
  89.   END;
  90.  
  91.   FUNCTION CPosOk : BOOLEAN; (* Cursorposition überprüfen *)
  92.   VAR
  93.     Xp, Yp : BYTE;
  94.   BEGIN
  95.     Xp     := WhereX;
  96.     Yp     := WhereY;
  97.     CPosOk := ((Xp > 1) AND (Xp < 80) AND
  98.                (Yp > 1) AND (Yp <25 ));
  99.   END;
  100.  
  101.   FUNCTION GetScrnChar : CHAR;
  102.   VAR
  103.     Regs : Registers;
  104.   BEGIN
  105.     Regs.ah := 08;
  106.     Regs.bh := 0;
  107.     Intr($10, Regs);
  108.     GetScrnChar := CHAR(Regs.al);
  109.   END;
  110.  
  111.   PROCEDURE PutChar(ch : CHAR; First : BOOLEAN);
  112.   VAR
  113.     Regs : Registers;
  114.   BEGIN
  115.     IF First THEN
  116.       IF DrawMode = DoubleMode THEN
  117.            IF Direct = UpDown THEN ch := '║'        { #186 }
  118.                               ELSE ch := '═'        { #205 }
  119.       ELSE IF Direct = UpDown THEN ch := '│'        { #179 }
  120.                               ELSE ch := '─';       { #196 }
  121.     Regs.ah := $0A;
  122.     Regs.al := Ord(ch);
  123.     Regs.bh := 00;
  124.     Regs.cx := 01;
  125.     Intr($10, Regs);
  126.   END;
  127.  
  128.   PROCEDURE CharBuffer(ch : CHAR);
  129.   VAR
  130.     Regs : Registers;
  131.   BEGIN
  132.     Regs.ah := 05;
  133.     Regs.cl := Ord(ch);
  134.     Regs.ch := 00;
  135.     Intr($16, Regs);
  136.   END;
  137.  
  138.   PROCEDURE MoveC(C : BYTE);
  139.   VAR
  140.     Regs : Registers;
  141.   BEGIN
  142.     Regs.ah := 05;
  143.     Regs.cl := 0;
  144.     Regs.ch := C;
  145.     Intr($16, Regs);
  146.   END;
  147.  
  148.   PROCEDURE RepLast;
  149.   (* letzte Cursorposition reparieren *)
  150.   CONST
  151.     LeftSingleNipple  : SET OF CHAR =
  152.       ['┤','╢','╖','╜','┐','┴','┬','─','┼','╨','╥','╫','┘'];
  153.     LeftDoubleNipple  : SET OF CHAR =
  154.       ['╡','╕','╣','╗','╝','╛','╩','╦','═','╬','╧','╤','╪'];
  155.     RightSingleNipple : SET OF CHAR =
  156.       ['└','┴','┬','├','─','┼','╟','╨','╥','╙','╓','╫','┌'];
  157.     RightDoubleNipple : SET OF CHAR =
  158.       ['╞','╚','╔','╩','╦','═','╬','╧','╤','╘','╒','╪','╠'];
  159.     UpSingleNipple    : SET OF CHAR =
  160.       ['│','┤','╡','╛','└','┴','├','┼','╞','╧','╘','╪','┘'];
  161.     UpDoubleNipple    : SET OF CHAR =
  162.       ['╢','╣','║','╜','╟','╚','╩','╠','╬','╨','╙','╫','╝'];
  163.     DownSingleNipple  : SET OF CHAR =
  164.       ['│','┤','╡','╕','┐','┬','├','┼','╞','╤','╒','╪','┌'];
  165.     DownDoubleNipple  : SET OF CHAR =
  166.       ['╢','╖','╣','║','╗','╟','╔','╦','╠','╬','╥','╓','╫'];
  167.  
  168.     (* Zuordnungstabelle *)
  169.    Tabelle : ARRAY [0..256] OF CHAR = ( ' ',
  170.      {   1   2   3   4   5   6   7   8   9   10}
  171.         ' ',' ','└',' ','│','┌','├',' ','┘','─',        {00}
  172.         '┴','┐','┤','┬','┼',' ',' ','╙',' ',' ',        {10}
  173.         ' ',' ',' ','╜',' ','╨',' ',' ',' ',' ',        {20}
  174.         ' ',' ','╘',' ',' ','╒','╞',' ',' ',' ',        {30}
  175.         ' ',' ',' ',' ',' ',' ',' ','╚',' ',' ',        {40}
  176.         ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',        {50}
  177.         ' ',' ',' ',' ',' ','╓',' ',' ',' ',' ',        {60}
  178.         ' ','╖',' ','╥',' ',' ',' ',' ',' ','║',        {70}
  179.         ' ','╟',' ',' ',' ',' ',' ','╢',' ','╫',        {80}
  180.         ' ',' ',' ',' ',' ','╔',' ',' ',' ',' ',        {90}
  181.         ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',       {100}
  182.         ' ','╠',' ',' ',' ',' ',' ',' ',' ',' ',       {110}
  183.         ' ',' ',' ',' ',' ',' ',' ',' ','╛',' ',       {120}
  184.         ' ','╕','╡',' ',' ',' ',' ',' ',' ',' ',       {130}
  185.         ' ',' ',' ','╝',' ',' ',' ',' ',' ',' ',       {140}
  186.         ' ',' ',' ',' ',' ',' ',' ',' ',' ','═',       {150}
  187.         '╧',' ',' ','╤','╪',' ',' ',' ',' ',' ',       {160}
  188.         ' ',' ',' ',' ',' ','╩',' ',' ',' ',' ',       {170}
  189.         ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',       {180}
  190.         ' ','╗',' ',' ',' ',' ',' ',' ',' ',' ',       {190}
  191.         ' ',' ',' ',' ',' ',' ',' ','╣',' ',' ',       {200}
  192.         ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',       {210}
  193.         ' ',' ',' ','╦',' ',' ',' ',' ',' ',' ',       {220}
  194.         ' ',' ',' ',' ',' ',' ',' ',' ',' ','╬',       {230}
  195.         ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',       {240}
  196.         ' ',' ',' ',' ',' ',' ');                      {250}
  197.   VAR
  198.     Lc,                                  { linkes Zeichen  }
  199.     Rc,                                  { rechtes Zeichen }
  200.     Uc,                                  { oberes Zeichen  }
  201.     Dc            : CHAR;                { unteres Zeichen }
  202.     AktLeftNipple,                       { linker Nippel   }
  203.     AktRightNipple,                      { rechter Nippel  }
  204.     AktUpNipple,                         { oberer Nippel   }
  205.     AktDownNipple : BYTE;                { unterer Nippel  }
  206.     X, Y          : BYTE;                { Screenposition  }
  207.  
  208.     FUNCTION GetChar(X, Y : BYTE) : CHAR;
  209.     VAR
  210.       OldX, OldY : BYTE;
  211.     BEGIN
  212.       OldX := WhereX;            { Alte Position speichern }
  213.       OldY := WhereY;
  214.       GotoXY(X,Y);               { x, y einstellen         }
  215.       GetChar := GetScrnChar;    { Zeichen lesen           }
  216.       GotoXY(OldX, OldY);        { wieder zurückgehen      }
  217.    END;
  218.  
  219.    {┌─────────────────────────────────────────────────────┐}
  220.    {│Aktuelles Zeichen ermitteln:                         │}
  221.    {│                                                     │}
  222.    {│ Single       Double                                 │}
  223.    {│┌──┬──┬──┬──╥──┬──┬──┬──┐                            │}
  224.    {││ 1│ 2│ 4│ 8║10│20│40│80│HEX BYTE                    │}
  225.    {│└─┬┴─┬┴─┬┴─┬╨─┬┴─┬┴─┬┴─┬┘                            │}
  226.    {│  │  │  │  │  │  │  │  └─ Nippel links               │}
  227.    {│  │  │  │  │  │  │  └──── Nippel unten               │}
  228.    {│  │  │  │  │  │  └─────── Nippel rechts              │}
  229.    {│  │  │  │  │  └────────── Nippel hoch                │}
  230.    {│  │  │  │  └───────────── Nippel links               │}
  231.    {│  │  │  └──────────────── Nippel unten               │}
  232.    {│  │  └─────────────────── Nippel rechts              │}
  233.    {│  └────────────────────── Nippel hoch                │}
  234.    {│                                                     │}
  235.    {└─────────────────────────────────────────────────────┘}
  236.  
  237.    PROCEDURE GetAktChar(ModeGet : BYTE);
  238.    BEGIN
  239.      AktLeftNipple  := 0;
  240.      AktRightNipple := 0;
  241.      AktUpNipple    := 0;
  242.      AktDownNipple  := 0;
  243.      IF ((ModeGet = All) OR (ModeGet = Single)) THEN BEGIN
  244.        IF Lc IN RightSingleNipple THEN AktLeftNipple  := 8;
  245.        IF Rc IN LeftSingleNipple  THEN AktRightNipple := 2;
  246.        IF Uc IN DownSingleNipple  THEN AktUpNipple    := 1;
  247.        IF Dc IN UpSingleNipple    THEN AktDownNipple  := 4;
  248.      END;
  249.      IF ((ModeGet = All) OR (ModeGet = Double)) THEN BEGIN
  250.        IF Lc IN RightDoubleNipple THEN AktLeftNipple := 128;
  251.        IF Rc IN LeftDoubleNipple  THEN AktRightNipple := 32;
  252.        IF Uc IN DownDoubleNipple  THEN AktUpNipple    := 16;
  253.        IF Dc IN UpDoubleNipple    THEN AktDownNipple  := 64;
  254.      END;
  255.    END;
  256.  
  257.    FUNCTION CalcChar : CHAR;         (* Zeichen ermitteln *)
  258.    VAR
  259.      Dummy : CHAR;
  260.    BEGIN
  261.      Lc := GetChar(X-1, Y);            { Umgebung einlesen }
  262.      Rc := GetChar(X+1, Y);            { Umgebung einlesen }
  263.      Uc := GetChar(X, Y-1);            { Umgebung einlesen }
  264.      Dc := GetChar(X, Y+1);            { Umgebung einlesen }
  265.      IF DrawMode = DoubleMode THEN     { Default setzen    }
  266.  
  267.        IF Direct = UpDown THEN CalcChar := '║'      { #186 }
  268.                           ELSE CalcChar := '═'      { #205 }
  269.      ELSE
  270.        IF Direct = UpDown THEN CalcChar := '│'      { #176 }
  271.                           ELSE CalcChar := '─';     { #197 }
  272.  
  273.      GetAktChar(All);        { Aktuelles Zeichen ermitteln }
  274.      Dummy := Tabelle[AktLeftNipple + AktRightNipple +
  275.                       AktUpNipple   + AktDownNipple];
  276.  
  277.      IF Dummy = ' ' THEN BEGIN
  278.        IF DrawMode = DoubleMode THEN GetAktChar(Double)
  279.                                 ELSE GetAktChar(Single);
  280.        Dummy := Tabelle[AktLeftNipple + AktRightNipple +
  281.                         AktUpNipple   + AktDownNipple];
  282.      END;
  283.      IF Dummy <> ' ' THEN
  284.        CalcChar := Dummy;               { Zeichen gefunden }
  285.    END;
  286.  
  287.   BEGIN
  288.     X := WhereX;
  289.     Y := WhereY;
  290.     PutChar(CalcChar, FALSE);
  291.   END;
  292.  
  293.   FUNCTION BufferEmpty : BOOLEAN;
  294.   VAR
  295.     Head : WORD ABSOLUTE $0:$41A;  { Tastaturpuffer Anfang }
  296.     Tail : WORD ABSOLUTE $0:$41C;  { Tastaturbuffer Ende   }
  297.   BEGIN
  298.     BufferEmpty := (Head = Tail);  { Leer : Anfang = Ende  }
  299.   END;
  300.  
  301.   FUNCTION EditorIsInInsert : BOOLEAN;
  302.   (* Editor in OVERWRITE schalten  (nur für Turbo Pascal! *)
  303.   VAR
  304.     Zeile      : STRING [6];
  305.     Mode       : BYTE ABSOLUTE $40:$49;
  306.     ScreenBase : WORD;
  307.     i          : BYTE;
  308.   BEGIN
  309.     IF Mode = 7 THEN ScreenBase := $B000
  310.                 ELSE ScreenBase := $B800;
  311.     Zeile[0] := #6;
  312.     FOR i := 0 TO 5 DO
  313.       Zeile[i+1] := CHAR(Ptr(ScreenBase, $D2+i*2)^);
  314.  
  315.     IF Zeile = '══════' THEN    { Turbo-Fenster mit Rahmen }
  316.       FOR i := 0 TO 5 DO
  317.         Zeile[i+1] := CHAR(Ptr(ScreenBase, $174+i*2)^);
  318.     EditorIsInInsert := (Zeile = 'Insert');
  319.   END;
  320.  
  321. {$F+}
  322.   PROCEDURE PopupLeft;
  323.   (* HotKey-Entry *)
  324.   BEGIN
  325.     IF EditorIsInInsert THEN MoveC(InsertToggle);
  326.     IF NOT BufferEmpty  THEN Exit;
  327.     IF NOT CPosOk       THEN
  328.       Beep
  329.     ELSE BEGIN
  330.       Direct := LeftRight;
  331.       CMoveLeft;  PutChar(' ', TRUE);  CMoveRight;
  332.       RepLast;
  333.       CharBuffer(GetScrnChar);
  334.       CMoveLeft;  MoveC(CLeft);  MoveC(CLeft);
  335.       RepLast;
  336.       CharBuffer(GetScrnChar);
  337.       MoveC(CLeft);
  338.     END;
  339.   END;
  340.  
  341.   PROCEDURE PopupRight;
  342.   BEGIN
  343.     IF EditorIsInInsert THEN MoveC(InsertToggle);
  344.     IF NOT BufferEmpty  THEN Exit;
  345.     IF NOT CPosOk       THEN
  346.       Beep
  347.     ELSE BEGIN
  348.       Direct := LeftRight;
  349.       CMoveRight;  PutChar(' ', TRUE);  CMoveLeft;
  350.       RepLast;
  351.       CharBuffer(GetScrnChar);
  352.       CMoveRight;
  353.       RepLast;
  354.       CharBuffer(GetScrnChar);
  355.       MoveC(CLeft);
  356.     END;
  357.   END;
  358.  
  359.   PROCEDURE PopupDown;
  360.   BEGIN
  361.     IF EditorIsInInsert THEN MoveC(InsertToggle);
  362.     IF NOT BufferEmpty  THEN Exit;
  363.     IF NOT CPosOk       THEN
  364.       Beep
  365.     ELSE BEGIN
  366.       Direct := UpDown;
  367.       CMoveDown;  PutChar(' ', TRUE); CMoveUp;
  368.       RepLast;
  369.       CharBuffer(GetScrnChar);
  370.       MoveC(CLeft);  MoveC(CDown); CMoveDown;
  371.       RepLast;
  372.       CharBuffer(GetScrnChar);  MoveC(CLeft);
  373.     END;
  374.   END;
  375.  
  376.   PROCEDURE PopupUp;
  377.   BEGIN
  378.     IF EditorIsInInsert THEN MoveC(InsertToggle);
  379.     IF NOT BufferEmpty  THEN Exit;
  380.     IF NOT CPosOk       THEN
  381.       Beep
  382.     ELSE BEGIN
  383.       Direct := UpDown;
  384.       CMoveUp;  PutChar(' ', TRUE);  CMoveDown;
  385.       RepLast;
  386.       CharBuffer(GetScrnChar);
  387.       MoveC(CLeft);  MoveC(Cup);  CMoveUp;
  388.       RepLast;
  389.       CharBuffer(GetScrnChar); MoveC(CLeft);
  390.     END;
  391.   END;
  392.  
  393.   PROCEDURE ToggleDraw;
  394.   BEGIN
  395.     DrawMode := NOT DrawMode;
  396.   END;
  397. {$F-}
  398.  
  399. BEGIN
  400.   Ok := TRUE;
  401.   IF ParamCount = 0 THEN BEGIN
  402.     ClrScr;
  403.     TextBackground(Red);
  404.     FOR I := 1 TO LogoSize DO BEGIN
  405.       Write('             ');                  { 13 Blanks }
  406.       Write(Logo[I]);
  407.       WriteLn('            ');                 { 13 Blanks }
  408.     END;
  409.     TextBackground(Black);
  410.   END;
  411.   IF AlreadyLoaded(GrashID) THEN
  412.     WriteLn('Bereits geladen')
  413.   ELSE BEGIN                       { Hotkey-Routinen inst. }
  414.  
  415.     Ok := Ok AND PopUpInstalled(@ToggleDraw,
  416.                                  HotKeyToggle, 0, 1);
  417.     Ok := Ok AND PopUpInstalled(@PopupLeft,
  418.                                  HotkeyLeft,   0, 2);
  419.     Ok := Ok AND PopUpInstalled(@PopupRight,
  420.                                  HotkeyRight,  0, 3);
  421.     Ok := Ok AND PopUpInstalled(@PopupUp,
  422.                                  HotkeyUp,     0, 4);
  423.     Ok := Ok AND PopUpInstalled(@PopupDown,
  424.                                  HotkeyDown,   0, 5);
  425.     IF Ok THEN
  426.       MakeResident(GrashID)
  427.     ELSE
  428.       WriteLn('Fehler: Konnte nicht installiert werden');
  429.   END;
  430. END.
  431. (* ------------------------------------------------------ *)
  432. (*                 Ende von GRAFFITI.PAS                  *)
  433.  
  434.