home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vpbgib1.zip / GRAPHSRV.PAS < prev    next >
Pascal/Delphi Source File  |  1996-08-08  |  10KB  |  317 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal v1.1                              █}
  4. {█      BGI Graphics Server for mixed BGI/Textmode       █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1996 fPrint UK Ltd                 █}
  7. {█        Written May-July 1996 by Allan Mertner         █}
  8. {█        Pipe interface engineered by Alex Vermeulen    █}
  9. {█                                                       █}
  10. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  11.  
  12. program GraphSrv;
  13.  
  14. {&PMTYPE PM}
  15.  
  16. uses Use32, Dos, Os2Def, Os2Base, Strings, Dgraph, BGImsg;
  17.  
  18. const
  19.   Stopping : boolean = false;
  20.  
  21. procedure Error( No: Integer; s: String );
  22. begin
  23.   Case No of
  24.     1 : ; // Cannot open BGI named pipe "s"
  25.     2 : ; // Cannot create semaphore "s"
  26.     3 : ; // Cannot link named pipe and semaphore.
  27.     4 : ; // Cannot read data from pipe
  28.     5 : ; // Cannot send result to client
  29.     6 : ; // SetTextStyle failed; check BGIPath
  30.   else
  31.     // 'Unknown error occured';
  32.   end;
  33.   Halt( No );
  34. end;
  35.  
  36. var
  37.   r    : DisplayListT;
  38.   hevn : HEv;
  39.   pip  : HPipe;
  40.   rc   : ApiRet;
  41.   Ptr  : word;
  42.   res  : BGIResArT;
  43.   ulBytesR: uLong;
  44.   ulBytes : uLong;
  45.  
  46. procedure openpipe( Name: String );
  47. begin
  48.   // Create named pipe for communicating with client
  49.   name:=name+#0;
  50.   rc:=DosCreateNPipe( @Name[1],pip,NP_ACCESS_DUPLEX,  // Duplex pipe
  51.                       NP_WAIT OR
  52.                       NP_WMESG OR                     // Write messages
  53.                       NP_RMESG OR                     // Read messages
  54.                       1,                              // Unique instance of pipe
  55.                       256,                            // Output buffer size
  56.                       4096*sizeof(Word),              // Input buffer size
  57.                       1000);                          // Use default time-out
  58.   if rc <> No_Error then
  59.     Error( 1, Name );
  60.  
  61.   // Create event semaphore to link with pipe
  62.   name := '\SEM32' + name;
  63.   rc := DosCreateEventSem( @name[1], hevn, 0, false );
  64.   if rc <> No_Error then
  65.     Error( 2, Name );
  66.  
  67.   // Link semaphore and pipe together
  68.   rc := DosSetNPipeSem( Pip, hsem(hevn), 1);
  69.   if rc <> No_Error then
  70.     Error( 3, '' );
  71.  
  72.   // Connect to the pipe
  73.   DosConnectNPipe(Pip);
  74. {   <> no_Error do
  75.     DosSleep( 50 );}
  76. end;
  77.  
  78. // WaitForConn: Wait for client to connect to the pipe
  79. procedure WaitForConn;
  80. var
  81.   rc     : ApiRet;
  82.   Buffer : Longint;
  83.   fRead  : Longint;
  84.   fAvail : AvailData;
  85.   fState : Longint;
  86.  
  87. begin
  88.   repeat
  89.     // Wait 1/1000 sec for posting of the semaphore
  90.     rc := DosWaitEventSem(hevn, 1 );
  91.     // Have a look at the pipe data
  92.     DosPeekNPipe(pip, Buffer, 0, fRead, fAvail, fState);
  93.     if fAvail.cbPipe = 0 then
  94.       begin
  95.         // No data available in pipe
  96.         if fState in [ np_state_Disconnected, np_State_Closing ] then
  97.           begin
  98.             // If exiting, return EOF
  99.             Stopping := True;
  100.             Exit;
  101.           end;
  102.         // No data: Wait a little before retrying
  103.         DosSleep( 31 );
  104.       end;
  105.     // Stay in loop until data received
  106.   until ( rc = No_Error ) and ( fAvail.cbPipe <> 0 );
  107. end;
  108.  
  109. procedure ProcessBGIMessages;
  110. var
  111.   point  : ^CommandListT;
  112.   nrpar  : word;
  113.   len    : word;
  114.   cmd    : word;
  115.   lineS  : LineSettingsType;
  116.   ArcC   : ArcCoordsType;
  117.   Pal    : PaletteType;
  118.   Fill   : FillPatternType;
  119.   FillI  : FillSettingsType;
  120.   textS  : TextSettingsType;
  121.   View   : ViewPortType;
  122.  
  123. begin
  124.   repeat
  125.     repeat
  126.       rc := DosRead(Pip,                  { Handle of pipe }
  127.                     r,                    { Buffer for message read }
  128.                     sizeof(DisplayListT), { Buffer size }
  129.                     ulBytesR);            { Number of bytes actually read }
  130.       if rc = Error_No_Data then
  131.         DosSleep( 50 );
  132.     until rc <> error_no_Data;
  133.  
  134.     if rc <> No_Error then
  135.       // Error; cannot normally occur, since we know that there are
  136.       // data in the pipe
  137.       Error( 4, '' );
  138.  
  139.     // Stop DIVE from refreshing the display while drawing
  140.     SuspendRefresh;
  141.     Ptr    :=0;
  142.     res[0] :=0;
  143.  
  144.     // Process all messages
  145.     while Ptr < ulBytesR div Sizeof(word) do
  146.     begin
  147.       cmd   := r.w[Ptr];      // Command number
  148.       nrpar := r.w[Ptr+1];    // Parameter count
  149.       len   := r.w[Ptr+2];    // Length of expected return value
  150.       point := @r.w[Ptr+3];   // Array of points (x,y)
  151.  
  152.       // Execute one command
  153.       with point^ do
  154.         case cmd of
  155.           1: Arc(x1,y1,w3,w4,w5);
  156.           2: Bar(x1,y1,x2,y2);
  157.           3: Bar3D(x1,y1,x2,y2,w5,w6=1);
  158.           4: Circle(x1,y1,w3);
  159.           5: ClearDevice;
  160.           6: ClearViewPort;
  161.           7: CloseGraph;
  162.           8: DetectGraph(res[0],res[1]);
  163.           9: DrawPoly(nr,pts);
  164.           10: Ellipse(x1,y1,w3,w4,w5,w6);
  165.           11: FillEllipse(x1,y1,w3,w4);
  166.           12: FillPoly(nr,pts);
  167.           14: begin GetArcCoords(ArcC);move(arcC,res,sizeof(arcC)) end;
  168.           15: GetAspectRatio(res[0],res[1]);
  169.           16: res[0]:=getBkColor;
  170.           17: res[0]:=GetColor;
  171.           18: begin GetDefaultpalette(Pal);move(Pal,res,sizeof(Pal)) end;
  172.           19: begin s:=GetDriverName;move(s,res,sizeof(s)) end;
  173.           20: begin GetFillPattern(Fill);move(fill,res,sizeof(fill)) end;
  174.           21: begin GetFillSettings(FillI);move(fillI,res,sizeof(fillI)) end;
  175.           22: res[0]:=GetGraphMode;
  176.           24: begin getlinesettings(lineS);move(lineS,res,sizeof(lineS)) end;
  177.           25: res[0]:=GetMaxColor;
  178.           26: res[0]:=GetMaxX;
  179.           27: res[0]:=GetMaxY;
  180.           28: begin s:=getModeName(w1);move(s,res,sizeof(s)) end;
  181.           29: begin GetPalette(Pal); move(Pal,res,sizeof(Pal)) end;
  182.           30: res[0]:=GetPaletteSize;
  183.           31: res[0]:=GetPixel(x1,y1);
  184.           32: begin gettextsettings(textS);move(texts,res,sizeof(texts)) end;
  185.           33: begin getviewsettings(view);move(view,res,sizeof(view)) end;
  186.           34: res[0]:=GetX;
  187.           35: res[0]:=GetY;
  188.           36: GraphDefaults;
  189.           39: res[0]:=ImageSize(x1,y1,x2,y2);
  190.           41: res[0]:=InstallUserFont(s);
  191.           42: Line(x1,y1,x2,y2);
  192.           43: LineRel(x1,y1);
  193.           44: LineTo(x1,y1);
  194.           45: MoveRel(x1,y1);
  195.           46: MoveTo(x1,y1);
  196.           47: OutText(s);
  197.           48: OutTextXY(x1,y1,s);
  198.           49: PieSlice(x1,y1,w3,w4,w5);
  199.           51: PutPixel(x1,y1,w3);
  200.           52: Rectangle(x1,y1,x2,y2);
  201.           53: RegisterBGIFont(i1,pointer(w2));
  202.           54: Sector(x1,y1,w3,w4,w5,w6);
  203.           55: SetAllPalette(PaletteType(i[0]));
  204.           56: SetAspectRatio(w1,w2);
  205.           57: SetBkColor(w1);
  206.           58: SetColor(w1);
  207.           59: SetFillPattern(fillpatterntype(w[1]),w1);
  208.           60: SetFillStyle(w1,w2);
  209.           61: SetLineStyle(w1,w2,w3);
  210.           62: SetPalette(w1,w2);
  211.           63: SetRGBPalette(w1,w2,w3,w4);
  212.           64: SetTextJustify(w1,w2);
  213.           65: try
  214.                 SetTextStyle(i1,i2,i3);
  215.               except
  216.                 Error( 6, '' );  // Could not find font
  217.               end;
  218.           66: SetUserCharSize(w1,w2,w3,w4);
  219.           67: SetViewPort(x1,y1,x2,y2,w5=1);
  220.           68: SetWriteMode(i1);
  221.           69: res[0]:=TextHeight(s);
  222.           70: res[0]:=TextWidth(s);
  223.           71: SetWideFillPattern(newpatterntype(w[1]),w1);
  224.           99: if keypressed then res[0] := ord(Readkey) else res[0] := 0;
  225.         else
  226.           // Ignore unknown commands
  227.         end;
  228.  
  229.         // Skip command and parameters
  230.         Inc(Ptr,nrpar+3);
  231.       end;
  232.  
  233.     // Re-enable DIVE refreshind the display
  234.     EnableRefresh;
  235.  
  236.     // Always send at least one word of acknowledgment to client
  237.     if len = 0 then
  238.       len := 1;
  239.  
  240.     if ulBytesR > 0 then
  241.       begin
  242.         rc:= DosWrite(Pip,              // Handle of pipe
  243.                       res,              // Buffer containing message to write
  244.                       len*sizeof(word), // Length of message
  245.                       ulBytes);         // Number of bytes actually written
  246.  
  247.         if rc <> No_Error then
  248.           Error( 5, '' );
  249.       end;
  250.   until ulBytesR = 0;
  251. end;
  252.  
  253. // Close pipe connection
  254. procedure shutconn;
  255. begin
  256.   rc := DosCloseEventSem(hevn);
  257.   rc := DosDisConnectNPipe(Pip);
  258. end;
  259.  
  260. var
  261.   ok          : Integer;
  262.   GraphMode   : Integer;
  263.   GraphDriver : word;
  264.   s           : String;
  265.   x           : Integer;
  266.   BGIPath     : String;
  267.  
  268. begin
  269.   BGIPath := '';
  270.   // Process command line parameters
  271.   // -P<PipeName> sets the pipe name
  272.   // -X<Number>   sets the horizontal resolution
  273.   // -Y<Number>   sets the vertical resolution
  274.   // -B<Path>     sets the path to BP BGI fonts
  275.   for x:=1 to paramcount do
  276.     begin
  277.       s := ParamStr(x);
  278.       if s[1] IN ['/','-'] then
  279.         case upcase(s[2]) of
  280.           'P': begin
  281.                  BGIPipeName:=copy(s,3,length(s));
  282.                  WindowTitle:=copy(s,3,length(s));
  283.                end;
  284.           'X': Val(copy(s,3,length(s)),X_Size,ok);
  285.           'Y': Val(copy(s,3,length(s)),Y_Size,ok);
  286.           'B': begin
  287.                  BGIPath := s;
  288.                  Delete( BGIPath, 1, 2 );
  289.                end;
  290.         end;
  291.     end;
  292.  
  293.   // Initialise DIVE window
  294.   GraphDriver:=Detect;
  295.   if BGIPath = '' then
  296.     BGIPath := GetEnv( 'BGIDIR' );
  297.   InitGraph( GraphDriver, Graphmode, BGIPath );
  298.  
  299.   // Open pipe for communications with client
  300.   OpenPipe(BGIPipeName);
  301.   ClearDevice;
  302.   GraphDefaults;
  303.  
  304.   // Receive and execute BGI commands
  305.   repeat
  306.     if not Stopping then
  307.       ProcessBGIMessages;
  308.   until Stopping;
  309.  
  310.   // Close the connection and the DIVE window
  311.   ShutConn;
  312.   CloseGraph;
  313. end.
  314.  
  315.  
  316.  
  317.