home *** CD-ROM | disk | FTP | other *** search
/ CD PowerPlay 6 / TheCompleteAdventureCollection1995 / CDPP6.ISO / utility / agtsrc / declare.pa4 < prev    next >
Encoding:
Text File  |  1989-12-20  |  9.4 KB  |  268 lines
  1.  
  2.   {DECLARE.PA2}
  3.  
  4.  
  5. { This utility will let you change the type (shape and visibility) of the
  6. cursor.  At the same time, it saves the previous type.
  7. For block cursor, set new:=  13   (Works on all machines.)
  8. For invisible cursor, set new:=8192 }
  9.   {Added by David Malmberg}
  10.  
  11.  
  12.   PROCEDURE ChangeCursor(NewSize : Integer; VAR OldSize : Integer);
  13.  
  14.   BEGIN
  15.     INLINE(
  16.       $31/$C0                     {       XOR   AX,AX            ;Set AX=0}
  17.       /$8E/$C0                    {       MOV   ES,AX            ;Set ES=0}
  18.       /$26/$A1/$60/$04            {       ES: MOV AX,WO[$0460]   ;Read old cursor type}
  19.       /$C4/$7E/<OldSize           {       LES   DI,[BP+<OldSize]     ;Set address for Old}
  20.       /$AB                        {       STOSW                  ;Store old value}
  21.       /$B4/$01                    {       MOV   AH,$01           ;}
  22.       /$8B/$4E/<NewSize           {       MOV   CX,[BP+<NewSize]     ;Get New value}
  23.       /$CD/$10                    {       INT   $10              ;Set cursor change}
  24.       );
  25.   END;
  26.  
  27.  
  28.  
  29.   FUNCTION DisplayMode : Byte;
  30.  
  31.   VAR Regs : registers;
  32.  
  33.   BEGIN
  34.     Regs.ah := $0F;
  35.     INTR($10, Dos.registers(Regs));
  36.     DisplayMode := Regs.al;
  37.   END;                            {DisplayMode}
  38.  
  39.  
  40.  
  41.   PROCEDURE reverse;
  42.  
  43.   BEGIN
  44.     IF DisplayMode = Mono
  45.     THEN BEGIN
  46.       TEXTCOLOR(BLACK);
  47.       TEXTBACKGROUND(LIGHTGRAY);
  48.     END
  49.     ELSE BEGIN                    {some kind of color capability}
  50.       TEXTCOLOR(ReverseTextColor);
  51.       TEXTBACKGROUND(ReverseTextBackground);
  52.     END;
  53.   END;                            {Reverse}
  54.  
  55.  
  56.  
  57.   PROCEDURE normal;
  58.  
  59.   BEGIN
  60.     IF DisplayMode = Mono
  61.     THEN BEGIN
  62.       TEXTCOLOR(LIGHTGRAY);
  63.       TEXTBACKGROUND(BLACK);
  64.     END
  65.     ELSE BEGIN                    {some kind of color capability}
  66.       TEXTCOLOR(NormalTextColor);
  67.       TEXTBACKGROUND(NormalTextBackground);
  68.     END;
  69.   END;                            {Normal}
  70.  
  71.  
  72.   PROCEDURE highlight;
  73.   BEGIN
  74.     IF DisplayMode = Mono
  75.     THEN BEGIN
  76.       TEXTCOLOR(WHITE);
  77.       TEXTBACKGROUND(BLACK);
  78.     END
  79.     ELSE BEGIN                    {some kind of color capability}
  80.       TEXTCOLOR(HighLightTextColor);
  81.       TEXTBACKGROUND(NormalTextBackground);
  82.     END;
  83.   END;
  84.  
  85.  
  86.  
  87.   PROCEDURE RestoreCursor;
  88.  
  89.  
  90.     PROCEDURE SetCursor(Starting, Ending : Byte);
  91.       {-Set the starting and ending scan lines for the cursor.}
  92.     BEGIN
  93.       INLINE(
  94.         $B4/$01                   {MOV AH,1}
  95.         /$8A/$6E/<Starting        {MOV CH,[BP+<Starting]}
  96.         /$8A/$4E/<Ending          {MOV CL,[BP+<Ending]}
  97.         /$55                      {PUSH BP}
  98.         /$CD/$10                  {INT $10}
  99.         /$5D                      {POP BP}
  100.  
  101.         );
  102.     END;
  103.  
  104.   BEGIN
  105.     IF DisplayMode = Mono THEN
  106.       SetCursor(11, 12)
  107.     ELSE
  108.       SetCursor(6, 7);
  109.   END;                            {RestoreCursor}
  110.  
  111.  
  112.   { Pause }
  113.   {Prompt the user and wait until}
  114.   {a RETURN key is pressed. }
  115.  
  116.   PROCEDURE Pause;
  117.  
  118.   BEGIN
  119.     WriteLn(IO, ' ');
  120.     highlight;
  121.     ChangeCursor(8192, Old_Cursor); {make cursor invisible}
  122.     Write(IO, '                    -- Hit <RETURN> to continue --');
  123.     ReadLn;
  124.     normal;
  125.     WriteLn(IO, ' ');
  126.   END;                            {pause}
  127.  
  128.  
  129.  
  130.   PROCEDURE EXPLAIN_Keys;
  131.     {exhibits diagram of special input key assignments}
  132.  
  133.   BEGIN
  134.     ChangeCursor(8192, Old_Cursor); {make cursor invisible}
  135.     WriteLn(IO, 'EXPLAIN KEYS');
  136.     WriteLn(IO, ' ');
  137.     WriteLn(IO, ' ');
  138.     WriteLn(IO, 'You may use a single key to enter many of the most common commands:');
  139.     WriteLn(IO, ' ');
  140.     WriteLn(IO, '        FUNCTION KEYS                        CURSOR KEYS');
  141.     WriteLn(IO, '    ┌─────────┬─────────┐     ┌─────────┬─────────┬─────────┬─────────┐');
  142.     WriteLn(IO, '    │    F1   │   F2    │     │  Home   │    ^    │  Pg Up  │    -    │');
  143.     WriteLn(IO, '    │   GET   │  DROP   │     │NORTHWEST│  NORTH  │NORTHEAST│   UP    │');
  144.     WriteLn(IO, '    ├─────────┼─────────┤     ├─────────┼─────────┼─────────┼─────────┤');
  145.     WriteLn(IO, '    │    F3   │   F4    │     │   <--   │         │   -->   │    +    │');
  146.     WriteLn(IO, '    │ EXAMINE │  READ   │     │   WEST  │         │   EAST  │  DOWN   │');
  147.     WriteLn(IO, '    ├─────────┼─────────┤     ├─────────┼─────────┼─────────┼─────────┘');
  148.     WriteLn(IO, '    │   F5    │   F6    │     │   End   │    v    │  Pg Dn  │');
  149.     WriteLn(IO, '    │  OPEN   │  CLOSE  │     │SOUTHWEST│  SOUTH  │SOUTHEAST│');
  150.     WriteLn(IO, '    ├─────────┼─────────┤     ├─────────┼─────────┼─────────┘');
  151.     WriteLn(IO, '    │   F7    │   F8    │     │   Ins   │   Del   │');
  152.     WriteLn(IO, '    │INVENTORY│  LOOK   │     │  ENTER  │  EXIT   │');
  153.     WriteLn(IO, '    ├─────────┼─────────┤     └─────────┴─────────┘');
  154.     WriteLn(IO, '    │   F9    │   F10   │');
  155.     WriteLn(IO, '    │  SCORE  │  HELP   │');
  156.     WriteLn(IO, '    └─────────┴─────────┘');
  157.     WriteLn(IO, ' ');
  158.     Pause;
  159.     Previous_room := 0;           {will print full room description}
  160.     ChangeCursor(13, Old_Cursor); {make cursor visible}
  161.   END;
  162.  
  163.  
  164.  
  165.   FUNCTION GetInputString : s;
  166.     {Gets adventure input sentences -- also inputs function and direction keys}
  167.  
  168.   VAR
  169.     Ch : Char;
  170.     Done : Boolean;
  171.     TempString : s;
  172.   BEGIN
  173.     TempString := '';             {to begin with}
  174.     Done := False;
  175.     ChangeCursor(13, Old_Cursor); {make cursor visible}
  176.     highlight;
  177.     REPEAT
  178.       IF KEYPRESSED
  179.       THEN BEGIN
  180.         Read(KBD, Ch);            {Read a character, if ESC (chr(27) then}
  181.         IF ((Ch = Chr(27)) AND OK_To_Display_Keys)
  182.         THEN BEGIN                {keystroke must be either ESC key or one}
  183.           {that generates a two-digit code}
  184.           Read(KBD, Ch);
  185.           TempString := '';       {default case for function keys}
  186.           CASE Ch OF
  187.             'H' {Up arrow} : TempString := 'NORTH';
  188.             'P' {Down arrow} : TempString := 'SOUTH';
  189.             'K' {Left arrow} : TempString := 'WEST';
  190.             'M' {Right arrow} : TempString := 'EAST';
  191.             'G' {Home} : TempString := 'NORTHWEST';
  192.             'O' {End} : TempString := 'SOUTHWEST';
  193.             'I' {PgUp} : TempString := 'NORTHEAST';
  194.             'Q' {PgDn} : TempString := 'SOUTHEAST';
  195.             'R' {INS key} : TempString := 'ENTER';
  196.             'S' {DEL key} : TempString := 'EXIT';
  197.             ';' {F1} : TempString := 'GET ';
  198.  
  199.             '<' {F2 Key} : TempString := 'DROP ';
  200.             '=' {F3 Key} : TempString := 'EXAMINE ';
  201.             '>' {F4 Key} : TempString := 'READ ';
  202.             '?' {F5 Key} : TempString := 'OPEN ';
  203.             '@' {F6 Key} : TempString := 'CLOSE ';
  204.             'A' {F7 Key} : TempString := 'INVENTORY';
  205.             'B' {F8 Key} : TempString := 'LOOK';
  206.             'C' {F9 Key} : TempString := 'SCORE';
  207.             'D' {F10 Key} : TempString := 'HELP';
  208.           END;                    {Case}
  209.           IF TempString <> ''
  210.           THEN BEGIN
  211.             Done := True;
  212.             IF POS(' ', TempString) = 0
  213.             THEN WriteLn(IO, TempString) {with CR}
  214.             ELSE BEGIN            {GET or EXAMINE or READ}
  215.               Write(IO, TempString); {without CR}
  216.               Done := False;
  217.             END;
  218.           END;
  219.         END                       {Special Key}
  220.         ELSE                      {normal key}
  221.           CASE Ch OF
  222.             '?' {Display special keys} : BEGIN
  223.                                            EXPLAIN_Keys;
  224.                                            TempString := 'LOOK';
  225.                                            Done := True;
  226.                                          END;
  227.             '-' {minus sign} : IF Length(TempString) = 0
  228.                                THEN BEGIN
  229.                                  TempString := 'UP';
  230.                                  WriteLn(IO, TempString); {with CR}
  231.                                  Done := True;
  232.                                END
  233.                                ELSE BEGIN
  234.                                  Write(IO, Ch); {echo on screen}
  235.                                  TempString := TempString+Ch;
  236.                                END;
  237.             '+' {plus sign} : BEGIN
  238.                                 TempString := 'DOWN';
  239.                                 WriteLn(IO, TempString); {with CR}
  240.                                 Done := True;
  241.                               END;
  242.             ^H {backspace} : BEGIN
  243.                                IF Length(TempString) > 0
  244.                                THEN BEGIN
  245.                                  Delete(TempString, Length(TempString), 1);
  246.                                  Write(IO, Chr(8), ' ', Chr(8));
  247.                                END;
  248.                              END;
  249.           ELSE                    {for Case}
  250.             BEGIN                 {default -- for normal keys}
  251.               IF DoingUpperCase THEN Ch := Upcase(Ch); {Capitalize input}
  252.               Write(IO, Ch);      {echo on screen}
  253.               IF Ch <> Chr(13)
  254.               THEN TempString := TempString+Upcase(Ch)
  255.               ELSE BEGIN
  256.                 Done := True;
  257.                 WriteLn(IO, ' ');
  258.               END;
  259.             END;                  {ELSE of case}
  260.           END;                    {Case}
  261.       END;                        {IF keypressed}
  262.     UNTIL Done;
  263.     GetInputString := TempString;
  264.     ChangeCursor(8192, Old_Cursor); {make cursor invisible}
  265.     normal;
  266.   END;                            {of GetInputString}
  267.  
  268.