home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / apollo / apoterm.pas < prev   
Pascal/Delphi Source File  |  2020-01-01  |  7KB  |  231 lines
  1. PROGRAM DIRECT_EXAMPLE;
  2.  
  3. %INCLUDE '/SYS/INS/BASE.INS.PAS';
  4. %INCLUDE '/SYS/INS/GPR.INS.PAS';
  5. %INCLUDE '/SYS/INS/KBD.INS.PAS';
  6. %INCLUDE '/SYS/INS/PAD.INS.PAS';
  7. %INCLUDE '/SYS/INS/ERROR.INS.PAS';
  8.  
  9. CONST
  10.    LF = CHR(10);
  11.    CR = CHR(13);
  12.    SP = CHR(32);
  13.  
  14.    FOREVER = FALSE;
  15.  
  16. VAR
  17.    event        : GPR_$EVENT_T;
  18.    status       : STATUS_$T;
  19.    cur_position : GPR_$POSITION_T;
  20.    event_type   : GPR_$EVENT_T;
  21.    ch           : CHAR;
  22.    i            : INTEGER;
  23.    timeout      : TIME_$CLOCK_T;
  24.    disp_bm_size : GPR_$OFFSET_T;
  25.    init_bitmap  : GPR_$BITMAP_DESC_T;
  26.    unobscured   : BOOLEAN;
  27.    fwidth       : INTEGER;
  28.    fhite        : INTEGER;
  29.    fname        : PAD_$STRING_T;
  30.    fnsize       : INTEGER;
  31.    fnlen        : INTEGER;
  32.    fid          : INTEGER;
  33.    start        : GPR_$OFFSET_T;
  34.    xend         : INTEGER;
  35.    window       : PAD_$WINDOW_DESC_T;
  36.    stream_out   : STREAM_$ID_T;
  37.    stream_in    : STREAM_$ID_T;
  38.    cur_origin   : GPR_$POSITION_T;
  39.  
  40. (* The following procedure will scroll the terminal emulator screen by one    *)
  41. (* full line.                                                                 *)
  42.  
  43. PROCEDURE scroll;
  44.  
  45.    VAR
  46.      bitmap_desc   : GPR_$BITMAP_DESC_T;
  47.  
  48.      source_window : GPR_$WINDOW_T;
  49.      source_plane  : GPR_$PLANE_T;
  50.      dest_origin   : GPR_$POSITION_T;
  51.      dest_plane    : GPR_$PLANE_T;
  52.      status        : STATUS_$T;
  53.  
  54.    BEGIN
  55.    GPR_$INQ_BITMAP(bitmap_desc, status);
  56.    GPR_$SET_BITMAP(bitmap_desc, status);
  57.  
  58.    WITH source_window DO
  59.       BEGIN
  60.       WITH window_base DO
  61.          BEGIN
  62.          x_coord := 0;
  63.          y_coord := fhite+7;
  64.          END;
  65.       WITH window_size DO
  66.          BEGIN
  67.          x_size := 80*fwidth;
  68.          y_size := 25*fhite;
  69.          END;
  70.       END;
  71.    source_plane := 0;
  72.    WITH dest_origin DO
  73.       BEGIN
  74.       x_coord := 0;
  75.       y_coord := 7;
  76.       END;
  77.    dest_plane := 0;
  78.  
  79.    GPR_$PIXEL_BLT(bitmap_desc, source_window, dest_origin, status);
  80.    END; (* of scroll *)
  81.  
  82. BEGIN
  83.    { initialize specifying direct mode }
  84.    stream_out := STREAM_$ERROUT;
  85.    stream_in := STREAM_$ERRIN;
  86.  
  87.    fwidth := 11;
  88.    fhite := 23;
  89.  
  90.    disp_bm_size.x_size := 1024;
  91.    disp_bm_size.y_size := 1024;
  92.    GPR_$INIT(GPR_$BORROW, 1, disp_bm_size, 0, init_bitmap, status);
  93.    IF status.all <> STATUS_$OK
  94.       THEN
  95.          BEGIN
  96.          WRITELN('Unable to initialize graphics mode.');
  97.          ERROR_$PRINT(status);
  98.          END;
  99.  
  100.    { set up text font that will be used in direct window }
  101.  
  102.    GPR_$LOAD_FONT_FILE('/SYS/DM/FONTS/F9X15', 19, fid, status);
  103.    GPR_$SET_TEXT_FONT(fid, status);
  104.  
  105.    { set time-out to 5 seconds }
  106.  
  107.    timeout.low32 := 5*250000;
  108.    timeout.high16 := 0;
  109.    GPR_$SET_ACQ_TIME_OUT(timeout, status);
  110.  
  111.    { enable keystroke event and characters from 0 to 127 which includes all    }
  112.    { keys                                                                      }
  113.  
  114.    GPR_$ENABLE_INPUT(GPR_$KEYSTROKE, [chr(0) .. chr(127),
  115.                                       KBD_$CR, KBD_$LEFT_ARROW,
  116.                                       KBD_$RIGHT_ARROW, KBD_$UP_ARROW,
  117.                                       KBD_$DOWN_ARROW, KBD_$BS], status);
  118.    cur_position.x_coord := 0;
  119.    cur_position.y_coord := fhite-1;
  120.    cur_origin.x_coord := 0;
  121.    cur_origin.y_coord := 8;
  122.    GPR_$SET_CURSOR_ORIGIN(cur_origin, status);
  123.    GPR_$SET_CURSOR_POSITION(cur_position, status);
  124.    GPR_$SET_CURSOR_ACTIVE(TRUE, status);
  125.  
  126.    REPEAT
  127.       { call event wait and wait for a keystrokee event, char, and cursor pos }
  128.  
  129.       unobscured := GPR_$EVENT_WAIT(event, ch, cur_position, status);
  130.  
  131.       { print char at present cursor position and then move the cursor to the  }
  132.       { next position                                                          }
  133.  
  134.       IF event = GPR_$KEYSTROKE
  135.          THEN
  136.             BEGIN
  137.             IF ORD(ch) = 3 THEN EXIT;
  138.             GPR_$SET_CURSOR_ACTIVE(FALSE, status);
  139.  
  140.             { determine width of character from font, and move the cursor by   }
  141.             { that amount in preparation for next input character              }
  142.  
  143.             CASE ch OF
  144.                CR, KBD_$CR :
  145.                   BEGIN
  146.                   cur_position.x_coord := 0;
  147.                   cur_position.y_coord := cur_position.y_coord + fhite;
  148.                   IF cur_position.y_coord > 24*fhite
  149.                      THEN
  150.                         BEGIN
  151.                         scroll;
  152.                         cur_position.y_coord := 24*fhite;
  153.                         END;
  154.                   END;
  155.                KBD_$BS :
  156.                   BEGIN
  157.                   IF cur_position.x_coord - fwidth >= 0
  158.                      THEN
  159.                         BEGIN
  160.                         cur_position.x_coord := cur_position.x_coord - fwidth;
  161.                         GPR_$MOVE(cur_position.x_coord, cur_position.y_coord,
  162.                                   status);
  163.                         GPR_$TEXT(SP, 1, status);
  164.                         END;
  165.                   END;
  166.                KBD_$LEFT_ARROW :
  167.                   BEGIN
  168.                   IF cur_position.x_coord - fwidth >= 0
  169.                      THEN
  170.                         cur_position.x_coord := cur_position.x_coord - fwidth
  171.                      ELSE
  172.                         cur_position.x_coord := 0;
  173.                   END;
  174.                KBD_$RIGHT_ARROW :
  175.                   BEGIN
  176.                   IF cur_position.x_coord + fwidth <= 79*fwidth
  177.                      THEN
  178.                         cur_position.x_coord := cur_position.x_coord + fwidth
  179.                      ELSE
  180.                         cur_position.x_coord := 79*fwidth;
  181.                   END;
  182.                KBD_$UP_ARROW :
  183.                   BEGIN
  184.                   IF cur_position.y_coord - fhite >= fhite-1
  185.                      THEN
  186.                         cur_position.y_coord := cur_position.y_coord - fhite
  187.                      ELSE
  188.                         cur_position.y_coord := fhite-1;
  189.                   END;
  190.                KBD_$DOWN_ARROW :
  191.                   BEGIN
  192.                   IF cur_position.y_coord + fhite <= 24*fhite
  193.                      THEN
  194.                         cur_position.y_coord := cur_position.y_coord + fhite
  195.                      ELSE
  196.                         cur_position.y_coord := 24*fhite;
  197.                   END;
  198.                OTHERWISE
  199.                   BEGIN
  200.                   GPR_$MOVE(cur_position.x_coord, cur_position.y_coord, status);
  201.                   GPR_$TEXT(ch, 1, status);
  202.                   cur_position.x_coord := cur_position.x_coord + fwidth;
  203.                   IF cur_position.x_coord > 79*fwidth
  204.                      THEN
  205.                         BEGIN
  206.                         cur_position.x_coord := 0;
  207.                         cur_position.y_coord := cur_position.y_coord + fhite;
  208.                         IF cur_position.y_coord > 24*fhite
  209.                            THEN
  210.                               BEGIN
  211.                               scroll;
  212.                               cur_position.y_coord := 24*fhite;
  213.                               END;
  214.                         END;
  215.                   END; (* of otherwise *)
  216.                END; (* of case *)
  217.  
  218.             GPR_$SET_CURSOR_POSITION(cur_position, status);
  219.  
  220.             GPR_$SET_CURSOR_ACTIVE(true, status);
  221.             END;
  222.    UNTIL FOREVER;
  223.  
  224.    GPR_$DISABLE_INPUT(GPR_$KEYSTROKE, status);
  225.  
  226.    { terminate direct mode graphics }
  227.  
  228.    GPR_$TERMINATE(FALSE, status);
  229.  
  230. END.
  231.