home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FSSERIAL.ZIP / SERTEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-01-29  |  8.6 KB  |  321 lines
  1. {$DEFINE TVSPY}  {Define this if you want the TVSPY program installed}
  2.  
  3. Program Serial_Test;
  4.  
  5. Uses App, Objects, Drivers, Views, Menus, Gadgets,
  6. {$IFDEF TVSPY}
  7.      EventWin,
  8. {$ENDIF}
  9.      Serial, AnsiView, Crt;
  10.  
  11. CONST MaxScreen  = 100;
  12.  
  13. TYPE
  14.       PDummy      = ^TDummy;
  15.       TDummy      = OBJECT(TANSIView)
  16.                        Count : WORD;
  17.                        CONSTRUCTOR Init;
  18.                        PROCEDURE DisplayEvent(VAR Event : TEvent);
  19.                        PROCEDURE Idle; VIRTUAL;
  20.                     END;
  21.  
  22.       TSerialApp = OBJECT(TApplication)
  23.                       Clock  : PClockView;
  24.                       Heap   : PHeapView;
  25.                       Dummy  : PDummy;
  26.                       CONSTRUCTOR Init;
  27.                       PROCEDURE Idle; VIRTUAL;
  28.                       PROCEDURE HandleEvent(VAR Event : TEvent); VIRTUAL;
  29.                       PROCEDURE InitStatusLine; VIRTUAL;
  30.                       PROCEDURE InitMenuBar; VIRTUAL;
  31.                       PROCEDURE GetEvent(VAR E : TEvent); VIRTUAL;
  32.                    END;
  33.  
  34.       PTermWindow = ^TTermWindow;
  35.       TTermWindow = OBJECT(TANSIView)
  36.                        Port     : BYTE;
  37.                        Carrier  : BOOLEAN;
  38.                        TxBuffer : BOOLEAN;
  39.                        DTRState : BOOLEAN;
  40.                        CONSTRUCTOR Init(PortNum : BYTE; Bounds : TRect);
  41.                        PROCEDURE HandleEvent(VAR Event : TEvent); VIRTUAL;
  42.                        DESTRUCTOR Done; VIRTUAL;
  43.                     END;
  44.  
  45.  
  46. VAR   MyApp : TSerialApp;
  47.  
  48. CONST cmPort1 = 250;
  49.       cmPort2 = 252;
  50.       cmPort3 = 253;
  51.       cmPort4 = 254;
  52.  
  53.       cmOpen       = 100;
  54.       cmNew        = 101;
  55.       cmChangeDir  = 102;
  56.       cmDosShell   = 103;
  57.       cmCalculator = 104;
  58.       cmShowClip   = 105;
  59.  
  60. CONSTRUCTOR TTermWindow.Init;
  61. VAR   s   : STRING;
  62.       E   : TEvent;
  63.       Max : TPoint;
  64. BEGIN
  65.    IF (PortNum < 0) OR (PortNum > 3) THEN
  66.       FAIL;
  67.    Port := PortNum;
  68.    STR(PortNum + 1:0,s);
  69.    Max.X := 80;
  70.    Max.Y := 25;
  71.    TANSIView.Init(Bounds,Max,'Terminal Window (COM ' + s + ')',PortNum + 1);
  72.  
  73.    E.What := evSerial;
  74.    E.Command := serInit;
  75.    E.InfoByte := Port;
  76.    MyApp.HandleEvent(E);
  77.  
  78.    E.What := evSerial;
  79.    E.Command := serBaud;
  80.    E.InfoLong := 2400 SHL 16;
  81.    E.InfoByte := Port;
  82.    MyApp.HandleEvent(E);
  83.  
  84.    E.What := evSerial;
  85.    E.Command := serEventGenOn;
  86.    MyApp.HandleEvent(E);
  87.  
  88.    Carrier := FALSE;
  89.    TxBuffer := FALSE;
  90.    DTRState := FALSE;
  91.    EventMask := EventMask OR evSerial;
  92.    CursorOn;
  93. END;
  94.  
  95. PROCEDURE TTermWindow.HandleEvent;
  96. VAR   ch : CHAR;
  97. BEGIN
  98.    TANSIView.HandleEvent(Event);
  99.    IF (Event.What = evSerial) THEN
  100.       IF (Event.Command = serRecvLine) AND (RecvRec(Event.InfoPtr^).Port = Port) THEN
  101.          Print(RecvRec(Event.InfoPtr^).St)
  102.       ELSE
  103.          IF Event.InfoByte = Port THEN
  104.             CASE Event.Command OF
  105.                serCarrier  : Carrier := BOOLEAN(HI(Event.InfoWord));
  106.                serTxBuffer : TxBuffer := BOOLEAN(HI(Event.InfoWord));
  107.                serRecvChar : PrintChar(CHAR(HI(Event.InfoWord)));
  108.                ELSE          EXIT;
  109.             END;
  110.  
  111.    {Real Bogus Code Here}
  112.  
  113.    IF GetState(sfSelected) AND (Event.What = evKeyDown) THEN
  114.       BEGIN
  115.          IF (ch = #27) OR ((ch >= ' ') AND (ch <= '~')) THEN
  116.             BEGIN
  117.                ch := Event.CharCode;
  118.                Event.What := evSerial;
  119.                Event.Command := serSend;
  120.                Event.InfoWord := BYTE(ch) SHL 8;
  121.                Event.InfoByte := Port;
  122.                PutEvent(Event)
  123.             END
  124.          ELSE
  125.             EXIT
  126.       END
  127.    ELSE
  128.       EXIT;
  129.    ClearEvent(Event)
  130. END;
  131.  
  132. DESTRUCTOR TTermWindow.Done;
  133. VAR   E : TEvent;
  134. BEGIN
  135.    E.What := evSerial;
  136.    E.Command := serDeInit;
  137.    E.InfoByte := Port;
  138.    MyApp.HandleEvent(E);
  139.    TANSIView.Done
  140. END;
  141.  
  142. CONSTRUCTOR TDummy.Init;
  143. VAR   R : TRect;
  144.       B : TPoint;
  145.       x : BYTE;
  146.       y : BYTE;
  147. BEGIN
  148.    x := RANDOM(30);
  149.    y := RANDOM(10);
  150.    R.Assign(x,y,x + 50,y + 10);
  151.    B.X := 80;
  152.    B.Y := 25;
  153.    TANSIView.Init(R,B,'Dummy Window',0);
  154.    Count := 0;
  155.    Flags := wfMove + wfGrow;
  156. END;
  157.  
  158. PROCEDURE TDummy.DisplayEvent;
  159. VAR   i : INTEGER;
  160.       os : STRING;
  161.  
  162.    FUNCTION disp_hex(b : BYTE) : STRING;
  163.    CONST hexstr : ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
  164.    BEGIN
  165.       disp_hex := hexstr[(b AND $F0) SHR 4] + hexstr[b AND $0F] + '  ';
  166.    END;
  167.  
  168. BEGIN
  169.    IF Event.What = evSerial THEN
  170.       BEGIN
  171.          CASE Event.Command OF
  172.             serRecvChar : print(disp_hex(HI(Event.InfoWord)));
  173.             serRecvLine : BEGIN
  174.                              os := '';
  175.                              FOR i := 1 TO LENGTH(RecvRec(Event.InfoPtr^).st) DO BEGIN
  176.                                 IF LENGTH(os) > 240 THEN
  177.                                    BEGIN
  178.                                       print(os);
  179.                                       os := '';
  180.                                    END;
  181.                                 os := os + disp_hex(ORD(RecvRec(Event.InfoPtr^).st[i]));
  182.                              END;
  183.                              print(os)
  184.                           END;
  185.          END
  186.       END
  187. END;
  188.  
  189. PROCEDURE TDummy.Idle;
  190. BEGIN
  191. END;
  192.  
  193. CONSTRUCTOR TSerialApp.Init;
  194. VAR   R   : TRect;
  195.       Max : TPoint;
  196. BEGIN
  197.    RANDOMIZE;
  198.    TApplication.Init;
  199.  
  200.    RegisterSerial;
  201.    RegisterANSIView;
  202.  
  203.    SerialSys := NEW(PSerial,Init);     {Install the Serial Port system}
  204.    Desktop^.Insert(SerialSys);
  205.  
  206.    GetExtent(R);
  207.    R.A.X := R.B.X - 9;
  208.    R.B.Y := R.A.Y + 1;
  209.    Clock := NEW(PClockView,Init(R));
  210.    Insert(Clock);
  211.  
  212.    GetExtent(R);
  213.    Dec(R.B.X);
  214.    R.A.X := R.B.X - 9;
  215.    R.A.Y := R.B.Y - 1;
  216.    Heap := NEW(PHeapView,Init(R));
  217.    Insert(Heap);
  218.  
  219. {$IFDEF TVSPY}
  220.    Desktop^.GetExtent(R);
  221.    R.Assign(R.A.X,R.B.Y-10,R.B.X div 2,R.B.Y);
  222.    EventWindow := NEW(PEventWindow,Init(R,'Event Window',wnNoNumber,100));
  223.    Desktop^.Insert(EventWindow);
  224.  
  225.    EventWindow^.InsertCommand(cmPort1,'cmPort1');
  226.    EventWindow^.InsertCommand(cmPort2,'cmPort2');
  227.    EventWindow^.InsertCommand(cmPort3,'cmPort3');
  228.    EventWindow^.InsertCommand(cmPort4,'cmPort4');
  229.    EventWindow^.InsertCommand(cmOpen,'cmOpen');
  230.    EventWindow^.InsertCommand(cmNew,'cmNew');
  231.    EventWindow^.InsertCommand(cmChangeDir,'cmChangeDir');
  232.    EventWindow^.InsertCommand(cmDosShell,'cmDosShell');
  233.    EventWindow^.InsertCommand(cmCalculator,'cmCalculator');
  234.    EventWindow^.InsertCommand(cmShowClip,'cmShowClip');
  235. {$ENDIF}
  236.  
  237.    Dummy := NEW(PDummy,Init);
  238.    DeskTop^.Insert(Dummy);
  239.  
  240. END;
  241.  
  242. PROCEDURE Add_Serial(Port : BYTE);
  243. VAR   R : TRect;
  244. BEGIN
  245.    R.Assign(10,0,60,12);
  246.    Desktop^.Insert(NEW(PTermWindow,Init(Port,R)));
  247. END;
  248.  
  249. PROCEDURE TSerialApp.HandleEvent;
  250. BEGIN
  251.    TApplication.HandleEvent(Event);
  252.    CASE Event.What OF
  253.       evCommand : CASE Event.Command OF
  254.                      cmPort1 : Add_Serial(0);
  255.                      cmPort2 : Add_Serial(1);
  256.                      cmPort3 : Add_Serial(2);
  257.                      cmPort4 : Add_Serial(3);
  258.                      ELSE EXIT
  259.                   END;
  260.       ELSE EXIT
  261.    END;
  262.    ClearEvent(Event)
  263. END;
  264.  
  265. PROCEDURE TSerialApp.Idle;
  266. BEGIN
  267.    TApplication.Idle;
  268.    Clock^.Update;
  269.    SerialSys^.Idle;
  270.    Heap^.Update;
  271.    Dummy^.Idle;
  272. END;
  273.  
  274. PROCEDURE TSerialApp.GetEvent;
  275. BEGIN
  276.    TApplication.GetEvent(E);
  277. {$IFDEF TVSPY}
  278.    EventWindow^.DisplayEvent(E);
  279. {$ENDIF}
  280.    Dummy^.DisplayEvent(E);
  281. END;
  282.  
  283. PROCEDURE TSerialApp.InitStatusLine;
  284. VAR   R : TRect;
  285. BEGIN
  286.    GetExtent(R);
  287.    R.A.Y := R.B.Y - 1;
  288.    StatusLine := NEW(PStatusLine,Init(R,
  289.                    NewStatusDef(0,$FFFF,
  290.                      NewStatusKey('~Alt-X~ Exit',kbAltX,cmQuit,
  291.                      NIL),
  292.                    NIL)
  293.                  ))
  294. END;
  295.  
  296. PROCEDURE TSerialApp.InitMenuBar;
  297. VAR   R : TRect;
  298. BEGIN
  299.    GetExtent(R);
  300.    R.B.Y := R.A.Y + 1;
  301.    MenuBar := NEW(PMenuBar,Init(R,NewMenu(
  302.                 NewSubMenu('~F~ile',hcNoContext,NewMenu(
  303.                   NewItem('~O~pen','F3',kbF3,cmCancel,hcNoContext,
  304.                   NewItem('~Q~uit','Alt-X',kbAltX,cmQuit,hcNoContext,
  305.                   NIL))),
  306.                 NewSubMenu('~S~erial Connection',hcNoContext,NewMenu(
  307.                   NewItem('~1~ Open Port 1','Alt-F1',kbAltF1,cmPort1,hcNoContext,
  308.                   NewItem('~2~ Open Port 2','Alt-F2',kbAltF2,cmPort2,hcNoContext,
  309.                   NewItem('~3~ Open Port 3','Alt-F3',kbAltF3,cmPort3,hcNoContext,
  310.                   NewItem('~4~ Open Port 4','Alt-F4',kbAltF4,cmPort4,hcNoContext,
  311.                   NIL))))),
  312.                 NIL))
  313.               )))
  314. END;
  315.  
  316. BEGIN
  317.    MyApp.Init;
  318.    MyApp.Run;
  319.    MyApp.Done
  320. END.
  321.