%include "inc:util.imp"
%include "inc:maths.imp"

%dynamic %routine %spec hline %alias "FRED_GRAPHICS_HLINE" %c
                                                          (%integer x0, x1, y)
%dynamic %routine %spec vline %alias "FRED_GRAPHICS_VLINE" (%integer x, y0, y1)
%dynamic %routine %spec fill %alias "FRED_GRAPHICS_FILL" %c
                                                     (%integer x0, y0, x1, y1)
%dynamic %routine %spec line %alias "FRED_GRAPHICS_LINE" %c
                                                     (%integer x0, y0, x1, y1)
%dynamic %routine %spec trapeze %alias "FRED_GRAPHICS_TRAPEZE" %c
                                   (%integer x00, x01, y0, x10, x11, y1)
%dynamic %routine %spec plot %alias "FRED_GRAPHICS_PLOT" (%integer x, y)
%dynamic %routine %spec setfont %alias "FRED_GRAPHICS_SETFONT" %c
                                                            (%integer %name a)
%dynamic %routine %spec show symbol %alias "FRED_GRAPHICS_SHOWSYM" %c
                                                          (%integer s)
%dynamic %routine disc %alias "FRED_GRAPHICS_DISC" (%integer x, y, r)
   %integer dx, dy, d, odx

   dx = 0
   odx = 1
   dy = r
   d = 3-r-r
   hline(x-r, x+r, y)
   %while dx<dy %cycle
      %if d<0 %start
         d = d+6+(dx<<2)
      %else
         d = d+10+((dx-dy)<<2)
         %if dx<=odx %start
            hline(x-dy, x+dy, y+dx)
            hline(x-dy, x+dy, y-dx)
         %else
            fill(x-dy, y+odx, x+dy, y+dx)
            fill(x-dy, y-odx, x+dy, y-dx)
         %finish
         hline(x-dx, x+dx, y+dy)
         hline(x-dx, x+dx, y-dy)
         odx = dx+1
         dy = dy-1
      %finish
      dx = dx+1
   %repeat
   %if dx=dy %start
      %if odx#dx %start
         hline(x-dy, x+dy, y+odx)
         hline(x-dy, x+dy, y-odx)
      %finish
      hline(x-dx, x+dx, y+dy)
      hline(x-dx, x+dx, y-dy)
   %finish
%end
%dynamic %routine ring %alias "FRED_GRAPHICS_RING" (%integer x, y, r)
   %integer dx, dy, d, odx

   dx = 0
   odx = 1
   dy = r
   d = 3-r-r
   plot(x, y+dy)
   plot(x, y-dy)
   plot(x-dy, y)
   plot(x+dy, y)
   %while dx<dy %cycle
      %if d<0 %start
         d = d+6+(dx<<2)
      %else
         %if dx<=odx %start
            plot(x-dx, y-dy)
            plot(x-dx, y+dy)
            plot(x+dx, y-dy)
            plot(x+dx, y+dy)
            plot(x-dy, y-dx)
            plot(x-dy, y+dx)
            plot(x+dy, y-dx)
            plot(x+dy, y+dx)
         %else
            hline(x-dx, x-odx, y+dy)
            hline(x+odx, x+dx, y+dy)
            hline(x-dx, x-odx, y-dy)
            hline(x+odx, x+dx, y-dy)
            vline(x-dy, y+odx, y+dx)
            vline(x-dy, y-odx, y-dx)
            vline(x+dy, y+odx, y+dx)
            vline(x+dy, y-odx, y-dx)
         %finish
         d = d+10+((dx-dy)<<2)
         odx = dx+1
         dy = dy-1
      %finish
      dx = dx+1
   %repeat
   %if dx=dy %start
      %if dx#odx %start
         plot(x-odx, y+dy)
         plot(x+odx, y+dy)
         plot(x-odx, y-dy)
         plot(x+odx, y-dy)
         plot(x+dy, y+odx)
         plot(x-dy, y+odx)
         plot(x+dy, y-odx)
         plot(x-dy, y-odx)
      %finish
      plot(x+dx, y+dy)
      plot(x+dx, y-dy)
      plot(x-dx, y+dy)
      plot(x-dx, y-dy)
   %finish
%end
%dynamic %routine drawarc %alias "FRED_GRAPHICS_DARC" %c
                                   (%integer x, y, r, x0, y0, x1, y1)
   %integer odx, ody, dx, dy, d, e

   x1 = x1-x
   y1 = y1-y
   dx = x0-x
   dy = y0-y
   d =  dx*dx+dy*dy-r*r
   odx = dx
   ody = dy
   %if dx>0 %start
      %if dy>0 %start
         %if dx<dy %then ->oct0 %else ->oct1
      %else
         %if -dy<dx %then ->oct2 %else ->oct3
      %finish
   %else
      %if dy<0 %start
         %if -dx<-dy %then ->oct4 %else ->oct5
      %else
         %if dy<-dx %then ->oct6 %else ->oct7
      %finish
   %finish
   %cycle

oct0: %if x1>0 %and y1>0 %and y1>=x1 %and dx<=x1 %start
         %while dx<x1 %cycle
            d = d+1+dx+dx
            e = d+1-dy-dy
            %if |e|<|d| %start
               d = e
               %if dx=odx %start
                  plot(x+odx,  y+dy)
               %else
                  hline(x+odx, x+dx, y+dy)
               %finish
               odx = dx+1
               dy = dy-1
            %finish
            dx = dx+1
         %repeat
         line(x+odx, y+dy, x+x1, y+y1)
         %return
      %else
         %while dy>dx %cycle
            d = d+1+dx+dx
            e = d+1-dy-dy
            %if |e|<|d| %start
               d = e
               %if dx=odx %start
                  plot(x+odx,  y+dy)
               %else
                  hline(x+odx, x+dx, y+dy)
               %finish
               odx = dx+1
               dy = dy-1
            %finish
            dx = dx+1
         %repeat
         plot(x+odx,  y+dy) %if dx#odx
         ody = dy
      %finish
oct1: %if x1>0 %and y1>0 %and dy>=y1 %start
         %while dy>y1 %cycle
            d = d+1-dy-dy
            e = d+1+dx+dx
            %if |e|<|d| %start
               %if ody=dy %start
                  plot(x+dx,  y+ody)
               %else
                  vline(x+dx, y+dy, y+ody)
               %finish
               ody = dy-1
               d = e
               dx = dx+1
            %finish
            dy = dy-1
         %repeat
         line(x+dx, y+ody, x+x1, y+y1)
         %return
      %else
         %while dy>0 %cycle
            d = d+1-dy-dy
            e = d+1+dx+dx
            %if |e|<|d| %start
               %if ody=dy %start
                  plot(x+dx,  y+ody)
               %else
                  vline(x+dx, y+dy, y+ody)
               %finish
               ody = dy-1
               d = e
               dx = dx+1
            %finish
            dy = dy-1
         %repeat
      %finish
oct2: %if x1>0 %and y1<=0 %and x1>=-y1 %and dy>=y1 %start
         %while dy>y1 %cycle
            d = d+1-dy-dy
            e = d+1-dx-dx
            %if |e|<|d| %start
               %if ody=dy %start
                  plot(x+dx,  y+ody)
               %else
                  vline(x+dx, y+dy, y+ody)
               %finish
               ody = dy-1
               d = e
               dx = dx-1
            %finish
            dy = dy-1
         %repeat
         line(x+dx, y+ody, x+x1, y+y1)
         %return
      %else
         %while dx>-dy %cycle
            d = d+1-dy-dy
            e = d+1-dx-dx
            %if |e|<|d| %start
               %if ody=dy %start
                  plot(x+dx,  y+ody)
               %else
                  vline(x+dx, y+dy, y+ody)
               %finish
               ody = dy-1
               d = e
               dx = dx-1
            %finish
            dy = dy-1
         %repeat
         plot(x+dx,  y+ody) %if ody#dy
         odx = dx
      %finish
oct3: %if x1>0 %and y1<=0 %and dx>=x1 %start
         %while dx>x1 %cycle
            d = d+1-dx-dx
            e = d+1-dy-dy
            %if |e|<|d| %start
               %if odx=dx %start
                  plot(x+odx,  y+dy)
               %else
                  hline(x+dx, x+odx, y+dy)
               %finish
               odx = dx-1
               d = e
               dy = dy-1
            %finish
            dx = dx-1
         %repeat
         line(x+odx, y+dy, x+x1, y+y1)
         %return
      %else
         %while dx>0 %cycle
            d = d+1-dx-dx
            e = d+1-dy-dy
            %if |e|<|d| %start
               %if odx=dx %start
                  plot(x+odx,  y+dy)
               %else
                  hline(x+dx, x+odx, y+dy)
               %finish
               odx = dx-1
               d = e
               dy = dy-1
            %finish
            dx = dx-1
         %repeat
      %finish
oct4: %if x1<=0 %and y1<=0 %and -y1>=-x1 %and dx>=x1 %start
         %while dx>x1 %cycle
            d = d+1-dx-dx
            e = d+1+dy+dy
            %if |e|<|d| %start
               %if odx=dx %start
                  plot(x+odx,  y+dy)
               %else
                  hline(x+dx, x+odx, y+dy)
               %finish
               odx = dx-1
               d = e
               dy = dy+1
            %finish
            dx = dx-1
         %repeat
         line(x+odx, y+dy, x+x1, y+y1)
         %return
      %else
         %while -dy>-dx %cycle
            d = d+1-dx-dx
            e = d+1+dy+dy
            %if |e|<|d| %start
               %if odx=dx %start
                  plot(x+odx,  y+dy)
               %else
                  hline(x+dx, x+odx, y+dy)
               %finish
               odx = dx-1
               d = e
               dy = dy+1
            %finish
            dx = dx-1
         %repeat
         plot(x+odx,  y+dy) %if dx#odx
         ody = dy
      %finish
oct5: %if x1<=0 %and y1<=0 %and dy<=y1 %start
         %while dy<y1 %cycle
            d = d+1+dy+dy
            e = d+1-dx-dx
            %if |e|<|d| %start
               %if ody=dy %start
                  plot(x+dx,  y+ody)
               %else
                  vline(x+dx, y+ody, y+dy)
               %finish
               ody = dy+1
               d = e
               dx = dx-1
            %finish
            dy = dy+1
         %repeat
         line(x+dx, y+ody, x+x1, y+y1)
         %return
      %else
         %while dy<0 %cycle
            d = d+1+dy+dy
            e = d+1-dx-dx
            %if |e|<|d| %start
               %if ody=dy %start
                  plot(x+dx,  y+ody)
               %else
                  vline(x+dx, y+ody, y+dy)
               %finish
               ody = dy+1
               d = e
               dx = dx-1
            %finish
            dy = dy+1
         %repeat
      %finish
oct6: %if x1<=0 %and y1>0 %and -x1>=y1 %and dy<=y1 %start
         %while dy<y1 %cycle
            d = d+1+dy+dy
            e = d+1+dx+dx
            %if |e|<|d| %start
               %if ody=dy %start
                  plot(x+dx,  y+ody)
               %else
                  vline(x+dx, y+ody, y+dy)
               %finish
               ody = dy+1
               d = e
               dx = dx+1
            %finish
            dy = dy+1
         %repeat
         line(x+dx, y+ody, x+x1, y+y1)
         %return
      %else
         %while -dx>dy %cycle
            d = d+1+dy+dy
            e = d+1+dx+dx
            %if |e|<|d| %start
               %if ody=dy %start
                  plot(x+dx,  y+ody)
               %else
                  vline(x+dx, y+ody, y+dy)
               %finish
               ody = dy+1
               d = e
               dx = dx+1
            %finish
            dy = dy+1
         %repeat
         plot(x+dx,  y+ody) %if ody#dy
         odx = dx
      %finish
oct7: %if x1<=0 %and y1>0 %and dx<=x1 %start
         %while dx<x1 %cycle
            d = d+1+dx+dx
            e = d+1+dy+dy
            %if |e|<|d| %start
               %if odx=dx %start
                  plot(x+odx,  y+dy)
               %else
                  hline(x+odx, x+dx, y+dy)
               %finish
               odx = dx+1
               d = e
               dy = dy+1
            %finish
            dx = dx+1
         %repeat
         line(x+odx, y+dy, x+x1, y+y1)
         %return
      %else
         %while dx<0 %cycle
            d = d+1+dx+dx
            e = d+1+dy+dy
            %if |e|<|d| %start
               %if odx=dx %start
                  plot(x+odx,  y+dy)
               %else
                  hline(x+odx, x+dx, y+dy)
               %finish
               odx = dx+1
               d = e
               dy = dy+1
            %finish
            dx = dx+1
         %repeat
      %finish
   %repeat
%end

%dynamic %routine endarc %alias "FRED_GRAPHICS_EARC" %c
                                  (%integer x0, y0, x1, y1, r)

   %integer x, y, sx, sy, odx, ody, dx, dy, d, e
   %real t
   dx = x1-x0
   dy = y1-y0
   %if dx<0 %then sx = 1 %else sx = -1
   %if dy<0 %then sy = -1 %else sy = 1
   %if r<0 %start
      d = x0
      x0 = x1
      x1 = d
      d = y0
      y0 = y1
      y1 = d
      r = -r
   %finish
   dx = dx*dx
   dy = dy*dy
   t = (4*r*r-dx-dy)/(dx+dy)
   %signal 15,0 %if t<0
   x = (x0+x1+sy*round(sqrt(dy*t))+1)//2
   y = (y0+y1+sx*round(sqrt(dx*t))+1)//2
   drawarc(x, y, r, x0, y0, x1, y1)
%end

%dynamic %routine anglearc %alias "FRED_GRAPHICS_AARC" %c
                          (%integer x, y, r, %real phi0, phi1)
   %integer x0, y0, x1, y1
   %routine choose(%real phi, %integer %name x, y)
      %integer xs, ys, mind, sx, sy, mx, my
      %routine test(%integer dx, dy)
         %integer xc, yc, d
         xc = xs+dx
         yc = ys+dy
         d = xc*xc+yc*yc-r*r
         d = -d %if d<0
         %if d<mind %start
            mind = d
            x = xc
            y = yc
         %finish
      %end

      xs = round(r*cos(phi))
      ys = round(r*sin(phi))
      mind = xs*xs+ys*ys-r*r
      mind = -mind %if mind<0
      x = xs
      y = ys
      %if xs<0 %then sx = -1 %and mx = -xs %else sx = 1 %and mx = xs
      %if ys<0 %then sy = -1 %and my = -ys %else sy = 1 %and my = ys
      %if mx<my+my %start
         test(0, sy)
         test(0, -sy)
      %else %if my<mx+mx
         test(sx, 0)
         test(-sx, 0)
      %else
         test(sx, sy)
         test(-sx, -sy)
      %finish
   %end

   %if phi0>phi1 %start
      choose(phi0, x0, y0)
      choose(phi1, x1, y1)
   %else
      choose(phi1, x0, y0)
      choose(phi0, x1, y1)
   %finish

   drawarc(x, y, r, x+x0, y+y0, x+x1, y+y1)
%end

%dynamic %routine read font %alias "FRED_GRAPHICS_READFONT" %c
                          (%string(255) file, %integer %name font)
   %integer l
   %string(255) first, last

   %if file->first.(".").last %start
      connect file(file, 0, font, l)
   %else
      connect file(file.".bft", 0, font, l)
   %finish
%end

%const %integer max vertex = 256
%record %format edge(%integer x0, y0, x1, y1, slope, %record(edge) %name l)
%own %record(edge) niledge
%own %integer pp = 0
%own %record(edge) %array edges(1:max vertex)


%dynamic %routine poly %alias "FRED_GRAPHICS_POLY" (%integer x, y)

   %signal 11, 1 %if pp=max vertex
   pp = pp+1
   edges(pp)_x0 = x
   edges(pp)_y0 = y
%end

%dynamic %routine close poly %alias "FRED_GRAPHICS_CLOSEPOLY"
      %record %format hl(%integer x0, x1, y)
      %record(edge) %name el, ael, e0, e1, nilael, p, l, q, r, s
      %record(hl) top, btm
      %integer i, x0, x1, y0
      %record(edge) %name d

   %routine sort edges(%integer l, r)
      %constant %integer insert limit = 5
      %record(edge) key
      %integer key y, lp, rp, i

      %return %unless l<r
      %while r-l>insert limit %cycle
         lp = l
         rp = r+1
         key = edges(l)
         key y = key_y0
         %cycle
            rp = rp-1 %until rp=lp %or key y>edges(rp)_y0 %or %c
                          (key y=edges(rp)_y0 %and key_x0>edges(rp)_x0) %or %c
                          (key y=edges(rp)_y0 %and key_x0=edges(rp)_x0 %and %c
                           key_slope>edges(rp)_slope)
            %exit %if lp=rp
            edges(lp) = edges(rp)
            lp = lp+1 %until rp=lp %or key y<edges(lp)_y0 %or %c
                          (key y=edges(lp)_y0 %and key_x0<=edges(lp)_x0) %or %c
                          (key y=edges(lp)_y0 %and key_x0=edges(lp)_x0 %and %c
                           key_slope<=edges(rp)_slope)
            %exit %if lp=rp
            edges(rp) = edges(lp)
         %repeat
         edges(lp) = key
         %if lp-l>r-rp %start
            sort edges(rp+1, r)
            r = lp-1
         %finish %else %start
            sort edges(l, lp-1)
            l = rp+1
         %finish
      %repeat
      %for rp = l+1, 1, r %cycle
         key = edges(rp)
         key y = key_y0
         lp = l
         lp = lp+1 %while lp#rp %and (key y>edges(lp)_y0 %or %c
                           (key y=edges(lp)_y0 %and key_x0>edges(lp)_x0) %or %c
                           (key y=edges(lp)_y0 %and key_x0=edges(lp)_x0 %and %c
                            key_slope>edges(lp)_slope))
         %for i = rp-1, -1, lp %cycle
            edges(i+1) = edges(i)
         %repeat
         edges(lp) = key
      %repeat
   %end

%routine print poly(%string(32) mess, %record(edge)%name p, t)
   %record(edge) %name q
   q==p
   %while %not q==t %cycle
      printstring(mess)
      write(addr(q), 10); write(q_x0, 5)
      write(q_y0, 5); write(q_x1, 5)
      write(q_y1, 5); write(q_slope, 10)
      newline
      q==q_l
   %repeat
%end

      %integer %function muldiv(%integer a, b, c)
         *muls d1,d0
         *divs d2,d0
         *extl d0
         *lea  12(a7),a7
         *rts
         %result = a*b//c
      %end

      %routine set ends(%record(edge)%name e, %integer x, y)
         %if e_y0<y %or (e_y0=y %and e_x0<=x) %start
            e_x1 = x
            e_y1 = y
         %finish %else %start
            e_x1 = e_x0
            e_y1 = e_y0
            e_x0 = x
            e_y0 = y
         %finish
         %if e_y0=e_y1 %start
            e_slope = 0
         %finish %else %start
            e_slope = ((e_x1-e_x0)<<16)//(e_y1-e_y0)
         %finish
      %end

      %routine check top(%record(edge) %name e)
         %record(edge) %name p, l
         %if e_y1>top_y %start
            e_x0 = e_x0+muldiv(e_x1-e_x0, top_y-btm_y, e_y1-btm_y)
            e_y0 = top_y
            p == el
            %while (%not p==niledge) %and (p_y0<top_y %or %c
                       (p_y0=top_y %and p_x0<e_x0) %or %c
                       (p_y0=top_y %and p_x0=e_x0 %and p_slope<e_slope)) %cycle
               l == p
               p == p_l
            %repeat
            e_l == p
            %if p==el %then el == e %else l_l == e
         %finish %else %start
            e_x0 = e_x1
         %finish
      %end

      %return %if pp=0
      %if pp=1 %start
         plot(edges(1)_x0, edges(1)_y0)
      %finish %else %start
         e1 == edges(1)
         x0 = e1_x0
         y0 = e1_y0
         %for i = 1, 1, pp %cycle
            e0 == e1
            e1 == edges(i)
            set ends(e0, e1_x0, e1_y0)
         %repeat
         set ends(e1, x0, y0)
         sort edges(1, pp)
         e1 == edges(1)
         el == e1
         e0 == e1 %and e1 == edges(i) %and e0_l == e1 %for i = 2, 1, pp
         e1_l == niledge

         %cycle
            ael == el
            btm_y =ael_y0
            x0 = ael_x0
            x1 = x0
! print poly("start", el, niledge)
            el == el_l %until el==niledge %or el_y0#btm_y
            nilael == el
! print poly("split1", ael, nilael)
! print poly("split2",  el, niledge)
            %cycle
               %while (%not ael==nilael) %and %c
                                  ael_y1=btm_y %and ael_x0<=x1 %cycle
                  x1 = ael_x1 %if x1<ael_x1
                  ael == ael_l
               %repeat
               %exit %if ael==nilael
               e0 == ael
               ael == ael_l
               %if e0_y1=btm_y %start
                  %exit %if ael==nilael
                  line(x0, btm_y, x1, btm_y) %unless x0=x1
                  x0 = ael_x0
                  x1 = x0
                  %continue
               %finish

               %while (%not ael==nilael) %and ael_y1=btm_y %cycle
                  x1 = ael_x1 %if x1<ael_x1
                  ael == ael_l
               %repeat
               e1 == ael
               ael == ael_l
               line(x0, btm_y, e0_x0, btm_y) %if x0<e0_x0 %and x0<x1
               %if x1>e1_x0 %start
                  x0 = e1_x0
               %finish %else %if %not ael==nilael %start
                  x0 = ael_x0
                  x1 = x0
               %finish %else %start
                  x0 = x1
               %finish
               %if e0_y1<e1_y1 %start
                  top_y = e0_y1
               %finish %else %start
                  top_y = e1_y1
               %finish
               top_y = nilael_y0 %unless nilael==niledge %or top_y<nilael_y0
               btm_x0 = e0_x0
               check top(e0)
               top_x0 = e0_x0
               btm_x1 = e1_x0
               check top(e1)
               top_x1 = e1_x0
               trapeze(btm_x0, btm_x1, btm_y, top_x0, top_x1, top_y)
               p == el
               %while (%not p==niledge) %and p_y0<=top_y %cycle
                  %if p_y0=top_y %and p_y1=top_y %start
                     %if top_x0<=p_x0 %and p_x1<=top_x1 %start
                        %if p==el %start
                           el == p_l
                        %finish %else %start
                           l_l == p_l
                        %finish
                     %finish %else %if top_x0<p_x1<=top_x1 %start
                        p_x1 = top_x0
                     %finish %else %if top_x0<=p_x0<top_x1 %start
                        p_x0 = top_x1
                     %finish %else %if p_x0<top_x0 %and top_x1<p_x1 %start
                        pp = pp+1
                        q == edges(pp)
                        q_x0 = top_x1
                        q_y0 = top_y
                        q_x1 = p_x1
                        q_y1 = top_y
                        p_x1 = top_x0
                        r == p_l
                        %while (%not r==niledge) %and r_y0=top_y %and %c
                                                          r_x0<top_x1 %cycle
                           s == r
                           r == r_l
                        %repeat
                        q_l == r
                        %if r==p_l %then p_l == q %else s_l == q
                     %finish
                  %finish
                  l == p
                  p == p_l
               %repeat
            %repeat %until ael==nilael
            line(x0, btm_y, x1, btm_y) %unless x0=x1
         %repeat %until el==niledge
      %finish
      pp = 0
   %end

%routine show spaces(%integer n)
  %while n>0 %cycle
    n = n-1; show symbol(' ')
  %repeat
%end

%dynamic %routine show i %alias "FRED_GRAPHICS_SHOWI" (%integer n,p)
%integer q,r
  %if p>0 %start
    p = \p; show symbol(' ') %and p = p+1 %if n>=0
  %finish
  p = -120 %if p<-120
  q = n//10; *move.l d1,r
  %if q=0 %start
    p = p+1 %if n<0; show spaces(-1-p); show symbol('-') %if n<0
  %else
    p = p+1 %if p<0; show i(q,p)
  %finish
  show symbol(|r|+'0')
%end

%dynamic %routine show r %alias "FRED_GRAPHICS_SHOWR" (%real x, %integer n,m)
%constreal pmax = 2147483647.0
%real y,z
%integer i=0,l,count=0,sign
  sign = ' '
  sign = '-' %if x < 0
  y = |x|+0.5/10.0\{^}m;  !modulus, rounded
  %if y > pmax %start
    count = count+1 %and y = y/10.0 %until y < 10.0
  %finish
  z = 1.0
  %cycle
    i = i+1;  z = z*10.0
  %repeat %until z > y
  show spaces(n-i)
  show symbol(sign) %unless sign = ' ' %and n <= 0
  %cycle
    z = z/10.0
    l = int pt(y/z)
    y = y-l*z
    show symbol(l+'0')
    i = i-1
    %exit %if i+m <= 0
    show symbol('.') %if i = 0
  %repeat
  show symbol('@') %and show i(count,0) %if count # 0
%end

%dynamic %routine show f %alias "FRED_GRAPHICS_SHOWF" (%real x, %integer n)
%real y,round
%integer count=-99,sign=0
  %if x # 0 %start
    x = -x %and sign = 1 %if x < 0
   !Adjust X so that 1.0 <= rounded(X) < 10.0
    count = 0;  round = 0.5\{^}n
    y = 1.0-round
    %if x < y %start;  !ie rounded(X) < 1.0
      count = count-1 %and x = x*10.0 %until x >= y
    %finish %else %start
      y = 10.0-round
      %while x >= y %cycle;  !ie rounded(X) > 10.0
        count = count+1;  x = x/10.0
      %repeat
    %finish
    x = -x %if sign # 0
  %finish
  show r(x,1,n)
  show symbol('@')
  show i(count,0)
%end

%dynamic %routine shex1 %alias "FRED_GRAPHICS_SHEX1" (%integer x)
  x = x&15; x = x+7 %if x>9; show symbol(x+'0')
%end

%dynamic %routine shex2 %alias "FRED_GRAPHICS_SHEX2" (%integer x)
  shex1(x>>4); shex1(x)
%end

%dynamic %routine shex4 %alias "FRED_GRAPHICS_SHEX4" (%integer x)
  shex2(x>>8); shex2(x)
%end

%dynamic %routine shex %alias "FRED_GRAPHICS_SHEX" (%integer x)
  shex4(x>>16); shex4(x)
%end

%end %of %file