home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 05 / trickbox / interpre.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-03  |  10.5 KB  |  279 lines
  1. UNIT Interpreter;
  2. (* (c) 1991 Ralf Hensmann & toolbox *)
  3.  
  4.  
  5. (**************************************************************************)
  6. (*                  Interpreter der TOOLBOX-Trickbox                      *)
  7. (*                                                                        *)
  8. (* Aufgabe: Interpretierung von Tastaturzeichen auf dem Schirm.           *)
  9. (*                                                                        *)
  10. (* Alle Zeichen werden als druckbar angesehen und auf dem Bildschirm aus- *)
  11. (* gegeben. Steuerzeichen werden als Steuercode interpretiert.            *)
  12. (* Steuercodes:                                                           *)
  13. (*                                                                        *)
  14. (* A..P :    Vordergrundfarbe setzen (0..15)                              *)
  15. (* a..p :    Hintergrundfarbe setzen (0..15)                              *)
  16. (* <>   :    Cursor links bzw. rechts                                     *)
  17. (* ^_   :    Cursor oben bzw. unten                                       *)
  18. (* -    :    Umschalten in den Line-Modus (Einfache Linie)                *)
  19. (* =    :    Umschalten in den Line-Modus (Doppelte Linie)                *)
  20. (* ?    :    Umschalten in den Line-Modus (keine Linienänderung)          *)
  21. (* /    :    Ausschalten des Linienmodus                                  *)
  22. (* U    :    Rubber-Mode                                                  *)
  23. (* #    :    Ein/Ausschalten des Einfügemodus                             *)
  24. (* !    :    Umschalten auf hellen/blinkenden Hintergrund                 *)
  25. (* X,Y  :    Zeilen einfügen/löschen                                      *)
  26. (* R    :    Return des Editors                                           *)
  27. (* W    :    Warte-Befehl (3*normales Warten)                             *)
  28. (* Z    :    Löscht den Bildschirm                                        *)
  29. (* {}   :    HOME, END                                                    *)
  30. (* ()   :    PgUp,PgDown                                                  *)
  31. (* []   :    Ctrl-Pfeiltasten                                             *)
  32. (* $&   :    Del, BS                                                      *)
  33. (*                                                                        *)
  34. (* Im Linienmodus sind nur die Befehle /,<,>,^ und _ erlaubt !            *)
  35. (*                                                                        *)
  36. (**************************************************************************)
  37.  
  38. INTERFACE
  39.  
  40. (**************************************************************************)
  41. (*                                                                        *)
  42. (*                            Import                                      *)
  43. (*                                                                        *)
  44. (* ScreenLow: TScreen            - Schirmtyp (80*25 Zeichen)              *)
  45. (*            PScreen            - Zeiger auf Schirmtyp                   *)
  46. (*            Screen             - Zeiger auf den Textbildschirm          *)
  47. (*            InsChar(ch)        - fügt Zeichen an Cursorposition ein.    *)
  48. (*            NewLine(i,i,i,i,b) - Neue Linie von nach, doppelt ?         *)
  49. (*            InsCr              - Editor-CR (Einfügemodus)               *)
  50. (*            SetHighBack(b)     - Setzt Hintergrund hell/blinkend        *)
  51. (*                                                                        *)
  52. (**************************************************************************)
  53. USES ScreenLow,Crt;
  54.  
  55. TYPE TStatus = RECORD                (* wird nur wegen DISPOSE exportiert *)
  56.                  Ins       : BOOLEAN;
  57.                  Line      : BOOLEAN;
  58.                  Double    : BOOLEAN;
  59.                  Rubber    : BOOLEAN;
  60.                  HighBack  : BOOLEAN;
  61.                  Ctrl      : BOOLEAN;
  62.                  LastX,
  63.                  LastY     : BYTE;
  64.                  Wait      : REAL;
  65.                  TCol,BCol : BYTE;
  66.                  Schirm    : TScreen;
  67.                END;
  68.      PStatus = ^TStatus;
  69.  
  70. VAR  PrintState : BOOLEAN; (* Gibt an, ob Print... erfolgreich war *)
  71.  
  72. PROCEDURE InitScreen;
  73.   (* Initialisiert den Schirm *)
  74.  
  75. FUNCTION SaveState(CtrlMode : BOOLEAN) : PStatus;
  76.   (* Sichert Status der Operation *)
  77.  
  78. PROCEDURE RestoreState(State : PStatus; VAR CtrlMode : BOOLEAN);
  79.   (* Stellt den gespeicherten Status wieder her. *)
  80.  
  81. PROCEDURE PrintChar(CH : CHAR; Time : BOOLEAN);
  82.   (* Druckt ein Zeichen an der Stelle aus und korrigiert die Zeile *)
  83.  
  84. PROCEDURE PrintCode(CH : CHAR; Time : BOOLEAN);
  85.   (* Gibt den Code aus *)
  86.  
  87. PROCEDURE WriteStatusLine(Pos : INTEGER);
  88.   (* Gibt die Statuszeile aus *)
  89.  
  90. IMPLEMENTATION
  91.  
  92. VAR Ins       : BOOLEAN; (* Insert-Modus an ?            *)
  93.     Line      : BOOLEAN; (* Line-Modus an ?              *)
  94.     Double    : BOOLEAN; (* Doppel-Linienmode ?          *)
  95.     Rubber    : BOOLEAN;
  96.     HighBack  : BOOLEAN; (* Background hell/blinkend     *)
  97.     Wait      : REAL;    (* Verzögerungszeit             *)
  98.     TCol,BCol : BYTE;    (* Vorder- und Hintergrundfarbe *)
  99.  
  100. PROCEDURE TextBackground(Color : BYTE);
  101. BEGIN
  102.   TextAttr := TextAttr AND $F + (Color AND $F) SHL 4;
  103. END;
  104.  
  105. PROCEDURE TextColor(Color : BYTE);
  106. BEGIN
  107.   TextAttr := TextAttr AND $F0 + (Color AND $F);
  108. END;
  109.  
  110. PROCEDURE WriteStatusLine(Pos : INTEGER);
  111. TYPE  BoolSt = ARRAY [FALSE..TRUE] OF STRING[8];
  112. CONST InsertSt : BoolSt = ('<Ovr>   ','<Ins>   ');
  113.       LineSt   : BoolSt = ('        ','Line    ');
  114.       DoubleSt : BoolSt = ('        ',' ╠╬╣    ');
  115.       RubberSt : BoolSt = ('        ','<Rub>   ');
  116.       HighBSt  : BoolSt = ('<Blk>   ','<Hgh>   ');
  117. VAR x,y : INTEGER;
  118. BEGIN
  119.   x := WhereX; y := WhereY;
  120.   GotoXY(1,25);
  121.   Write('':79);
  122.   GotoXY(1,25);
  123.   Write('(',x:2,' /',y:2,')    ',InsertSt[Ins],LineSt[Line],DoubleSt[Double],
  124.         RubberSt[Rubber],HighBSt[HighBack],'  ',Wait:6:2);
  125. END;
  126.  
  127. FUNCTION SaveState(CtrlMode : BOOLEAN) : PStatus;
  128. VAR p : PStatus;
  129. BEGIN
  130.   New(p);
  131.   p^.Ins    := Ins;        p^.Line     := Line;
  132.   p^.Double := Double;     p^.Schirm   := Screen^;
  133.   p^.Wait   := Wait;       p^.TCol     := TCol;
  134.   p^.BCol   := BCol;       p^.HighBack := HighBack;
  135.   SaveState := p;          p^.Ctrl     := CtrlMode;
  136.   p^.LastX  := WhereX;     p^.LastY    := WhereY;
  137.   p^.Rubber := Rubber;
  138. END;
  139.  
  140. PROCEDURE RestoreState(State : PStatus; VAR CtrlMode : BOOLEAN);
  141. BEGIN
  142.   Ins    := State^.Ins;    Line     := State^.Line;
  143.   Double := State^.Double; Wait     := State^.Wait;
  144.   Screen^:= State^.Schirm; TCol     := State^.TCol;
  145.   BCol   := State^.BCol;   HighBack := State^.HighBack;
  146.   SetHighBack(HighBack);   CtrlMode := State^.Ctrl;
  147.   Rubber := State^.Rubber;
  148.   Cursor(Line);
  149.   TextColor(TCol);
  150.   TextBackground(BCol);
  151.   GotoXY(State^.LastX,State^.LastY);
  152. END;
  153.  
  154. PROCEDURE InitScreen;
  155. BEGIN
  156.   TextColor(LightGray);    TCol     := LightGray;
  157.   TextBackground(Black);   BCol     := Black;
  158.   Ins    := FALSE;         Line     := FALSE;
  159.   Double := FALSE;         Wait     := 30;
  160.   SetHighBack(FALSE);      HighBack := FALSE;
  161.   Rubber := FALSE;
  162.   ClrScr;
  163.   GotoXY(1,1);
  164. END; (* InitScreen *)
  165.  
  166. PROCEDURE PrintChar(CH : CHAR; Time : BOOLEAN);
  167. BEGIN
  168.   IF Line THEN
  169.     PrintState := FALSE
  170.   ELSE BEGIN
  171.     PrintState := TRUE;
  172.     IF Ins THEN InsChar(CH) ELSE Write(CH);
  173.     IF Time AND (Wait >= 1.0) THEN Delay(Trunc(Wait));
  174.   END;
  175. END; (* PrintChar *)
  176.  
  177. PROCEDURE PrintCode(CH : CHAR; Time : BOOLEAN);
  178. VAR x,y,hx,hy : INTEGER;
  179. BEGIN
  180.   IF Time AND (Wait >= 1.0) AND (CH IN ['<','>','^','_','{','}','X','+','Y','R','Z','(',')','[',']','$','&']) THEN
  181.     Delay(Trunc(Wait));
  182.   x := WhereX; y := WhereY;
  183.   IF Line THEN BEGIN
  184.  
  185.     hx := x; hy := y;
  186.     CASE CH OF
  187.       '<'      : IF x=1  THEN x := 80 ELSE Dec(x);
  188.       '>'      : IF x=80 THEN x := 1  ELSE Inc(x);
  189.       '^'      : IF y=1  THEN y := 25 ELSE Dec(y);
  190.       '_'      : IF y=25 THEN y := 1  ELSE Inc(y);
  191.       '-'      : BEGIN Double := FALSE; Rubber := FALSE END;
  192.       '='      : BEGIN Double := TRUE;  Rubber := FALSE END;
  193.       'U'      : Rubber := TRUE;
  194.       '?'      : Rubber := FALSE;
  195.       '/'      : BEGIN
  196.                    Line:=FALSE;
  197.                    Cursor(FALSE);
  198.                    PrintState := TRUE;
  199.                    Exit;
  200.                  END;
  201.     ELSE BEGIN
  202.       PrintState := FALSE;
  203.       Exit;
  204.     END; END;
  205.     NewLine(hx,hy,x,y,Double,Rubber,TCol);
  206.     GotoXY(x,y);
  207.     PrintState := TRUE;
  208.  
  209.   END ELSE BEGIN
  210.  
  211.     PrintState := TRUE;
  212.  
  213.     CASE CH OF
  214.       'A'..'P' : BEGIN
  215.                    TCol := Ord(CH) - Ord('A');
  216.                    TextColor(TCol);
  217.                  END;
  218.       'a'..'p' : BEGIN
  219.                    BCol := Ord(CH) - Ord('a');
  220.                    TextBackground(BCol);
  221.                  END;
  222.       '<'      : IF x=1  THEN x := 80 ELSE Dec(x);
  223.       '>'      : IF x=80 THEN x := 1  ELSE Inc(x);
  224.       '^'      : IF y=1  THEN y := 25 ELSE Dec(y);
  225.       '_'      : IF y=25 THEN y := 1  ELSE Inc(y);
  226.       '{'      : x := 1;
  227.       '}'      : x := 80;
  228.       '-'      : BEGIN
  229.                    Line   := TRUE;
  230.                    Double := FALSE;
  231.                    Rubber := FALSE;
  232.                    Cursor(TRUE);
  233.                  END;
  234.       '='      : BEGIN
  235.                    Line   := TRUE;
  236.                    Double := TRUE;
  237.                    Rubber := FALSE;
  238.                    Cursor(TRUE);
  239.                  END;
  240.       '?'      : BEGIN
  241.                    Line   := TRUE;
  242.                    Rubber := FALSE;
  243.                    Cursor(TRUE);
  244.                  END;
  245.       '!'      : BEGIN
  246.                    HighBack := NOT HighBack;
  247.                    SetHighBack(HighBack);
  248.                  END;
  249.       '#'      : Ins := NOT Ins;
  250.       'X'      : InsLine;
  251.       '+'      : DoubleLine;
  252.       'Y'      : DelLine;
  253.       'R'      : IF Ins THEN InsCr
  254.             ELSE WriteLn;
  255.       'W'      : IF Time THEN Delay(Trunc(5*Wait));
  256.       'Z'      : ClrScr;
  257.       '('      : y := 1;
  258.       ')'      : y := 25;
  259.       '['      : Advance(-1);
  260.       ']'      : Advance(+1);
  261.       '*'      : IF Wait > 0.00009 THEN Wait := Wait / 1.1 ELSE Wait := 0.00009;
  262.       '~'      : IF Wait < 1000  THEN Wait := Wait * 1.1 ELSE Wait := 1000;
  263.       '$'      : DelCh;
  264.       '&'      : IF x > 1 THEN BEGIN
  265.                    Dec(x);
  266.            GotoXY(x,y);
  267.                    DelCh;
  268.                  END;
  269.     ELSE (* CASE *)
  270.       PrintState := FALSE;
  271.     END; (* CASE *)
  272.     IF CH IN ['<','>','^','_','{','}','(',')','&'] THEN
  273.       GotoXY(x,y);
  274.   END; (* ELSE *)
  275. END; (* PrintCode *)
  276.  
  277. END.
  278.  
  279.