home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / dcad.arc / DC.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-11-17  |  30.6 KB  |  768 lines
  1. { Keywords:  DC.PAS CAD GRAPHICS REIFF IBM-PC PC-DOS TURBO VERSION 3
  2.  
  3.   This is a poor man's CAD starter system.  It is experimental and has not
  4.   been thoroughly tested.  It is set-up to draw simple electrical circuits,
  5.   but can be modified for architectural, mechanical or other symbols.  You
  6.   will find that the program still contains bracketed debugging lines and
  7.   future possibility lines.
  8.  
  9.   It requires an IBM-PC or Compatable, Turbo Version 3 and Graphics Monitor.
  10.   It is a derivative of a course on interactive computer graphics which I
  11.   have taught.  It includes several elements of the CORE Graphics Standard.
  12.  
  13.   A companion program module which will print that which is shown on the
  14.   screen on an Epsom with GRAFTRAX will be written and made available as
  15.   User Supported Software.
  16.  
  17.   The program should compile and run as you receive it.
  18.  
  19.   I would appreciate your questions, comments, criticisms or suggestions.
  20.           Glenn Reiff    59 Villa Drive    Pueblo, CO 81001
  21.                   }
  22.  
  23. (****************************************************************************)
  24. (*      DC.PAS      To Draw and Print Electrical Circuits        5/12/85    *)
  25. (****************************************************************************)
  26. const  WidthStart =   0;   HeightStart =   0;
  27.        WidthEnd   = 231;   HeightEnd   = 171;
  28.        DFSize     = 1000;
  29.  
  30. type   Files = record
  31.                        dfOP,dfX,dfY,
  32.                        dfA,dfX0,dfY0,dfC,dfM:   integer;
  33.                end;
  34.        Displays   = array[1..DFSize] of Files;
  35.        Str40      = string[40];
  36.        CharSet    = set of char;
  37.  
  38. var   Frame  :  array[WidthStart..WidthEnd,HeightStart..HeightEnd] of boolean;
  39.       DisplayFile:                         Displays;
  40.       Free:                                integer;
  41.       EraseFlag:                           boolean;
  42.       A,X0,Y0,C,M,
  43.       Width,Height,
  44.       Xwas,Ywas,Xnow,Ynow,
  45.         Color, Mode             :  integer;
  46.       Character,Ch,Direction    :  char;
  47.  
  48. procedure Graphics;                                   external 'GRAPH.BIN';
  49. procedure Palette(N: Integer);                        external Graphics[12];
  50. procedure GraphWindow(X1,Y1,X2,Y2: Integer);          external Graphics[18];
  51. procedure Plot(X,Y,Color: Integer);                   external Graphics[21];
  52. procedure FillScreen(Color: Integer);                 external Graphics[45];
  53. procedure ClearScreen;                                external Graphics[60];
  54.  
  55. procedure BEEP;
  56.    BEGIN  write(chr(7));  END;
  57.  
  58. procedure CHOOSE(    L:       integer;
  59.                      Prompt:  Str40;
  60.                      Term:    CharSet;
  61.                  var TC:      Char   );
  62.   var Ch:  char;
  63.       I:   integer;
  64.   BEGIN
  65.        if L=0 then gotoXY(1,25) else gotoXY(1,L);
  66.        for I:=1 to length(Prompt) do begin
  67.            if (I>3) then
  68.               if (copy(Prompt,I-2,1)=' ') and (copy(Prompt,I-1,1)=' ') then
  69.                    highvideo else lowvideo;
  70.            write(copy(Prompt,I,1));
  71.        end;
  72.        repeat
  73.              read(kbd,Ch); TC:=upcase(Ch); if not (TC in Term) then BEEP;
  74.        until TC in Term;
  75.        write(Ch); if L=0 then gotoXY(1,25) else gotoXY(1,L);
  76.        write('                                        ');
  77.   END; { CHOOSE }
  78.  
  79. function MIN(A,B:  real): real;
  80.    BEGIN if A>B then MIN:=B else MIN:=A; END;
  81.  
  82. function MAX(A,B:  real): real;
  83.    BEGIN if A>B then MAX:=A else MAX:=B; END;
  84.  
  85. procedure DDA (X1, Y1, X2, Y2, Color, Mode:   integer);
  86.    var
  87.       dX, dY, dXstep, dYstep, X, Y  :  real;
  88.       Steps, S                      :  integer;
  89.    BEGIN
  90.       dX:= X2 - X1;    dY:= Y2 - Y1;
  91.       if abs(dX) > WidthEnd  then dX:=WidthEnd;
  92.       if abs(dY) > HeightEnd then dY:=HeightEnd;
  93.       Steps:=trunc(MAX(abs(dX),abs(dY)))+1;
  94.       dXstep:= dX / Steps;  dYstep:= dY / Steps;
  95.       X:= X1 + 0.5;         Y:= Y1 + 0.5;
  96.       for S:= 1 to Steps do
  97.          begin
  98.                if Mode<0 then
  99.                begin
  100.                  PLOT(trunc(X),trunc(Y),Color);
  101.                end
  102.                else
  103.                if Mode=0 then
  104.                begin
  105.                  PLOT(trunc(X),trunc(Y),Color);
  106.                  Frame[trunc(X),trunc(Y)]:= true;
  107.                end;
  108.                X:= X + dXstep;  Y:= Y + dYstep;
  109.          end; { for S }
  110.          if Mode<0 then
  111.          begin
  112.             PLOT(trunc(X),trunc(Y),Color);
  113.          end
  114.          else
  115.          if Mode=0 then
  116.          begin
  117.             PLOT(trunc(X),trunc(Y),Color);
  118.             Frame[trunc(X),trunc(Y)]:= true;
  119.          end;
  120. END; { DDA }
  121.  
  122. procedure ARCDDA (X0, Y0, A, X, Y, Color, Mode:   integer);  { X0,Y0  Center of Curvature }
  123.    const  Roundoff = 0.5;                                    { A  Arc Angle, Degrees      }
  124.    var                                                       { X,Y    Starting Point      }
  125.       Xarc,Yarc,Arad,Adrawn,Da,B,C      :  real;             { Draws Clockwise            }
  126.    BEGIN
  127.       if abs(X-X0) + abs(Y-Y0) >= Roundoff then
  128.       begin
  129.         Arad:=Pi*A/180; Adrawn:=0; B:=0.1; C:=1/(3.2*(abs(X-X0) + abs(Y-Y0)));
  130.         Da:=MIN(B,C);  Xarc:=X; Yarc:=Y;
  131.         while Adrawn < Arad do
  132.         begin
  133.           Xarc:=Xarc + (Y0-Yarc) * Da;
  134.           Yarc:=Yarc + (Xarc-X0)*Da;
  135.           Adrawn:=Adrawn + Da;
  136.                PLOT(round(Xarc),round(Yarc),Color);
  137.                Frame[round(Xarc),round(Yarc)]:= true;
  138.         end; { while }
  139.       end; { if abs }
  140.    END;  { ARCDDA }
  141.  
  142. procedure DISPLAY(Xo,Yo: integer);         { Xo,Yo are Offsets to Center }
  143.   var   X,Y:                     integer;
  144.   BEGIN
  145.     for Y:= HeightStart to HeightEnd do begin
  146.         for X := WidthStart to WidthEnd do
  147.                   if Frame[X,Y]=true then PLOT(Xo+X,Yo+Y,3);
  148.     end; { for Y }
  149.   END; { DISPLAY }
  150.  
  151. procedure ERASE;
  152.    var X,Y:          integer;
  153.    BEGIN
  154.       Free:=1;
  155.       for Y:= HeightStart to HeightEnd do begin
  156.                for X:= WidthStart to WidthEnd do begin
  157.                    if Frame[X,Y]<>false then begin
  158.                         PLOT(X,Y,0); Frame[X,Y]:=false; end;
  159.                end; { for X }
  160.       end; { for Y }
  161.       for X:=1 to DFSize do with DisplayFile[X] do
  162.                                begin
  163.                                   dfOP:=0; dfX:=0;  dfY:=0;
  164.                                   dfA :=0; dfX0:=0; dfY0:=0; dfC:=0; dfM:=0;
  165.                                end;
  166.    END; { ERASE }
  167.  
  168. procedure INITIALIZE;
  169.   var I:   integer;
  170.    BEGIN
  171.       clrscr;
  172.       Height:= HeightEnd - HeightStart;  Width:= WidthEnd - WidthStart;
  173.       ERASE;
  174.    END; { INITIALIZE }
  175.  
  176. function TERMINATE: char;
  177.    BEGIN
  178.       CHOOSE(0,'   Continue   Quit ',['C','Q'],Ch);
  179.       TERMINATE := upcase(Ch);
  180.    END; { TERMINATE }
  181.  
  182. procedure ERROR(S: Str40);
  183.           BEGIN
  184.                gotoXY(1,24); BEEP; write(S); delay(3000); gotoXY(1,24); clreol;
  185.                Ch := TERMINATE;
  186.           END; { ERROR }
  187.  
  188. procedure PUT_POINT(OP,X,Y,A,X0,Y0,Color,Mode: integer);
  189.           BEGIN
  190.                if Free > DFSize then ERROR('DISPLAY FILE FULL');
  191.                with DisplayFile[Free] do
  192.                begin dfOP:=OP;  dfX:=X;     dfY:=Y;
  193.                      dfA:=A;    dfX0:=X0;  dfY0:=Y0;  dfC:=Color;  dfM:=Mode;
  194.                end;
  195.                Free:=Free+1;
  196.           END; { PUT_POINT }
  197.  
  198. procedure GET_POINT(Nth: integer;  var OP,X,Y,A,X0,Y0,C,M:  integer);
  199.           BEGIN
  200.                with DisplayFile[Nth] do
  201.                  begin OP:=DfOP;  X:=DfX;     Y:=DfY;
  202.                        A:=dfA;    X0:=dfX0;  Y0:=dfY0;  Color:=dfC; Mode:=dfM;
  203.                  end;
  204.           END; { GET_POINT }
  205.  
  206. procedure DISPLAY_FILE_ENTER(OP:  integer);
  207.           BEGIN
  208.                PUT_POINT(OP,Xnow,Ynow,A,X0,Y0,C,M);
  209.           END; { DISPLAY_FILE_ENTER }
  210.  
  211. procedure MOVE_ABS(X,Y:  integer);
  212.           BEGIN
  213.                Xnow:=X;  Ynow:=Y;  DISPLAY_FILE_ENTER(1);
  214.                Xwas:=Xnow; Ywas:=Ynow;
  215.           END; { MOVE_ABS }
  216.  
  217. procedure LINE_ABS(X,Y:  integer);
  218.           BEGIN
  219.                Xnow:=X;  Ynow:=Y;  DISPLAY_FILE_ENTER(2)
  220.           END; { LINE_ABS }
  221.  
  222. procedure DOMOVE(X,Y:  integer);
  223.           BEGIN
  224.                 Xwas:=X; Ywas:=Y;
  225.          END; { DOMOVE }
  226.  
  227. procedure DOLINE(X,Y:  integer);
  228.   var  X1,Y1:   integer;
  229.         BEGIN
  230.                X1:=Xwas;  Y1:=Ywas;
  231.                Xwas:=X;   Ywas:=Y;
  232.                DDA(X1,Y1,Xwas,Ywas,Color,0);
  233.         END; { DOLINE }
  234.  
  235. procedure INTERPRET(Start,Count:  integer);
  236.   var  OP,X,Y:     integer;
  237.        Nth:        integer;
  238.         BEGIN
  239.              For Nth:=Start to Start+Count-1 do begin
  240.                  GET_POINT(Nth,OP,X,Y,A,X0,Y0,Color,Mode);
  241. (*
  242. writeln('Nth=',Nth:2,' OP=',OP:2,' X=',X:3,' Y=',Y:3,' C=',Color:2,' M=',Mode:2);
  243. *)
  244.                  if OP=1 then DOMOVE(X,Y)
  245.                    else if OP=2 then DOLINE(X,Y)
  246.                      else if OP=3 then ARCDDA(X0,Y0,A,X,Y,Color,Mode)
  247.                        else ERROR('OP-CODE ERROR');
  248.              end; { For Nth }
  249.            Xnow:=X; Xwas:=X; Ynow:=Y; Ywas:=Y;
  250.         END; { INTERPRET }
  251.  
  252. procedure MAKE_PICTURE_CURRENT(Xo,Yo: integer);
  253.         BEGIN
  254. (*
  255. GOTOXY(1,10); WRITELN('Free=',Free,' ********');
  256. *)
  257.              if Free>1 then INTERPRET(1,Free-1);
  258.              DISPLAY(Xo,Yo);
  259.         END; { MAKE_PICTURE_CURRENT }
  260.  
  261.  
  262. function INPUT_TEXT(What: Str40; L: integer): Str40;
  263.     const   Shade:   char = '0';
  264.     var  Input:   Str40;
  265.          I:       integer;
  266.     BEGIN
  267.     repeat
  268.      gotoXY(1,24); write(What,'? '); for I:=1 to L do write(Shade);
  269.      gotoXY(whereX-L,whereY); read(Input);
  270.      gotoXY(1,24); write('                                      ');
  271.      if length(Input)>L then Beep;
  272.     until length(Input) <= L;
  273.     INPUT_TEXT:=Input;
  274. END; { INPUT_TEXT }
  275.  
  276. procedure PUT_DISK;
  277.   var  FilT:       text;
  278.        FilName:    Str40;
  279.        I:          integer;
  280.   BEGIN
  281.      FilName:=INPUT_TEXT('File Name',12);
  282.      assign(FilT,FilName);
  283.      rewrite(FilT);
  284.            writeln(FilT,Free);
  285.            for I:=1 to Free-1 do with DisplayFile[I] do
  286.                writeln(FilT,dfOP:9,dfX:9,dfY:9,dfA:9,dfX0:9,dfY0:9,dfC:9,dfM:9);
  287.      close(FilT);
  288. END; { PUT_DISK }
  289.  
  290. procedure GET_DISK;
  291.   var  FilT:       text;
  292.        FilName:    string[12];
  293.        OP,X,Y:     real;
  294.        I:          integer;
  295.        OK:         boolean;
  296.   label Start;
  297.   BEGIN
  298.   Start:   FilName:=INPUT_TEXT('File Name',12); OK:=false;
  299.            repeat
  300.              assign(FilT,FilName);    {$I-} reset(FilT) {$I+};    OK:=(ioresult=0);
  301.              if not OK then begin
  302.                  gotoXY(1,24); write('Can''t find that FILE NAME  ! !'); BEEP; delay(2000);
  303.                  gotoXY(1,24); clreol; goto Start; end;
  304.            until OK;  OK:=false;
  305.            readln(FilT,Free);
  306.            for I:=1 to Free-1 do with DisplayFile[I] do
  307.               readln(FilT,dfOP,dfX,dfY,dfA,dfX0,dfY0,dfC,dfM);
  308.            close(FilT);
  309.            Color:=2; MAKE_PICTURE_CURRENT(0,0);
  310. END; { GET_DISK }
  311.  
  312.  
  313. procedure DO_DRAW;
  314. const  M:   array[1..19] of string[9] =
  315.                   ('Move','Line','Xline','Text','','Battery','Sources','','Resistors','Capacitor',
  316.                    'Inductors','','','','rUn','Put Disk','Get Disk','Erase','Quit');
  317. var    I,J,P:   integer;
  318.  
  319.   Procedure PLUS(X,Y,Color,Mode:  integer);
  320.   var X1,Y1,X2,Y2:  integer;
  321.    BEGIN
  322.         X1:=X-2; X2:=X+2; Y1:=Y-2; Y2:=Y+2;
  323.         DDA(X1,Y,X2,Y,Color,Mode);
  324.         if Mode>=0 then begin MOVE_ABS(X1,Y);  LINE_ABS(X2,Y); end;
  325.         DDA(X,Y1,X,Y2,Color,Mode);
  326.         if Mode>=0 then begin MOVE_ABS(X,Y1);  LINE_ABS(X,Y2); end;
  327.    END; { PLUS }
  328.  
  329. Procedure MINUS(X,Y,Color,Mode:  integer);
  330.   var X1,Y1,X2,Y2:  integer;
  331.    BEGIN
  332.         X1:=X-2; X2:=X+2;
  333.         DDA(X1,Y,X2,Y,Color,Mode);
  334.         if Mode>=0 then begin MOVE_ABS(X1,Y);  LINE_ABS(X2,Y); end;
  335.    END; { MINUS }
  336.  
  337.  Procedure AWAIT_STROKE;
  338.  var InKey:     Char;
  339.      FuncFlag:  Boolean;    { Indicates function key }
  340.  
  341.   Procedure INITIALIZE_DRAW;
  342.   BEGIN
  343.      Graphics;
  344.      ClearScreen;
  345.      palette(3);
  346.      gotoXY(71,1);
  347.      write(chr(27),chr(0),chr(24),chr(0),chr(25),chr(0),chr(26)); lowvideo;
  348.      for I:=1 to 19 do begin
  349.          gotoXY(71,I+2);
  350.              if (I=12) or (I=15) then P:=2 else P:=1;
  351.          for J:=1 to length(M[I]) do begin
  352.              if J=P then highvideo else lowvideo;
  353.              write(copy(M[I],J,1));
  354.          end; { for J }
  355.          writeln;
  356.      end; { for I }
  357.      graphwindow(0,0,Width,Height);
  358.      fillscreen(1);
  359.      Color:=2; Mode:=-1;
  360.      PLUS(58,27,Color,-1); PLUS(116,27,Color,-1); PLUS(174,27,Color,-1);
  361.      PLUS(58,85,Color,-1); PLUS(116,85,Color,-1); PLUS(174,85,Color,-1);
  362.      PLUS(58,143,Color,-1); PLUS(116,143,Color,-1); PLUS(174,143,Color,-1);
  363.      Xnow:=58; Xwas:=Xnow;  Ynow:=27; Ywas:=Ynow;
  364.      plot(Xnow,Ynow,2);  MOVE_ABS(Xnow,Ynow);
  365.   END; { INITIALIZE_DRAW }
  366.  
  367.   Function GET_KEY(var FuncFlag: Boolean): char;
  368.   var ch: char;
  369.   begin
  370.     read(kbd,Ch);
  371.     If (Ch = #27) AND KeyPressed Then  { it must be a function key }
  372.     begin
  373.       read(kbd,Ch);
  374.       FuncFlag := true;
  375.     end
  376.     else FuncFlag := false;
  377.     GET_KEY := Ch;
  378.   END; { GET_KEY }
  379.  
  380.   Procedure ALPHANUMERIC;
  381.     var  Input:   Str40;
  382.     BEGIN
  383.          Input:=INPUT_TEXT('What',12);
  384.          gotoXY(round(0.5+Xnow/8),round(0.5+Ynow/8)); write(Input);
  385. (*
  386.     Xnow:=Xnow+8*length(Input); Xwas:=Xnow; Ywas:=Ynow; plot(Xwas,Ywas,2);
  387.     MOVE_ABS(Xnow,Ynow); plot(Xwas,Ywas,2);
  388.     for I:=1 to length(Input) do
  389.     begin
  390.        DISPLAY_FILE_ENTER(ord(copy(Input,I,1)));
  391.        Xnow:=Xnow+8;
  392.     end;
  393. *)
  394.   END; { ALPHANUMERIC }
  395.  
  396.   procedure BATTERY;
  397.   var  X1,Y1,X2,Y2,X3,Y3,X4,Y4,X5,Y5,X6,Y6,Xhold,Yhold:  integer;
  398.   BEGIN
  399.           Color:=0; Xhold:=Xnow; Yhold:=Ynow;
  400.           if (Direction='D') or (Direction='U') then
  401.            begin
  402.               CHOOSE(23,'   +Up   -Up ',['+','-'],Ch);
  403.               if Direction='D' then
  404.               begin
  405.                 Yhold:=Ynow+4;
  406.                 if Ch='+' then
  407.                 begin
  408.                   X1:=Xnow-5; X3:=X1;   X5:=X1+2;    X2:=Xnow+5; X4:=X2; X6:=X2-2;
  409.                   Y1:=Ynow;   Y3:=Y1+1; Y5:=Y1+3;    Y2:=Y1;     Y4:=Y3; Y6:=Y5;
  410.                 end
  411.                 else if Ch='-' then
  412.                 begin
  413.                   X1:=Xnow-3; X3:=Xnow-5;   X5:=X3;    X2:=Xnow+3; X4:=Xnow+5; X6:=X4;
  414.                   Y1:=Ynow;   Y3:=Y1+2; Y5:=Y1+3;    Y2:=Y1;     Y4:=Y3; Y6:=Y5;
  415.                 end;
  416.               end
  417.               else if Direction='U' then
  418.               begin
  419.                 Yhold:=Ynow-4;
  420.                 if Ch='+' then
  421.                 begin
  422.                   X1:=Xnow-5; X3:=X1;   X5:=X1+2;    X2:=Xnow+5; X4:=X2; X6:=X2-2;
  423.                   Y1:=Ynow-2;   Y3:=Y1-1; Y5:=Ynow;    Y2:=Y1;     Y4:=Y3; Y6:=Y5;
  424.                 end
  425.                 else if Ch='-' then
  426.                 begin
  427.                   X1:=Xnow-3; X3:=Xnow-5;   X5:=X3;    X2:=Xnow+3; X4:=Xnow+5; X6:=X4;
  428.                   Y1:=Ynow-3;   Y3:=Ynow-1; Y5:=Ynow;    Y2:=Y1;     Y4:=Y3; Y6:=Y5;
  429.                 end;
  430.               end;
  431.            end;
  432.           if (Direction='R') or (Direction='L') then
  433.           begin
  434.               CHOOSE(23,'   +Right  -Right ',['+','-'],Ch);
  435.               if Direction='R' then
  436.               begin
  437.                Xhold:=Xnow+4;
  438.                if Ch='+' then
  439.                begin
  440.                   X1:=Xnow; X3:=Xnow+2;   X5:=Xnow+3;    X2:=X1; X4:=X3; X6:=X5;
  441.                   Y1:=Ynow-2;   Y3:=Ynow-4; Y5:=Y3;    Y2:=Ynow+2;     Y4:=Ynow+4; Y6:=Y4;
  442.                end
  443.                else if Ch='-' then
  444.                begin
  445.                   X1:=Xnow; X3:=Xnow+1;   X5:=Xnow+3;    X2:=X1; X4:=X3; X6:=X5;
  446.                   Y1:=Ynow-4;   Y3:=Y1; Y5:=Ynow-2;    Y2:=Ynow+4; Y4:=Y2; Y6:=Ynow+2;
  447.                end;
  448.               end
  449.               else if Direction='L' then
  450.               begin
  451.                Xhold:=Xnow-4;
  452.                if Ch='+' then
  453.                begin
  454.                   X1:=Xnow; X3:=Xnow-1;   X5:=Xnow-3;    X2:=X1; X4:=X3; X6:=X5;
  455.                   Y1:=Ynow-4;   Y3:=Y1; Y5:=Ynow-2;    Y2:=Ynow+4; Y4:=Y2; Y6:=Ynow+2;
  456.                end
  457.                else if Ch='-' then
  458.                begin
  459.                   X1:=Xnow-3; X3:=Xnow-2;   X5:=Xnow;    X2:=X1; X4:=X3; X6:=X5;
  460.                   Y1:=Ynow-4;   Y3:=Y1; Y5:=Ynow-2;    Y2:=Ynow+4; Y4:=Y2; Y6:=Ynow+2;
  461.                end;
  462.               end;
  463.           end;
  464.        DDA(X1,Y1,X2,Y2,Color,0); DDA(X3,Y3,X4,Y4,Color,0); DDA(X5,Y5,X6,Y6,Color,0);
  465.        MOVE_ABS(X1,Y1); LINE_ABS(X2,Y2);
  466.        MOVE_ABS(X3,Y3); LINE_ABS(X4,Y4);
  467.        MOVE_ABS(X5,Y5); LINE_ABS(X6,Y6);
  468.        Xnow:=Xhold; Ynow:=Yhold; Xwas:=Xnow; Ywas:=Ynow;
  469.        MOVE_ABS(Xnow,Ynow); PLOT(Xnow,Ynow,2);
  470.   END; { BATTERY }
  471.  
  472.   procedure SOURCES;
  473.    var Xhold,Yhold:  integer;
  474.      procedure POLARITY;
  475.       var Xhold,Yhold:  integer;
  476.      BEGIN
  477.           Xhold:=Xnow; Yhold:=Ynow;
  478.           if (Direction='D') or (Direction='U') then
  479.            begin
  480.               CHOOSE(23,'   +Up   -Up   ^Up   |Up ',['+','-','^','|'],Ch);
  481.               if Direction='D' then
  482.               begin
  483.                if Ch='+' then begin PLUS(Xhold,Yhold+5,Color,0); MINUS(Xhold,Yhold+13,Color,0); end;
  484.                if Ch='-' then begin MINUS(Xhold,Yhold+5,Color,0); PLUS(Xhold,Yhold+13,Color,0); end;
  485.                if Ch='^' then
  486.                   begin DDA(Xhold,Yhold+14,Xhold,Yhold+3,Color,0);
  487.                         DDA(Xhold,Yhold+3,Xhold+4,Yhold+7,Color,0);
  488.                         DDA(Xhold,Yhold+3,Xhold-4,Yhold+7,Color,0);
  489.                         MOVE_ABS(Xhold,Yhold+14); LINE_ABS(Xhold,Yhold+3);
  490.                         MOVE_ABS(Xhold,Yhold+3); LINE_ABS(Xhold+4,Yhold+7);
  491.                         MOVE_ABS(Xhold,Yhold+3); LINE_ABS(Xhold-4,Yhold+7);
  492.                   end;
  493.                if Ch='|' then
  494.                   begin DDA(Xhold,Yhold+14,Xhold,Yhold+3,Color,0);
  495.                         DDA(Xhold,Yhold+14,Xhold+4,Yhold+10,Color,0);
  496.                         DDA(Xhold,Yhold+14,Xhold-4,Yhold+10,Color,0);
  497.                         MOVE_ABS(Xhold,Yhold+14); LINE_ABS(Xhold,Yhold+3);
  498.                         MOVE_ABS(Xhold,Yhold+14); LINE_ABS(Xhold+4,Yhold+10);
  499.                         MOVE_ABS(Xhold,Yhold+14); LINE_ABS(Xhold-4,Yhold+10);
  500.                   end;
  501.                end
  502.                else if Direction='U' then
  503.                begin
  504.                if Ch='+' then begin MINUS(Xhold,Yhold-5,Color,0); PLUS(Xhold,Yhold-13,Color,0); end;
  505.                if Ch='-' then begin PLUS(Xhold,Yhold-5,Color,0); MINUS(Xhold,Yhold-13,Color,0); end;
  506.                if Ch='^' then
  507.                   begin DDA(Xhold,Yhold-14,Xhold,Yhold-3,Color,0);
  508.                         DDA(Xhold,Yhold-14,Xhold+4,Yhold-10,Color,0);
  509.                         DDA(Xhold,Yhold-14,Xhold-4,Yhold-10,Color,0);
  510.                         MOVE_ABS(Xhold,Yhold-14); LINE_ABS(Xhold,Yhold-3);
  511.                         MOVE_ABS(Xhold,Yhold-14); LINE_ABS(Xhold+4,Yhold-10);
  512.                         MOVE_ABS(Xhold,Yhold-14); LINE_ABS(Xhold-4,Yhold-10);
  513.                   end;
  514.                if Ch='|' then
  515.                   begin DDA(Xhold,Yhold-14,Xhold,Yhold-4,Color,0);
  516.                         DDA(Xhold,Yhold-4,Xhold+4,Yhold-8,Color,0);
  517.                         DDA(Xhold,Yhold-4,Xhold-4,Yhold-8,Color,0);
  518.                         MOVE_ABS(Xhold,Yhold-14); LINE_ABS(Xhold,Yhold-4);
  519.                         MOVE_ABS(Xhold,Yhold-4); LINE_ABS(Xhold+4,Yhold-8);
  520.                         MOVE_ABS(Xhold,Yhold-4); LINE_ABS(Xhold-4,Yhold-8);
  521.                   end;
  522.                end;
  523.            end;
  524.           if (Direction='R') or (Direction='L') then
  525.           begin
  526.               CHOOSE(23,'   +Right  -Right  >Right  <Left ',['+','-','>','<'],Ch);
  527.               if Direction='R' then
  528.               begin
  529.                if Ch='+' then begin PLUS(Xhold+13,Yhold,Color,0); MINUS(Xhold+5,Yhold,Color,0); end;
  530.                if Ch='-' then begin MINUS(Xhold+13,Yhold,Color,0); PLUS(Xhold+5,Yhold,Color,0); end;
  531.                if Ch='>' then
  532.                   begin DDA(Xhold+3,Yhold,Xhold+15,Yhold,Color,0);
  533.                         DDA(Xhold+15,Yhold,Xhold+11,Yhold+4,Color,0);
  534.                         DDA(Xhold+15,Yhold,Xhold+11,Yhold-4,Color,0);
  535.                         MOVE_ABS(Xhold+3,Yhold); LINE_ABS(Xhold+15,Yhold);
  536.                         MOVE_ABS(Xhold+15,Yhold); LINE_ABS(Xhold+11,Yhold+4);
  537.                         MOVE_ABS(Xhold+15,Yhold); LINE_ABS(Xhold+11,Yhold-4);
  538.                   end;
  539.                if Ch='<' then
  540.                   begin DDA(Xhold+3,Yhold,Xhold+16,Yhold,Color,0);
  541.                         DDA(Xhold+3,Yhold,Xhold+7,Yhold+4,Color,0);
  542.                         DDA(Xhold+3,Yhold,Xhold+7,Yhold-4,Color,0);
  543.                         MOVE_ABS(Xhold+3,Yhold); LINE_ABS(Xhold+16,Yhold);
  544.                         MOVE_ABS(Xhold+3,Yhold); LINE_ABS(Xhold+7,Yhold+4);
  545.                         MOVE_ABS(Xhold+3,Yhold); LINE_ABS(Xhold+7,Yhold-4);
  546.                   end;
  547.               end
  548.               else if Direction='L' then
  549.               begin
  550.                if Ch='+' then begin MINUS(Xhold-13,Yhold,Color,0); PLUS(Xhold-5,Yhold,Color,0); end;
  551.                if Ch='-' then begin PLUS(Xhold-13,Yhold,Color,0); MINUS(Xhold-5,Yhold,Color,0); end;
  552.                if Ch='>' then
  553.                   begin DDA(Xhold-3,Yhold,Xhold-16,Yhold,Color,0);
  554.                         DDA(Xhold-3,Yhold,Xhold-7,Yhold+4,Color,0);
  555.                         DDA(Xhold-3,Yhold,Xhold-7,Yhold-4,Color,0);
  556.                         MOVE_ABS(Xhold-3,Yhold); LINE_ABS(Xhold-16,Yhold);
  557.                         MOVE_ABS(Xhold-3,Yhold); LINE_ABS(Xhold-7,Yhold+4);
  558.                         MOVE_ABS(Xhold-3,Yhold); LINE_ABS(Xhold-7,Yhold-4);
  559.                   end;
  560.                if Ch='<' then
  561.                   begin DDA(Xhold-3,Yhold,Xhold-15,Yhold,Color,0);
  562.                         DDA(Xhold-15,Yhold,Xhold-11,Yhold+4,Color,0);
  563.                         DDA(Xhold-15,Yhold,Xhold-11,Yhold-4,Color,0);
  564.                         MOVE_ABS(Xhold-3,Yhold); LINE_ABS(Xhold-15,Yhold);
  565.                         MOVE_ABS(Xhold-15,Yhold); LINE_ABS(Xhold-11,Yhold+4);
  566.                         MOVE_ABS(Xhold-15,Yhold); LINE_ABS(Xhold-11,Yhold-4);
  567.                   end;
  568.               end;
  569.           end;
  570.      END; { POLARITY }
  571.  
  572.   BEGIN  { SOURCES }
  573.      begin
  574. (*
  575.           CHOOSE(23,'   Independent    Controlled ',['I','C'],Ch);
  576. *)
  577.           Mode:=0; Xhold:=Xnow; Yhold:=Ynow;
  578.           if Direction='D' then Ywas:=Ynow+9 else if Direction='U' then Ywas:=Ynow-9
  579.             else if Direction='R' then Xwas:=Xnow+9 else Xwas:=Xnow-9; end;
  580.           ARCDDA (Xwas, Ywas, 360, Xnow, Ynow, Color, Mode);
  581.           PUT_POINT(3,Xnow,Ynow,360,Xwas,Ywas,Color,Mode); Xnow:=Xhold; Ynow:=Yhold;
  582.           POLARITY;
  583.           Xnow:=Xhold; Ynow:=Yhold;
  584.           if Direction='D' then Ynow:=Ynow+19 else if Direction='U' then Ynow:=Ynow-19
  585.             else if Direction='R' then Xnow:=Xnow+19 else Xnow:=Xnow-19;
  586.           Color:=2; Xwas:=Xnow; Ywas:=Ynow;
  587.           plot(Xnow,Ynow,Color); MOVE_ABS(Xnow,Ynow);
  588.   END; { SOURCES }
  589.  
  590.   procedure RESISTORS;
  591.   var  X1,Y1,X2,Y2,Xhold,Yhold:  integer;
  592.   BEGIN
  593.           Xhold:=Xnow; Yhold:=Ynow;
  594.           if Direction='D' then begin X1:=Xnow-5; Y1:=Ynow+5; X2:=Xnow+6; Y2:=Ynow+10; Yhold:=Yhold+16; end
  595.            else if Direction='U' then begin X1:=Xnow+5; Y1:=Ynow-5; X2:=Xnow-6; Y2:=Ynow-10; Yhold:=Yhold-16; end
  596.             else if Direction='R' then begin X1:=Xnow+5; Y1:=Ynow-5; X2:=Xnow+10; Y2:=Ynow+6; Xhold:=Xhold+16; end
  597.              else if Direction='L' then begin X1:=Xnow-5; Y1:=Ynow+5; X2:=Xnow-10; Y2:=Ynow-6; Xhold:=Xhold-16; end;
  598.           DDA(Xwas,Ywas,X1,Y1,Color,0); DDA(X1,Y1,X2,Y2,Color,0); DDA(X2,Y2,Xhold,Yhold,Color,0);
  599.           LINE_ABS(X1,Y1);              LINE_ABS(X2,Y2);          LINE_ABS(Xhold,Yhold);
  600.           Xnow:=Xhold; Ynow:=Yhold; Xwas:=Xnow; Ywas:=Ynow;
  601.           MOVE_ABS(Xnow,Ynow); PLOT(Xnow,Ynow,2);
  602.   END; { RESISTORS }
  603.  
  604.   procedure CAPACITORS;
  605.    var   X1,Y1,X2,Y2,Xhold,Yhold:  integer;
  606.   BEGIN
  607.           Xhold:=Xnow; Yhold:=Ynow;
  608.           if (Direction='D') or (Direction='U') then
  609.            begin
  610.               X1:=Xhold-5; X2:=Xhold+5;
  611.               if Direction='D' then
  612.               begin
  613.                   DDA(X1,Yhold,X2,Yhold,Color,0); DDA(X1,Yhold+1,X2,Yhold+1,Color,0);
  614.                   MOVE_ABS(X1,Yhold); LINE_ABS(X2,Yhold); MOVE_ABS(X1,Yhold+1); LINE_ABS(X2,Yhold+1);
  615.                   DDA(X1,Yhold+3,X2,Yhold+3,Color,0); DDA(X1,Yhold+4,X2,Yhold+4,Color,0);
  616.                   MOVE_ABS(X1,Yhold+3); LINE_ABS(X2,Yhold+3); MOVE_ABS(X1,Yhold+4); LINE_ABS(X2,Yhold+4);
  617.                   Ynow:=Yhold+5; Ywas:=Ynow; Xnow:=Xhold; Xwas:=Xnow;
  618.                   MOVE_ABS(Xnow,Ynow);
  619.               end
  620.               else
  621.               begin
  622.                   DDA(X1,Yhold,X2,Yhold,Color,0); DDA(X1,Yhold-1,X2,Yhold-1,Color,0);
  623.                   MOVE_ABS(X1,Yhold); LINE_ABS(X2,Yhold); MOVE_ABS(X1,Yhold-1); LINE_ABS(X2,Yhold-1);
  624.                   DDA(X1,Yhold-3,X2,Yhold-3,Color,0); DDA(X1,Yhold-4,X2,Yhold-4,Color,0);
  625.                   MOVE_ABS(X1,Yhold-3); LINE_ABS(X2,Yhold-3); MOVE_ABS(X1,Yhold-4); LINE_ABS(X2,Yhold-4);
  626.                   Xnow:=Xhold; Xwas:=Xnow; Ynow:=Yhold-5; Ywas:=Ynow;
  627.               end;
  628.            end
  629.            else if (Direction='R') or (Direction='L') then
  630.            begin
  631.               Y1:=Ynow-5; Y2:=Ynow+5;
  632.               if Direction='R' then
  633.               begin
  634.                 DDA(Xhold,Y1,Xhold,Y2,Color,0); DDA(Xhold+1,Y1,Xhold+1,Y2,Color,0);
  635.                 MOVE_ABS(Xhold,Y1); LINE_ABS(Xhold,Y2); MOVE_ABS(Xhold+1,Y1); LINE_ABS(Xhold+1,Y2);
  636.                 DDA(Xhold+3,Y1,Xhold+3,Y2,Color,0); DDA(Xhold+4,Y1,Xhold+4,Y2,Color,0);
  637.                 MOVE_ABS(Xhold+3,Y1); LINE_ABS(Xhold+3,Y2); MOVE_ABS(Xhold+4,Y1); LINE_ABS(Xhold+4,Y2);
  638.                 Xnow:=Xhold+5; Xwas:=Xnow; Ynow:=Yhold; Ywas:=Ynow;
  639.               end
  640.               else
  641.               begin
  642.                 DDA(Xhold,Y1,Xhold,Y2,Color,0); DDA(Xhold-1,Y1,Xhold-1,Y2,Color,0);
  643.                 MOVE_ABS(Xhold,Y1); LINE_ABS(Xhold,Y2); MOVE_ABS(Xhold-1,Y1); LINE_ABS(Xhold-1,Y2);
  644.                 DDA(Xhold-3,Y1,Xhold-3,Y2,Color,0); DDA(Xhold-4,Y1,Xhold-4,Y2,Color,0);
  645.                 MOVE_ABS(Xhold-3,Y1); LINE_ABS(Xhold-3,Y2); MOVE_ABS(Xhold-4,Y1); LINE_ABS(Xhold-4,Y2);
  646.                 Xnow:=Xhold-5; Xwas:=Xnow; Ynow:=Yhold; Ywas:=Ynow;
  647.               end;
  648.            end;
  649.            MOVE_ABS(Xnow,Ynow); plot(Xnow,Ynow,2);
  650.   END; { CAPACITORS }
  651.  
  652.   procedure INDUCTORS;
  653.    var   cX,cY,Step:  integer;
  654.   BEGIN
  655.           Color:=0; Mode:=0; Step:=5;
  656.           if (Direction='D') or (Direction='U') then
  657.            begin
  658.                 if Direction='D' then
  659.                 begin
  660.                   cX:=Xnow; cY:=Ynow+Step;
  661.                   ARCDDA(cX,cY,240,Xnow,Ynow,Color,0);
  662.                   ARCDDA(cX,cY+Step-1,230,Xnow-Step+1,Ynow+Step+1,Color,0);
  663.                   PUT_POINT(3,Xnow,Ynow,240,cX,cY,Color,Mode);
  664.                   PUT_POINT(3,Xnow-Step+1,Ynow+Step+1,230,cX,cY+Step-1,Color,Mode);
  665.                   Ynow:=Ynow+14; Ywas:=Ynow;
  666.                 end
  667.                 else
  668.                 begin
  669.                   cX:=Xnow; cY:=Ynow-Step;
  670.                   ARCDDA(cX,cY,240,Xnow,Ynow,Color,0);
  671.                   ARCDDA(cX,cY-Step+1,230,Xnow+Step-1,Ynow-Step-1,Color,0);
  672.                   PUT_POINT(3,Xnow,Ynow,240,cX,cY,Color,Mode);
  673.                   PUT_POINT(3,Xnow+Step-1,Ynow-Step-1,230,cX,cY-Step+1,Color,Mode);
  674.                   Ynow:=Ynow-14; Ywas:=Ynow;
  675.                 end;
  676.            end
  677.            else if (Direction='R') or (Direction='L') then
  678.            begin
  679.                 if Direction='R' then
  680.                 begin
  681.                   cX:=Xnow+Step; cY:=Ynow;
  682.                   ARCDDA(cX,cY,240,Xnow,Ynow,Color,0);
  683.                   ARCDDA(cX+Step-1,cY,230,Xnow+Step+1,Ynow+Step-1,Color,0);
  684.                   PUT_POINT(3,Xnow,Ynow,240,cX,cY,Color,Mode);
  685.                   PUT_POINT(3,Xnow+Step+1,Ynow+Step-1,230,cX+Step-1,cY,Color,Mode);
  686.                   Xnow:=Xnow+14; Xwas:=Xnow;
  687.                 end
  688.                 else
  689.                 begin
  690.                   cX:=Xnow-Step; cY:=Ynow;
  691.                   ARCDDA(cX,cY,240,Xnow,Ynow,Color,0);
  692.                   ARCDDA(cX-Step+1,cY,230,Xnow-Step-1,Ynow-Step+1,Color,0);
  693.                   PUT_POINT(3,Xnow,Ynow,240,cX,cY,Color,Mode);
  694.                   PUT_POINT(3,Xnow-Step-1,Ynow-Step+1,230,cX-Step+1,cY,Color,Mode);
  695.                   Xnow:=Xnow-14; Xwas:=Xnow;
  696.                 end;
  697.            end;
  698.            MOVE_ABS(Xnow,Ynow); plot(Xnow,Ynow,2);
  699.   END; { INDUCTORS }
  700.  
  701. BEGIN  { DO_DRAW }
  702.   INITIALIZE_DRAW;
  703.   repeat
  704.    Inkey := GET_KEY(FuncFlag);
  705.    If FuncFlag then begin
  706.     plot(Xnow,Ynow,1); Color:=0; C:=0;
  707.     case Upcase(Inkey) of
  708.       'H': begin if Ynow > 0 then Ynow:=Ynow-1 else BEEP;
  709.                  plot(Xnow,Ynow,2); end;
  710.       'P': begin if Ynow < 171 then Ynow:=Ynow+1 else BEEP;
  711.                  plot(Xnow,Ynow,2); end;
  712.       'M': begin if Xnow < 231 then Xnow:=Xnow+1 else BEEP;
  713.                  plot(Xnow,Ynow,2); end;
  714.       'K': begin if Xnow > 0 then Xnow:=Xnow-1 else BEEP;
  715.                  plot(Xnow,Ynow,2); end;
  716.       'G': begin Xnow:=115; Ynow:=85; plot(Xnow,Ynow,2); end;
  717.     end;
  718.    end
  719.    else
  720.    case upcase(InKey) of
  721.      'M': MOVE_ABS(Xnow,Ynow);
  722.      'L': begin DDA(Xwas,Ywas,Xnow,Ynow,Color,0);
  723.                 if Ynow>Ywas then Direction:='D' else if Ynow<Ywas then Direction:='U'
  724.                   else if Xnow>Xwas then Direction:='R' else if Xnow<Xwas then Direction:='L';
  725.                 LINE_ABS(Xnow,Ynow);
  726.                 Xwas:=Xnow; Ywas:=Ynow;
  727.           end;
  728.      'X': begin
  729.                 Color:=1; DDA(Xwas,Ywas,Xnow,Ynow,Color,0);
  730.                 Xwas:=Xnow; Ywas:=Ynow; Color:=0;
  731.           end;
  732.      'T': ALPHANUMERIC;
  733.      'B': BATTERY;
  734.      'S': SOURCES;
  735.      'R': RESISTORS;
  736.      'C': CAPACITORS;
  737.      'I': INDUCTORS;
  738.      'P': PUT_DISK;
  739.      'G': GET_DISK;
  740.      'U': begin
  741.                textmode; clrscr; graphics; palette(2);
  742.                MAKE_PICTURE_CURRENT(44,14); palette(3);
  743.                Ch:=TERMINATE;
  744.                if Ch<>'Q' then INITIALIZE_DRAW
  745.                 else begin CLEARSCREEN; TEXTMODE; halt; end;
  746.                MAKE_PICTURE_CURRENT(0,0);
  747.                plot(Xnow,Ynow,2);
  748.           end;
  749.      'E': begin CLEARSCREEN; ERASE; INITIALIZE_DRAW; end;
  750.      end;   { case }
  751.   until UpCase(Inkey) in ['Q',#27];
  752.  end;  { AWAIT_STROKE }
  753.  
  754.   BEGIN  { DO_DRAW }
  755.    AWAIT_STROKE;
  756. END; { DO_DRAW }
  757.  
  758. {mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm}
  759. BEGIN
  760.      INITIALIZE;
  761.   repeat
  762.      DO_DRAW;
  763.      Ch:=TERMINATE;
  764.   until Ch<>'C';
  765.      CLEARSCREEN;
  766.      TEXTMODE;
  767. END.
  768.