home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPTC16.ZIP / TEST.SRC < prev    next >
Encoding:
Text File  |  1993-01-04  |  10.6 KB  |  480 lines
  1. MODULE MENUS;
  2. CONST
  3. {$I MENUS.CON}
  4. {$I CONTROLS.CON}
  5. {$I SWITCH.CON}
  6.     ASK = TRUE;
  7.     DONT_ASK = FALSE;
  8. TYPE
  9. {$I TELEX.DEF}
  10.  
  11. VAR
  12. {$I TELEX.GLB}
  13.     HELPANS:      BOOLEAN;
  14.     SELECT:       CHAR;
  15.     SLINE:        INTEGER;    
  16.     REPAINT:      BOOLEAN;
  17.     DUMMY_B:      BOOLEAN;
  18.     DATE:         STRING[12];
  19.     REVS:         BYTE;
  20.     WAIT_PERIOD:  LONGINT;
  21.  
  22.     IN_TOP_LEVEL: EXTERNAL BOOLEAN;
  23.     MNS:          EXTERNAL ARRAY [1..200] OF STRING[40];
  24.     L_MARGIN:     EXTERNAL BYTE;
  25.     T_MARGIN:     EXTERNAL BYTE;
  26.     R_MARGIN:     EXTERNAL BYTE;
  27.     B_MARGIN:     EXTERNAL BYTE;
  28.     COMSEL:       EXTERNAL BYTE;
  29.     ATTR:         EXTERNAL INTEGER;
  30.     FUNCS:        EXTERNAL ARRAY[0..31] OF BYTE;
  31.     MISC:         EXTERNAL ARRAY[1..16] OF BYTE;
  32.     UNS1:         EXTERNAL STRING;
  33.     WTANS:        EXTERNAL LONGINT;
  34.  
  35. {$I TERMINAL.EXT}
  36.     EXTERNAL PROCEDURE PUTCHRS(CH: CHAR ; CNT: INTEGER);
  37.     (*------- notice the external declaration -------*)
  38.     EXTERNAL PROCEDURE CLEAR_WINDOW(ULX,ULY,LRX,LRY: INTEGER);
  39.     EXTERNAL PROCEDURE PUTATPOS(CH:CHAR);
  40.     EXTERNAL FUNCTION READ_CHR: INTEGER;
  41.     EXTERNAL FUNCTION READXY: INTEGER;
  42.     EXTERNAL FUNCTION WAIT_FOR_CHAR: CHAR;
  43.     EXTERNAL FUNCTION GET_CHR_AND_MESSAGES: CHAR;
  44.     EXTERNAL FUNCTION SYS_TICK: LONGINT;
  45.     EXTERNAL PROCEDURE ANSWER;
  46.     EXTERNAL PROCEDURE HELP;
  47.     EXTERNAL PROCEDURE DELAY;
  48.     EXTERNAL PROCEDURE BEEP;
  49.     EXTERNAL PROCEDURE GET_STATUS(VAR S: STRING);
  50.     EXTERNAL PROCEDURE STR_OUT(S: STRING);
  51.  
  52.     EXTERNAL  [1] PROCEDURE EDIT;
  53.     (*------- notice the external declaration in an overlay #1 -------*)
  54.     EXTERNAL  [2] PROCEDURE PREPARE;
  55.     EXTERNAL  [2] PROCEDURE SAVE_SYS_PARMS;
  56.     EXTERNAL  [5] PROCEDURE LOAD_MSG;
  57.     EXTERNAL  [5] PROCEDURE SAVE_MSG;
  58.     EXTERNAL  [5] PROCEDURE KILL_MSG;
  59.     EXTERNAL  [5] PROCEDURE VIEW_MSG;
  60.     EXTERNAL  [5] PROCEDURE LDIR_MSG;
  61.     EXTERNAL  [5] PROCEDURE ADJUST;
  62.     EXTERNAL  [5] PROCEDURE CHANGE_LANG;
  63.     EXTERNAL  [5] PROCEDURE CHANGE_MODE;
  64.     EXTERNAL  [6] PROCEDURE READ_TELEX;
  65.     EXTERNAL  [7] PROCEDURE INDEX;
  66.     EXTERNAL  [7] PROCEDURE DEL_INDEX;
  67.     EXTERNAL  [8] PROCEDURE LIST_TELEX;
  68.     EXTERNAL  [9] PROCEDURE REVIEW;
  69.     EXTERNAL [10] FUNCTION  RETRIEVE(C: INTEGER): BOOLEAN;
  70.     EXTERNAL [10] PROCEDURE CLR_COPY;
  71.     EXTERNAL [11] PROCEDURE DOTHINGS;
  72.  
  73.     EXTERNAL [17] PROCEDURE PHONE;
  74.     EXTERNAL [18] PROCEDURE WELCOME;
  75.     EXTERNAL [21] PROCEDURE SEND(ASK_TIME: BOOLEAN);
  76.     EXTERNAL [21] FUNCTION  MULTI_SEND: INTEGER;
  77.     EXTERNAL [22] PROCEDURE ONLINE;
  78.     EXTERNAL [22] PROCEDURE CALL_SUBSCRIBER;
  79.     EXTERNAL [23] PROCEDURE CONFIG;
  80.     EXTERNAL [24] FUNCTION  QUIT: BOOLEAN;
  81.     EXTERNAL [25] PROCEDURE PUT_DATE(I: INTEGER ; OD: CHAR);
  82.     EXTERNAL [26] PROCEDURE PRINT_CONTENTS;
  83.     EXTERNAL [26] PROCEDURE GET_LOGGED_MESSAGE;
  84.  
  85.  
  86. FUNCTION  MENU_DRIVER(LTR: STRING ;START_ROW: INTEGER): CHAR;
  87. VAR
  88.     LOG_ON_DISK:        BOOLEAN;
  89.     CH,N:               INTEGER;
  90. BEGIN
  91.   N := LENGTH(LTR) - 1;
  92.   IF SP1STR = UNS1 THEN
  93.     LOG_ON_DISK := TRUE
  94.   ELSE
  95.     LOG_ON_DISK := FALSE;
  96.   XYGOTO(80,1);
  97.   REPEAT
  98.     REPEAT
  99.       IF IN_TOP_LEVEL AND LOG_ON_DISK THEN
  100.         CH := ORD(GET_CHR_AND_MESSAGES)
  101.       ELSE
  102.         CH := ORD(WAIT_FOR_CHAR);
  103.     UNTIL (CH = 27) OR (CH = FUNC_KEY);
  104.     IF CH <> 27 THEN
  105.       CH := ORD(GET_CHR);
  106.   UNTIL ((CH >= F1_KEY) AND (CH <= F1_KEY+N)) OR (CH = 27);
  107.   IF CH = 27 THEN
  108.     MENU_DRIVER := 'Q'
  109.   ELSE
  110.     BEGIN
  111.       N := CH - F1_KEY;
  112.       MENU_DRIVER := LTR[N+1];
  113.     END;
  114. END;
  115.  
  116. PROCEDURE SET_DATE(S: STRING);
  117. BEGIN
  118.   DATE := S;
  119.   ATTR := HILT; XYGOTO(60,1); WRITE([ADDR(PUT_CHR)],DATE);
  120.   ATTR := NORMAL;
  121. END;
  122.  
  123. PROCEDURE EXEC_PROC;
  124. VAR
  125.     S:  STRING;
  126.     C:  CHAR;
  127. BEGIN
  128.   IF MISC_PARMS[4] <> 0 THEN
  129.     BEGIN
  130.       GET_STATUS(S);
  131.       C := S[POS('P5',S)+2];
  132.       IF NOT (C IN ['3','4']) THEN
  133.         BEGIN
  134.           MISC_PARMS[4] := 0;
  135.           XYGOTO(2,22); DRAW_HORIZ;
  136.         END;
  137.     END;
  138. END;
  139.  
  140. PROCEDURE INVOKE_FUNC(P: INTEGER);
  141. BEGIN
  142.   CASE P OF
  143.     1: IF HELPANS THEN BEGIN HELPANS := FALSE; ANSWER; HELPANS := TRUE; END;
  144.     8: HELP;
  145.     16: PRINT_SCREEN;
  146.     20: ABORT_SEND;
  147.   END;
  148. END;
  149.  
  150. PROCEDURE ABORT_SEND;
  151. BEGIN
  152.   STR_OUT('{T}');
  153. END;
  154.  
  155. PROCEDURE PRINT_SCREEN;
  156. VAR
  157.     C,P,X,Y: INTEGER;
  158.     AT: BYTE;
  159.  
  160. PROCEDURE CRLF;
  161. BEGIN
  162.   PRN_CHR(CHR(13));
  163.   PRN_CHR(CHR(10));
  164. END;
  165.  
  166. (*PROCEDURE CHANGE_ATTR;
  167. VAR
  168.     A: BYTE;
  169. BEGIN
  170.   A := HI(C);
  171.   IF A = HLUL THEN
  172.     WRITE([ADDR(PRN_CHR)],CHR(27),'-1')
  173.   ELSE
  174.     WRITE([ADDR(PRN_CHR)],CHR(27),'-0');
  175.   AT := A;
  176. END;*)
  177.  
  178. PROCEDURE SWITCH(CH: CHAR);
  179. BEGIN
  180.   C := (C & $FF00) ! ORD(CH);
  181.   (*----           ^ this is a bit-wise OR ----*)
  182.   (*----  ^ this is a bit-wise AND ----*)
  183. END;
  184.  
  185. BEGIN
  186.   P := READXY; AT := NORMAL;
  187.   (*WRITE([ADDR(PRN_CHR)],CHR(27),'U1');*)
  188.   CRLF;
  189.   FOR Y := 1 TO 25 DO
  190.     BEGIN
  191.       FOR X := 1 TO 80 DO
  192.         BEGIN
  193.           XYGOTO(X,Y);
  194.           C := READ_CHR;
  195.           CASE CHR(LO(C)) OF
  196.             '╠','╣','╔','╚','╝','╗': SWITCH('+');
  197.             '═': SWITCH('-');
  198.             '║': SWITCH('|');
  199.           END;
  200.           (*IF AT <> HI(C) THEN
  201.             CHANGE_ATTR;*)
  202.           PRN_CHR(CHR(LO(C)));
  203.         END;
  204.       CRLF;
  205.     END;
  206. (*  WRITE([ADDR(PRN_CHR)],CHR(27),'-0',CHR(27),'U0');*)
  207.   CRLF; CRLF; CRLF;
  208.   XYGOTO(LO(P)+1,HI(P)+1);
  209. END;
  210.  
  211. PROCEDURE DEF_WINDOW(P: CHAR);
  212. BEGIN
  213.   LINE_WIDTH(1);
  214.   CASE P OF
  215.     'A':
  216.       BEGIN
  217.         LINE_WIDTH(0); T_MARGIN := 0; B_MARGIN := 24; XYGOTO(1,1);
  218.       END;
  219.     'L':
  220.       BEGIN
  221.         T_MARGIN := 4; B_MARGIN := 20; XYGOTO(2,5);
  222.       END;
  223.     'S':
  224.       BEGIN
  225.         T_MARGIN := 1; B_MARGIN := 2; XYGOTO(2,2);
  226.       END;
  227.     'B':
  228.       BEGIN
  229.         T_MARGIN := 22; B_MARGIN := 23; XYGOTO(2,22);
  230.       END;
  231.   END;
  232. END;
  233.  
  234. PROCEDURE LINE_WIDTH(I: INTEGER);
  235. BEGIN
  236.   L_MARGIN := I; R_MARGIN := 79 - I;
  237. END;
  238.  
  239. PROCEDURE PUT_SELECTION(IX: INTEGER);
  240. VAR
  241.     ATR:        INTEGER;
  242. BEGIN
  243.   XYGOTO(20,SLINE); ATR := ATTR; ATTR := HILT;
  244.   WRITELN([ADDR(PUT_CHR)],'F',SELECT,'  ',MNS[IX]);
  245.   SELECT := CHR(ORD(SELECT) + 1);
  246.   SLINE := SLINE + 2;
  247.   WRITELN([ADDR(PUT_CHR)]);
  248.   ATTR := ATR;
  249. END;
  250.  
  251. PROCEDURE DRAW_HORIZ;
  252. VAR
  253.     N: INTEGER;
  254. BEGIN
  255.   FOR N := 2 TO 79 DO PUT_CHR(CHR(205));
  256. END;
  257.  
  258. PROCEDURE REPNT;
  259. BEGIN
  260.   REPAINT := TRUE;
  261. END;
  262.  
  263. PROCEDURE NOREPNT;
  264. BEGIN
  265.   REPAINT := FALSE;
  266. END;
  267.  
  268.  
  269. PROCEDURE SWITCH(CH: CHAR);
  270. BEGIN
  271.   C := (C & $FF00) ! ORD(CH);
  272.   (*               ^ this is a bit-wise OR *)
  273.   (*      ^ this is a bit-wise AND *)
  274. END;
  275.  
  276. PROCEDURE PUTCONSTR(SI: INTEGER ; X,Y: INTEGER);
  277. VAR
  278.     SAVE_ATTR: BYTE;
  279. BEGIN
  280.   SAVE_ATTR := ATTR;
  281.   IF X >= 100 THEN
  282.     BEGIN
  283.       ATTR := HILT;
  284.       X := X - 100;
  285.     END;
  286.   IF Y > 0 THEN
  287.     XYGOTO(X,Y)
  288.   ELSE
  289.     FOR X := X DOWNTO 1 DO PUT_CHR(' ');
  290.   WRITE([ADDR(PUT_CHR)],MNS[SI]);
  291.   ATTR := SAVE_ATTR;
  292. END;
  293.  
  294. PROCEDURE CLR_L_WND;
  295. BEGIN
  296.   CLEAR_WINDOW(2,5,79,21);
  297. END;
  298.  
  299. PROCEDURE CLR_S_WND;
  300. BEGIN
  301.   CLEAR_WINDOW(2,2,79,3);
  302. END;
  303.  
  304. PROCEDURE CLR_B_WND;
  305. BEGIN
  306.   CLEAR_WINDOW(2,23,79,24);
  307. END;
  308.  
  309. FUNCTION TEST_PSWD(X,Y: INTEGER): BOOLEAN;
  310. VAR
  311.     I:  INTEGER;
  312.     CH: CHAR;
  313.     S:  STRING;
  314. BEGIN
  315.   TEST_PSWD := FALSE;
  316.   PUTCONSTR(PSWD,100+X,Y); CL_EOL;
  317.   S := '';
  318.   REPEAT
  319.     CH := WAIT_FOR_CHAR;
  320.     IF CH = CHR(27) THEN BEGIN XYGOTO(X,Y); CL_EOL; EXIT; END;
  321.     S := CONCAT(S,CH);
  322.   UNTIL CH = CHR(13);
  323.   DELETE(S,LENGTH(S),1);
  324.   IF S = PASSWORD THEN TEST_PSWD := TRUE;
  325.   XYGOTO(X,Y); CL_EOL;
  326. END;
  327.  
  328. PROCEDURE INIT_MENU;
  329. BEGIN
  330.   SELECT := '1';
  331.   SLINE := 6;
  332. END;
  333.  
  334. {$E-}
  335. PROCEDURE CHECK_CONNECT;
  336. VAR
  337.     P:  INTEGER;
  338.     AT: BYTE;
  339. BEGIN
  340.   AT := ATTR;
  341.   IF MISC_PARMS[4] <> 0 THEN
  342.     BEGIN
  343.       P := 40 - LENGTH(MNS[CLSC]) DIV 2;
  344.       ATTR := 112; PUTCONSTR(CLSC,P,22);
  345.     END
  346.   ELSE
  347.     BEGIN
  348.       XYGOTO(2,22); DRAW_HORIZ;
  349.     END;
  350.   ATTR := AT;
  351. END;
  352.  
  353. PROCEDURE CALL;
  354. BEGIN
  355.   XYGOTO(2,22); DRAW_HORIZ;
  356.   CALL_SUBSCRIBER;
  357.   CHECK_CONNECT;
  358. END;
  359. {$E+}
  360.  
  361. PROCEDURE PAINT_MENU_FRAME(HEADING: INTEGER);
  362. VAR
  363.     N: INTEGER;
  364. BEGIN
  365.   L_MARGIN := 0; T_MARGIN := 0; R_MARGIN := 79; B_MARGIN := 24;
  366.   ATTR := HILT; {- high lighted -}
  367.   CLR_S_WND;
  368.   MISC_PARMS[8] := HEADING;
  369.   PUTCONSTR(HEADING,6,2);
  370.   ATTR := NORMAL;
  371.   CLR_L_WND;
  372.   INIT_MENU;
  373.   WTANS := WAIT_PERIOD;
  374.   IF NOT REPAINT THEN EXIT;
  375.   XYGOTO(1, 1); 
  376.   PUT_CHR(CHR(201)); 
  377.   DRAW_HORIZ;
  378.   PUT_CHR(CHR(187));
  379.   PUT_CHR(CHR(186));
  380.   XYGOTO(80,2); 
  381.   PUT_CHR(CHR(186)); PUT_CHR(CHR(186));
  382.   XYGOTO(80,3); 
  383.   PUT_CHR(CHR(186)); PUT_CHR(CHR(204));
  384.   DRAW_HORIZ;
  385.   PUT_CHR(CHR(185)); PUT_CHR(CHR(186));
  386.   FOR N := 5 TO 24 DO
  387.     BEGIN
  388.       XYGOTO(80,N);
  389.       PUT_CHR(CHR(186));
  390.       PUT_CHR(CHR(186));
  391.     END;
  392.   XYGOTO(1,22); PUT_CHR(CHR(204)); DRAW_HORIZ; PUT_CHR(CHR(185));
  393.   XYGOTO(1,25); PUT_CHR(CHR(200)); DRAW_HORIZ; PUT_CHR(CHR(188));
  394.   PUTCONSTR(PRX,106,25);
  395.   IF HELPANS THEN PUTCONSTR(HLAN,100,0);
  396.   PUT_MODE;
  397.   ATTR := HILT; XYGOTO(60,1); WRITE([ADDR(PUT_CHR)],DATE);
  398.   ATTR := NORMAL;
  399.   CHECK_CONNECT;
  400.   NOREPNT;
  401. END;
  402.  
  403.  
  404. PROCEDURE MAIN_MENU;
  405. VAR
  406.     CH: CHAR;
  407. BEGIN
  408.   WAIT_PERIOD := WTANS;
  409.   MISC_PARMS[4] := 0;
  410.   FUNCS[1] := 1; { ENABLE ANSWER }
  411.   FUNCS[8] := 1; { ENABLE HELP }
  412.   FUNCS[20] := 1; { ENABLE TRANSMIT ABORT }
  413.   REPNT;
  414.   HELPANS := TRUE;
  415.   PUT_DATE(SYS_DATE,'M');
  416.   DATE := ISTR;
  417.   REPEAT
  418.     PAINT_MENU_FRAME(TMN);
  419.     PUT_SELECTION(PNS);
  420.     PUT_SELECTION(TMM);
  421.     PUT_SELECTION(TSD);
  422.     PUT_SELECTION(OXF);
  423.     PUT_SELECTION(CNS);
  424.     PUT_SELECTION(DTN);
  425.     IF MISC_PARMS[4] = 0 THEN IN_TOP_LEVEL := TRUE;
  426.     CH := MENU_DRIVER('PTSACD',3);
  427.     IN_TOP_LEVEL := FALSE;
  428.     SHORT_WAIT;
  429.     CASE CH OF
  430.       'P': PREP_MENU;
  431.       'T': MANG_MENU;
  432.       'S': PHONE;
  433.       'A': AUX_MENU;
  434.       'C': IF TEST_PSWD(2,23) THEN CONFIG;
  435.       'D': CALL;
  436.       'Q': IF MISC_PARMS[4] <> 0 THEN
  437.              CALL
  438.            ELSE IF QUIT THEN 
  439.              EXIT;
  440.     END;
  441.   UNTIL FALSE;
  442. END;
  443. {$E+}
  444.  
  445.  
  446. {added procs for testing 1.4}
  447. procedure test_353;
  448. var
  449.    lv:  longint;
  450.    a,b: integer;
  451.  
  452.    procedure nested_353;
  453.    var
  454.       a,c: integer;
  455.    begin
  456.       lv := #5;
  457.       a := 4;
  458.       b := 5;
  459.       c := 6;
  460.    end;
  461.  
  462. begin
  463.    nested_353;
  464.    lv := #123456;  {long integer literal}
  465.    a := 123;       {integer literal}
  466.    b := $123;      {hex literal}
  467.    a := ~a;        {bitwise not}
  468.    a := \a;        {bitwise not}
  469.    a := ?a;        {bitwise not}
  470.    a := a | b;     {bitwise or}
  471.    writeln([],'special case');   {no output routine given}
  472.    write([addr(putchar)],lv);    {indirect write}
  473.    readln([],a);                 {no input routine given}
  474.    readln([addr(getchar)],b);    {indirect read}
  475. end;
  476.  
  477.  
  478. MODEND.
  479. (* ---- end of module ( separate compilation -----*)
  480.