program framer;

uses sysutils;

type
  str60  = string[60];
  str30  = string[30];
  all_char = set of ' '..'}';

var
   d  : array[1..50,1..50] of real;  { Matrix to solve }
   b  : array[1..40,1..6]  of real;  { Beam Data }
   c  : array[1..40,1..2]  of real;  { column data }
   e  : array[1..10,1..4]  of real;  { wind loading }
   ld : array[1..50,1..4]  of real;  { loads, story, load, location, length }
   mp : array[1..20,1..2]  of integer; { Macro pointer of loadings }
   r  : array[0..400] of real;  { array of moments, deflections }

   s,p   : integer;  { # stories, # portals }
   q     : integer;  { size of matrix to solve }
   z     : integer;  { type of base joints 1 or 2 }
   l2,l3 : real;   { total height, total width feet }

   lp    : integer;  { load pointer, points to next row in load matrix }
   mc    : integer;  { macro counter, multible loads per macro }
   lc    : integer;  { load count of loads applied }
   lm    : array[1..50] of integer; { save load#'s of all loads applied }
   psl   : integer;  { plot scale member length }
   psm   : integer;  { plot scale moment kip-ft/inch}
   proj_descrip : str60;
   load_descrip : str60;
   time         : str30;
   option       : integer;
   shear        : boolean;

const 
    puf = 96; { plotter unit factor (dots per inch), Epson mini plotter was 254 units/dots per inch, 
					Video screen is 96 dots per inch (dpi)  see: https://www.pixelto.net/px-to-inches-converter 
					laser printer dpi is high: 300, 600 or even 2400
			  }
var
	page_width :integer = 1800;
	page_height :integer= 1100;

var 
	cur_x:integer;
	cur_y:integer;
	char_height:integer;
	char_width:integer;
	char_draw_angle:integer;
	draw_pen:integer;
	plot_str:AnsiString;
	gX,gY:real; { save for mouseover display }
	gWhat:string; { show what member the mouseover display is for }
	mouseover_enabled:boolean=false;
	tabulation_str:AnsiString;
	tab_cnt:integer=0;  { used to make <span id> to focus the tabulation elements on mouseover }

procedure MA(x:integer; y:integer);
	begin
		cur_x:=x;
		cur_y:=y;
	end;

procedure DA(x:integer; y:integer);
	var color:string = 'black';
		thickness:integer =1;

	begin

		case draw_pen of
			1: begin color:='black'; thickness:=1; end;
			2: begin color:='red';  thickness:=1; end;
			3: begin color:='blue'; thickness:=2; end;
		end;
		
		{ the svg y-origin is at top of page, not at bottom
				X
			o--------------->
            | (0,0)
            |
		  Y	|           (100,100)
			|              o
			v


			want Y origin at bottom of page
            ^
			|              o
			|           (100,100) 
			|
		  Y	|
			| (0,0)
			o---------------->
				X

		 }

		{ use an invisible circle for easier mouse snap ofr coordinate display }
		if mouseover_enabled then
		begin
			tab_cnt:=tab_cnt+1;

			appendStr( plot_str, format('<circle cx="%d" cy="%d" r="5" fill="transparent" fill-opacity="0" onmouseover="showTab(%d);" />',
											[x, page_height - y, 
												tab_cnt]) );

			appendStr (tabulation_str, format('<span id="tab%d">%3.1f  %7.3f</span><br>', [tab_cnt, gX, gY]) );
		end;

		appendStr ( plot_str, format('<line x1="%d" y1="%d" x2="%d" y2="%d"  style="stroke:%s; stroke-width:%dpx;"/> ',
										[cur_x, page_height - cur_y, { set Y origin at bottom }
										     x, page_height - y, 
											 color,
											 thickness ]) ) ; 
		cur_x:=x;
		cur_y:=y;
	end;

procedure LA( text:string);
	begin
		appendStr( plot_str, format('<text x="%d" y="%d">%s</text>', [cur_x, page_height-cur_y, text]) );
	end;

procedure SI(h:integer; w:integer); { set char height width }
	begin
		char_height:=h;
		char_width:=w;
	end;

procedure DI(a:integer); { set char draw angle }
	begin
		char_draw_angle:=a;
	end;

procedure SP(pen:integer);
	begin
		draw_pen:=pen;
	end;

function  when:string;
  begin
	when:=DateTimeToStr(Now)
  End;

function parse_up(s:str60):str60;
  var i: integer;
  begin
    for i:=1 to length(s) do s[i]:=upcase(s[i]);
    parse_up:=s;
  end;

function pw(n:real; p:integer):real;
  var i:integer;
      a:real;
  begin
    a:=1;
    for i:=1 to p do a:=a*n;
    pw:=a;
  end;

procedure readr( var r:real);
  var
    i : integer;
  begin
    repeat
      {$I-} read(r); {$I+} i:=IOResult;
      if I<>0 then readln;
    until i=0;
  end;

procedure readi( var r:integer);
  var
    i : integer;
  begin
    repeat
      {$I-} read(r); {$I+} i:=IOResult;
      if I<>0 then readln;
    until i=0;
  end;

procedure reads(var s:str60);
  begin
    read(s);
  end;

procedure signon;
  begin
    writeln('RIGID FRAME ANALYSIS  By Gary Argraves - 8701.15');
    writeln;
    write('Project Designation ? '); reads(proj_descrip);
    writeln(proj_descrip);
    writeln('  Date: ',time);
    writeln;
  end;

 procedure fatal_err(s:str60);
   begin
     writeln(s);
     halt;
   end;

procedure initial_var;
  var i,j:integer;
  begin
    lp:=1;
    mc:=0;
    lc:=0;
    for i:=1 to 50 do for j:=1 to 50 do d[i,j]:=0;
    for i:=1 to 40 do for j:=1 to 6 do b[i,j]:=0;
    for i:=1 to 40 do for j:=1 to 2 do c[i,j]:=0;
    for i:=1 to 10 do for j:=1 to 4 do e[i,j]:=0;
    for i:=1 to 50 do for j:=1 to 4 do ld[i,j]:=0;
    for i:=1 to 20 do for j:=1 to 2 do mp[i,j]:=0;
    for i:=1 to 50 do lm[i]:=0;
  end;

procedure get_size;
  begin

     writeln('___INPUT FRAME SIZE___');
     write('How many Stories ? ':25); readi(s);  writeln(s:6);
     write('How many Portals ? ':25); readi(p);  writeln(p:6);
     writeln;
     q:=(s+1)*(p+1)+s;
  end;

procedure get_geometry;
  var
   i,j,z2  : integer;
   l       : real;
  begin
    writeln('___INPUT FRAME GEOMETRY (units=feet)___');
    writeln('   Input story heights.');
    l3:=0;
    for i:=1 to s do
      begin
        write('Story #':12,i:2,' ? '); readr(l); writeln(l:8:2);
        l3:=l3+l;
        z2:=(p+1)*(s-i)+1;
        for j:=z2 to z2+p do c[j,2]:=l;
      end;
    writeln('  Total height=',l3:7:2);
    writeln;
    writeln('   Input beam lengths.');
    l2:=0;
    for i:=1 to p do
      begin
        write('Beam #':12,i:2,' ? '); readr(l); writeln(l:8:2);
        l2:=l2+l;
        j:=i; repeat b[j,2]:=l; j:=j+p; until j>i+(s-1)*p;
      end;
    writeln('  Total length=',l2:7:2);
    psl:=5;
    psm:=50;
    while l2/psl>9{inches} do
      begin psl:=psl+10; psm:=psm+100; end; (*** modify scale as required ***)

    writeln;
    write('Page width (pixels) =',page_width:5,' ? '); readi(page_width);
	writeln;
    write('Page height (pixels) =',page_height:5,' ? '); readi(page_height);

	writeln;
    write('Plot Scale Length (ft/in) =',psl:3,' ? '); readi(psl);
	writeln;
    write('Plot Scale Moment (kip-ft/inch) =',psm:4,' ? '); readi(psm);
	writeln;
	writeln;
  end;

procedure get_member_sizes;  { by story }
  var
    i,j:integer;
  begin
    writeln('___INPUT MEMBER SIZES - Moment of Inertia (I) (units=inch^4)___');
    for i:=1 to s do
      begin
        writeln;
        writeln('STORY #':12,i:2);
        writeln('-------':12,'--');
        for j:=1 to p do
          begin
            write('Beam #':12,j:2,' ? ');
            readr(b[j+p*(s-i),1]); writeln(b[j+p*(s-i),1]:10:2);
          end;
        for j:=1 to p+1 do
          begin
            write('Column #':12,j:2,' ? ');
            readr(c[j+(s-i)*(p+1),1]); writeln(c[j+(s-i)*(p+1),1]:10:2);
          end;
      end;
    writeln;
  end;

procedure get_base_joint_type;
  begin
    writeln('___BASE JOINT TYPE___');
    writeln('1. Fixed ':15);
    writeln('2. Pinned':15);
    repeat
      write('Enter 1 or 2 ? ':12); readi(z); writeln(z:3);;
    until z in [1,2];
    writeln;
  end;

procedure get_macro_loads;
  var
    i     : integer;
    w,j,k : real;    { load parameters }
    l4    : real;
  begin
    writeln('  ___________ MACRO LOAD DEFINITION ____________');
    writeln;
    writeln('            +-A--+---C---+');
    writeln('         W  !    #########--W');
    writeln('          \ ====================== -- Story 2');
    writeln('        -+-#I      I      I      I');
    writeln('         | #I      I      I      I');
    writeln('      C--| #I      I      I      I');
    writeln('         | #====================== -- Story 1');
    writeln('        -+-#I      I      I      I');
    writeln('      A--|  I  P1  I  P2  I  P3  I');
    writeln('       __|__I______I______I______I___ Ground');
    writeln;
    writeln('  S=0 :Lateral Load   S=-1 :Next Macro Definition');
    writeln('  S>0 :Gravity Load   S=-2 :Quit Macro Definition');
    writeln;
(*    if lp<1 then lp:=1; *)
    repeat
      mc:=mc+1;
      mp[mc,1]:=lp;
      repeat
        writeln('Macro #':12,mc:2,'  Load #',lp:2);
        writeln('-------':12,'--','  ------','--');
        write('Enter Story # S=? ':22); readi(i); writeln(i:5);
        if (i>s) then fatal_err('*** Error: Incorrect stories number ***');
        if i=0 then l4:=l3 else l4:=l2;
        if i>=0 then
          begin
             write('Intensity W=? ':22); readr(w);  writeln(w:8:2);
             write('Location  A=? ':22); readr(j);  writeln(j:8:2);
             write('Length    C=? ':22); readr(k);  writeln(k:8:2);
             if j+k>l4 then fatal_err('*** Error: A+C> Total Length of Frame ***');
            ld[lp,1]:=i;
            ld[lp,2]:=w;
            ld[lp,3]:=j;
            ld[lp,4]:=k;
            mp[mc,2]:=lp;
            lp:=lp+1; { bump load pointer }
          end
        else if mp[mc,2]=0 then mc:=mc-1;
        writeln;
      until i<0;
    until i<-1;
  end;

procedure apply_macro_loads;
  var
    u,i,m : integer;
    w,j,k,t,t2 : real;

  procedure process_lateral_load; { data, FEM's & Shears }
    var
      h,o   : integer;
      a,b2,c2,l : real;

    begin
     for H:=1 TO S do
       begin
         O:=1+(S-H)*(P+1);                    { o is the column number }
         T:=T+C[O,2];                         { T is the height to top of column }
         T2:=T-C[O,2];                        { T2 is the height to column base }
         IF (J<T) and (J+K>T2) THEN           { Is the load in this section ? }
           begin
             A:=0;                            { Yes, A is the relative start position }
             IF J>T2 THEN A:=J-T2;            { Load starts in from segment beginning }
             B2:=C[O,2]-A;                    { B is the load length in this segment }
             IF J+K<T THEN B2:=J+K-A-T2;      { Load does not go to end of segment }
             L:=C[O,2];                       { L is the column length }
             C2:=A+B2;
             E[H,1]:=E[H,1]-(W*ABS(1/12/sqr(L)*(6*sqr(L)*(sqr(C2)-sqr(A))-8*L*(pw(C2,3)-pw(A,3))+3*(pw(C2,4)-pw(A,4)))));
             E[H,2]:=E[H,2]+(W*ABS(1/12/sqr(L)*(4*L*(pw(C2,3)-pw(A,3))-3*(pw(C2,4)-pw(A,4)))));
             E[H,3]:=E[H,3]+(W*B2*(A+B2/2));
             E[H,4]:=E[H,4]+(W*B2*(L-A-B2/2));
           end;
       end;
    end;

  procedure process_beam_load;  { FEM'S & shears }
    var
      h,o   : integer;
      a,b2,c2,l : real;
    begin
      FOR H:=1 TO P do
        begin
          O:=H+(S-I)*P;
          T:=T+B[O,2];
          T2:=T-B[O,2];
          IF (J<T) and (J+K>T2) THEN
            begin
              A:=0; IF J>T2 THEN A:=J-T2;
              B2:=B[O,2]-A; IF J+K<T THEN B2:=J+K-A-T2;
              L:=B[O,2];
              C2:=A+B2;
              B[O,3]:=B[O,3]-(W*ABS(1/12/sqr(L)*(6*sqr(L)*(sqr(C2)-sqr(A))-8*L*(pw(C2,3)-pw(A,3))+3*(pw(C2,4)-pw(A,4)))));
              B[O,4]:=B[O,4]+(W*ABS(1/12/sqr(L)*(4*L*(pw(C2,3)-pw(A,3))-3*(pw(C2,4)-pw(A,4)))));
              B[O,5]:=B[O,5]+(W*B2*(A+B2/2));
              B[O,6]:=B[O,6]+(W*B2*(L-A-B2/2));
            end;
        end;
    end;

  begin
     writeln('___APPLY LOADS TO FRAME___');
     writeln;
     writeln('  # > 0 :Macro Loading');
     writeln('  # < 0 :Single Load');
     writeln('  # = 0 :Quit loading');
     writeln;
     lc:=0;
     write('Enter Loading Designation ? ');
     readln;
     reads(load_descrip); load_descrip:=parse_up(load_descrip);
     writeln(load_descrip);
     repeat
       write('Enter # ? ');  readi(m); writeln(m:3);
       if (m>0) and (m<=mc) then begin
           for u:=mp[m,1] to mp[m,2] do
             begin
               lc:=lc+1; lm[lc]:=u;  { save all loads applied for moment dia }
               i:=trunc(ld[u,1]); w:=ld[u,2]; j:=ld[u,3]; k:=ld[u,4]; t:=0; t2:=0;
               if i=0 then process_lateral_load else process_beam_load;
             end;
         end
       else if (m<0) and (m>-lp) then
              begin
                u:=abs(m);
                lc:=lc+1; lm[lc]:=u;
                i:=trunc(ld[u,1]); w:=ld[u,2]; j:=ld[u,3]; k:=ld[u,4]; t:=0; t2:=0;
                if i=0 then process_lateral_load else process_beam_load;
              end
            else if m<>0 then fatal_err('*** Error: No such Macro or Load. ***');
     until m=0;
   writeln;
  end;

procedure setup_matrix;
  var
    z2,u,i,j : integer;
    o : real;
  label
    NEXT_J;
  begin
    Z2:=S+1;
    IF Z=1 THEN Z2:=S;
    for U:=1 TO Z2 do
      for J:=S+U*(1+P)-P TO S+U*(1+P) do
        begin
          IF U<>1 then begin
            O:=C[J-S-P-1,1]/C[J-S-P-1,2];
            IF J=S+U*(1+P)-P THEN D[J,Q+1]:=E[S+2-U,1];
            D[J,J]:=4*O+D[J,J];
            D[J,J-P-1]:=2*O;
            O:=O/C[J-S-P-1,2];
            D[J,U-1]:=6*O+D[J,U-1];
            IF U=S+1 THEN GOTO NEXT_J;
            D[U,J]:=-6*O;
            D[U,J-P-1]:=-6*O;
            D[U,U]:=D[U,U]+12*O/C[J-S-P-1,2];
            D[U,U-1]:=D[U,U-1]-12*O/C[J-S-P-1,2];
            D[J,U]:=D[J,U]-6*O;
          end;
          O:=C[J-S,1]/C[J-S,2];
          IF J=S+U*(1+P)-P THEN D[J,Q+1]:=D[J,Q+1]+E[S+1-U,2];
          D[J,J]:=D[J,J]+4*O;
          IF (Z<>1) or (u<>s) THEN begin
            D[U,J+P+1]:=6*O/C[J-S,2];
            D[J,J+P+1]:=2*O;
          end;
          O:=O/C[J-S,2];
          D[U,J]:=D[U,J]+6*O;
          D[J,U]:=D[J,U]+6*O;
          D[U,U]:=D[U,U]+12*O/C[J-S,2];
          IF U<>S THEN begin
            D[J,U+1]:=D[J,U+1]-6*O;
            D[U,U+1]:=D[U,U+1]-12*O/C[J-S,2];
          end;
          IF J<>S+U*(1+P) THEN begin
            O:=B[J-S-U+1,1]/B[J-S-U+1,2];
            D[J,J+1]:=2*O;
            D[J,J]:=D[J,J]+4*O;
            D[J,Q+1]:=D[J,Q+1]+B[J-S-U+1,3];
          end;
          IF J<>S+U*(1+P)-P THEN begin
            O:=B[J-S-U,1]/B[J-S-U,2];
            D[J,J]:=D[J,J]+4*O;
            D[J,J-1]:=D[J,J-1]+2*O;
            D[J,Q+1]:=D[J,Q+1]+B[J-S-U,4];
          end;
         NEXT_J:
        end{for j};

     FOR I:=1 TO S do begin
       U:=S+1-I;
       D[I,Q+1]:=(E[U,3]+E[U,2]+E[U,1])/C[(I-1)*(P+1)+1,2];
       IF I>1 THEN D[I,Q+1]:=D[I,Q+1]+(E[U+1,4]-E[U+1,2]-E[U+1,1])/C[(I-2)*(P+1)+1,2];
     end;
  end;

procedure solve_matrix;
  var
    i,j,l : integer;
    m : real;
    matrix_err,go,restart : boolean;

begin
  matrix_err:=false;
  repeat
    restart:=false;
    i:=1;
    repeat
      IF (Z=1) and (I=Q-P) THEN exit;
      IF D[I,I]=0 THEN
        begin
          IF I=Q THEN matrix_err:=true;
          if not matrix_err then
            begin
              j:=q; go:=false; restart:=false;
              repeat
                IF (J<>I) and (D[J,I]<>0) then
                  begin
                    FOR L:=1 TO Q+1 do D[I,L]:=D[I,L]+D[J,L];
                    if j>i then go:=true
                    else begin restart:=true; i:=q; end;
                  end;
                j:=j-1;
                if (not go) and (not restart) and (j=0) then matrix_err:=true;
              until (j=0) or (go) or (restart);
            end;
          if matrix_err then fatal_err('*** Matrix solution Error ***');
        end;
      if not restart then
        begin
          M:=D[I,I];
          FOR L:=1 TO Q+1 do D[I,L]:=D[I,L]/M;
            FOR J:=1 TO Q do
              IF J<>I THEN
                begin M:=D[J,I];
                      FOR L:=1 TO Q+1 do D[J,L]:=D[J,L]-M*D[I,L];
                end;
        end;
      i:=i+1;
    until i>q;
  until not restart;
  end;

procedure plot_beam_mom(story,beam:integer; m1,v1:real);
  var
    w,a,c2,l: real;     { load, start load, length load, length beam }
    sb,eb   : real;     { start beam, end beam length }
    sh      : real;     { story height }
    last_lc : integer;  { last load count }
    i,k     : integer;  { general }
    ox,oy   : integer;
    x       : real;     { distance along member }

  procedure find_load(var w,a,c:real);
    var
      sl,el : real; { start load, end load }
    begin
      w:=0;
      while (last_lc<=lc) and (w=0) do
        begin
          if ld[lm[last_lc],1]=story then
            begin
              sl:=ld[lm[last_lc],3];
              el:=sl+ld[lm[last_lc],4];
              if (sl<sb) and (el>sb) then
                begin w:=ld[lm[last_lc],2]; a:=0; c:=el-sb; end
              else if (sl>=sb) and (sl<eb) then
                     begin w:=ld[lm[last_lc],2]; a:=sl-sb; c:=el-sl; end;
              if (w<>0) and (a+c>l) then c:=l-a;
            end;
          last_lc:=last_lc+1;
        end;
    end;

  procedure tab_moments;
    var
      x,mx : real;
    begin
      x:=0.5; k:=1;
      repeat
        mx:=0;
        if (x>a) and (x<=a+c2) then  mx:=w/2*sqr(x-a)
        else if x>a+c2 then mx:=c2*w*(x-(a+c2/2));
        r[k]:=r[k]+mx;
        x:=x+0.5; k:=k+1;
      until x>=l;
      r[k]:=r[k]+c2*w*(l-(a+c2/2));
    end;

  procedure tab_shears;
    var
      x,vx : real;
    begin
      x:=0.5; k:=1;
      repeat
        vx:=0;
        if (x>a) and (x<=a+c2) then  vx:=(x-a)*w
        else if x>a+c2 then vx:=c2*w;
        r[k]:=r[k]-vx;
        x:=x+0.5; k:=k+1;
      until x>=l;
      r[k]:=r[k]-c2*w;
    end;


  begin
    sb:=0; for i:=1 to beam-1 do sb:=sb+b[p*(s-story)+i,2];
    eb:=sb+b[p*(s-story)+beam,2];
    sh:=0; for i:=1 to story do sh:=sh+c[(p+1)*(s-i)+1,2];
    l:=eb-sb;
    last_lc:=1;
    for i:=0 to 200 do r[i]:=0;
    i:=0; x:=0;
    repeat
      if shear then r[i]:=v1 else r[i]:=m1-v1*x;
      i:=i+1; x:=x+0.5;
    until x>=l; if shear then r[i]:=v1 else r[i]:=m1-v1*l;
    repeat
      find_load(w,a,c2);
      if w<>0 then begin if shear then tab_shears else tab_moments; end;
    until last_lc>lc;
    k:=i;
    ox:=round( ( sb/psl + 0.20*(beam)+0.50) *puf);
    oy:=round( ( sh/psl + 0.20*(story)    ) *puf);

	{ draw the beam, l is length, 1=black }
	mouseover_enabled:=false; {disable onmouseover }
    SP(1); 
    MA(ox, oy);
    DA(round(l/psl*puf)+ox, oy);

	{ value at 0 feet is displayed at the Y-value point, not at y=0 }
    SP(1); 
    MA(ox, oy);
    DA(ox, round(r[0]/psm*puf)+oy); 

	{ draw the shear or the moment; which ever is selected, 2=red, 3=blue }
	mouseover_enabled:=true; {enable onmouseover }
	gWhat := format('story=%d beam=%d',[story, beam]);
	if shear then appendStr (tabulation_str, '<br>Shear<br>' + gWhat + '<br>') else appendStr (tabulation_str, '<br>Moment<br>' + gWhat + '<br>');
    if shear then SP(2) else SP(3); 
    x:=0;
    for i:=0 to k-1 do
      begin
		gX:=x;	gY:=r[i]; {save for mouseover display }

        DA(round(x/psl*puf)+ox, round(r[i]/psm*puf)+oy);
        x:=x+0.5;
      end;

	gX:=l;	gY:=r[k]; {save for mouseover display }
    DA( round(l/psl*puf)+ox, round(r[k]/psm*puf)+oy);

	mouseover_enabled:=false; {disable onmouseover }
    SP(1); 
    DA( round(l/psl*puf)+ox, oy);
  end{plot_mom_dia};

procedure output_beam;
  var
    i,j,h : integer;
    o,m,m1 : real;
  begin
    if not shear then begin
      writeln('Beam':11, 'Moment-L':10, 'Moment-R':10,'Shears-L':10,'Shears-R':10);
      writeln( '(#)':11,'(Kip-ft)':10,'(Kip-ft)':10,'(Kips)':10,'(Kips)':10);
      writeln('----':11,'--------':10,'--------':10,'------':10,'------':10);
    end;
    for i:=0 to s-1 do
      begin
        if not shear then writeln('Story',s-i:2);
        for j:=1 to p do
          begin
             H:=I*P+J;
             O:=B[H,1]/B[H,2];
             M:=O*(4*D[S+I+H,Q+1]+2*D[S+I+H+1,Q+1])-B[H,3];
             M1:=O*(2*D[S+I+H,Q+1]+4*D[S+I+H+1,Q+1])-B[H,4];
             D[H,1]:=(M+M1+B[H,6])/B[H,2];
             D[H,2]:=(B[H,5]-M-M1)/B[H,2];
             if not shear then writeln(j:11,m:10:3,m1:10:3,d[h,1]:10:3,d[h,2]:10:3);
             plot_beam_mom(s-i,j,m,d[h,1]);
          end;
      end;
    if not shear then writeln;
  end;

procedure plot_column_mom(story,column:integer; m1,v1:real);
  var
    w,a,c2,l: real;     { load, start load, length load, length beam }
    sc,ec   : real;     { start colum, end column length }
    bw      : real;     { beam width }
    last_lc : integer;  { last load count }
    i,k     : integer;  { general }
    ox,oy   : integer;
    x       : real;

  procedure find_load(var w,a,c:real);
    var
      sl,el : real; { start load, end load }
    begin
      w:=0;
      while (last_lc<=lc) and (w=0) do
        begin
          if (ld[lm[last_lc],1]=0) and (column=1) then
            begin
              sl:=ld[lm[last_lc],3];
              el:=sl+ld[lm[last_lc],4];
              if (sl<sc) and (el>sc) then
                begin w:=ld[lm[last_lc],2]; a:=0; c:=el-sc; end
              else if (sl>=sc) and (sl<ec) then
                     begin w:=ld[lm[last_lc],2]; a:=sl-sc; c:=el-sl; end;
              if (w<>0) and (a+c>l) then c:=l-a;
            end;
          last_lc:=last_lc+1;
        end;
    end;

  procedure tab_moments;
    var
      x,mx : real;
    begin
      x:=0.5; k:=1;
      repeat
        mx:=0;
        if (x>a) and (x<=a+c2) then  mx:=w/2*sqr(x-a)
        else if x>a+c2 then mx:=c2*w*(x-(a+c2/2));
        r[k]:=r[k]-mx;
        x:=x+0.5; k:=k+1;
      until x>=l;
      r[k]:=r[k]-c2*w*(l-(a+c2/2));
    end;

  procedure tab_shears;
    var
      x,vx : real;
    begin
      x:=0.5; k:=1;
      repeat
        vx:=0;
        if (x>a) and (x<=a+c2) then vx:=w*(x-a)
        else if x>a+c2 then vx:=w*c2;
        r[k]:=r[k]+vx;
        x:=x+0.5; k:=k+1;
      until x>=l;
      r[k]:=r[k]+c2*w;
    end;


  begin
    sc:=0; for i:=1 to story-1 do sc:=sc+c[(p+1)*(s-i)+1,2];
    ec:=sc+c[(p+1)*(s-story)+1,2];
    bw:=0; for i:=1 to column-1 do bw:=bw+b[p*(s-story)+i,2];
    l:=ec-sc;
    last_lc:=1;
    for i:=0 to 200 do begin r[i]:=0; end;
    i:=0; x:=0;
    repeat
      if shear then r[i]:=v1 else r[i]:=-(m1+v1*x);
      i:=i+1; x:=x+0.5;
    until x>=l; if shear then r[i]:=v1 else r[i]:=-(m1+v1*l);
    repeat
      find_load(w,a,c2);
      if w<>0 then begin if shear then tab_shears else tab_moments; end;
    until last_lc>lc;
    k:=i;
    ox:=round( (bw/psl +0.10*(2*column-1)+0.50)*puf );
    oy:=round( (sc/psl +0.10*(2*story-1)      )*puf );

	{ draw the column, 1=black	}
	mouseover_enabled:=false; {disable onmouseover }
    SP(1);
    MA(ox, oy);
    DA(ox, round(l/psl*puf)+oy);

	{ value at 0 feet is displayed at the Y-value point, not at y=0 }
    SP(1); 
    MA(ox, oy);
    DA(round(r[0]/psm*puf)+ox, oy); 

	{ draw the shear or the moment; which ever is selected, 2=red, 3=blue }
	mouseover_enabled:=true; {enable onmouseover }
	gWhat := format('story=%d column=%d',[story, column]);
	if shear then appendStr(tabulation_str, '<br>Shear<br>' + gWhat + '<br>') else appendStr(tabulation_str, '<br>Moment<br>' + gWhat + '<br>');
    if shear then SP(2) else SP(3);
    x:=0;
    for i:=0 to k-1 do
      begin
		gX:=x;	gY:=r[i]; {save for mouseover display }

        DA(round(r[i]/psm*puf)+ox, round(x/psl*puf)+oy);
        x:=x+0.5;
      end;

	gX:=l;	gY:=r[k]; {save for mouseover display }
    DA(round(r[k]/psm*puf)+ox, round(l/psl*puf)+oy);

	mouseover_enabled:=false; {disable onmouseover }
    SP(1); 
    DA(ox, round(l/psl*puf)+oy);

    if (story=1) and (column=p+1) then
      begin
        MA(100,page_height-30);
        SI(35,35); { set character height }
        if shear then LA('RIGID FRAME ANALYSIS SHEAR DIAGRAM')
        else		  LA('RIGID FRAME ANALYSIS MOMENT DIAGRAM');
        SI(27, 27);
        MA(100,page_height-60);
        LA('Project Name: '+proj_descrip);
        MA(100,page_height-90);
        LA('Date: '+time);
        MA(100,page_height-120);
        LA('Load Designation: '+load_descrip);
        MA(100,page_height-150);
        if shear then
          	 LA( format( 'Scales: X-%3d feet/inch  Y-%4d Kips/inch ; dots per inch = %3d ', [psl, psm, puf]))
        else LA( format( 'Scales: X-%3d feet/inch  Y-%4d Kip-Feet/inch ; dots per inch = %3d ', [psl, psm, puf]));
        MA(0,0);
      end;
  end{plot_mom_dia};

procedure output_column;
  var
    i,j,h : integer;
    o,l,m,m1 : real;
  begin
    if not shear then begin
      writeln('Column':11,'Moment':10,'Shears':10,'Axial':10);
      writeln( '(#)':11,'(Kip-ft)':10,'(Kips)':10,'(Kips)':10);
      writeln('----':11,'--------':10,'------':10,'------':10);
    end;
    for i:=0 to s-1 do
      begin
        if not shear then writeln('Story',s-i:2);
        for j:=1 to p+1 do
          begin
            H:=I*(P+1)+J;
            O:=C[H,1]/C[H,2];
            L:=6/C[H,2]*D[I+1,Q+1];
            M:=O*(4*D[S+H,Q+1]+2*D[S+H+P+1,Q+1]+L);
            M1:=O*(2*D[S+H,Q+1]+4*D[S+H+P+1,Q+1]+L);
            IF I<>S-1 THEN begin
              L:=O/C[H,2]*6*D[I+2,Q+1];
              M1:=M1-L;
              M:=M-L;
            end;
            IF J<=1 THEN begin
              M:=M-E[S-I,2];
              M1:=M1-E[S-I,1];
            end;
            O:=0;
            IF J<P+1 THEN O:=D[I*P+J,1];
            IF J>1 THEN O:=O+D[I*P+J-1,2];
            IF I>0 THEN O:=O+D[J,3];
            D[J,3]:=O;
            L:=0; IF J=1 THEN L:=E[S-I,3];
            if not shear then writeln(j:11,m:10:3,(m+m1-l)/c[h,2]:10:3,o:10:3);
            L:=0; IF J=1 THEN L:=E[S-I,4];
            if not shear then writeln(m1:21:3,(m+m1+l)/-c[h,2]:10:3);
            plot_column_mom(s-i,j,m1,((m+m1+l)/-c[h,2]));
          end;
      end;
    if not shear then writeln;
  end;

procedure output_rotation;
  var
    i,j,l : integer;

  begin
    writeln('Joint':11,'Rotation':15,'Displacement':15);
    writeln('(#)':11,'(Radians)':15,'(Feet)':15);
    writeln('----':11,'---------':15,'------':15);
    L:=0;
    for i:=s+1 to q do
      begin
        J:=I-S;
        IF (J-1)/(P+1)=int((J-1)/(P+1)) THEN
          begin
            writeln('Story',trunc(S-(J-1)/(P+1)):2);
            L:=L+1;
            IF L<=S THEN
              writeln(j:11,d[i,q+1]*0.0048:15:9,d[l,q+1]*0.0048:15:8)
            else writeln(j:11,d[i,q+1]*0.0048:15:9);
          end
        else writeln(j:11,d[i,q+1]*0.0048:15:9);
      end;
    writeln;
  end;

procedure reset_matrix;
  var
    i,j : integer;
  begin
    for i:=1 to q+1 do for j:=1 to q+1 do d[i,j]:=0;
    for i:=1 to 40  do
      for j:=3 to 6 do
        begin
          b[i,j]:=0;
          if i<11 then e[i,j-2]:=0;
        end;
  end;

procedure user_option;
  begin
    writeln('============================================');
    writeln('1. Define More Macros.':30);
    writeln('2. Reload the Frame.  ':30);
    writeln('3. Exit Program.      ':30);
    writeln;
    repeat
      option:=0;
      write('Enter Option ? '); readi(option); writeln(option:3);
    until option in [1,2,3];
    writeln;
  end;

begin (****  M A I N   L I N E  ****)

	writeln('<script>');
	writeln('var last_o=null;');
	writeln('function showTab(id_no){ let id=`tab${id_no}`; let o=document.getElementById(id); o.scrollIntoView({behavior: "auto", block: "nearest", inline: "nearest"}); o.style.backgroundColor="lightblue"; if (last_o != null) last_o.style.backgroundColor="white"; last_o=o;}');
	writeln('</script>');

  writeln('RIGID FRAME ANALYSIS  By Gary Argraves - Ver. 8809.08');
  writeln('=====================================================');
  time:=when;
  signon;

  initial_var;
  get_size;
  get_geometry;
  get_member_sizes;
  get_base_joint_type;
  option:=1;
  repeat
    if option=1 then get_macro_loads;
    apply_macro_loads;
    setup_matrix;
    solve_matrix;

	writeln;
	tabulation_str:='<b>'+load_descrip+'</b><br>';
	plot_str:= format( '<svg width="%d" height="%d">', [page_width, page_height]);
	{ box the page }
	SP(1); MA(0,0); DA(0,page_height); DA(page_width, page_height); DA(page_width,0);  DA(0,0);

	shear:=false; output_beam; output_column;
	appendStr( plot_str , '</svg>');

	writeln('<table><tr>');
	writeln('<td>');
		writeln('<div style="height:700px; width:180px; border:1px solid black; overflow-y:scroll; margin:10 10 10 10;padding:10 10 10 10;">');
		writeln(tabulation_str);
		writeln('</div>');
	writeln('<td>');
		writeln(plot_str);
	writeln('</tr></table>');
  	
	writeln;
	tabulation_str:='<b>'+load_descrip+'</b><br>';
	plot_str:=  format( '<svg width="%d" height="%d">', [page_width, page_height]);
	{ box the page }
	SP(1); MA(0,0); DA(0,page_height); DA(page_width, page_height); DA(page_width,0);  DA(0,0);

	shear:=true;  output_beam; output_column;
	appendStr( plot_str , '</svg>');

	writeln('<table><tr>');
	writeln('<td>');
		writeln('<div style="height:700px; width:180px; border:1px solid black; overflow-y:scroll; margin:10 10 10 10;padding:10 10 10 10;">');
		writeln(tabulation_str);
		writeln('</div>');
	writeln('<td>');
		writeln(plot_str);
	writeln('</tr></table>');

    output_rotation;
    reset_matrix;
    user_option;
  until option=3;
  writeln('*****  E N D   O F   R U N  *****');
end.