[comp.sources.amiga] v02i017: PostScript interpreter source

lee@uhccux.UUCP (Greg Lee) (08/28/87)

# This is a shell archive.  Remove anything before this line
# then unpack it by saving it in a file and typing "sh file"
# (Files unpacked will be owned by you and have default permissions).
# This archive contains the following files:
#	./a-box
#	./color-chart
#	./console.a
#	./control.a
#	./dict.a
#	./fan
#	./ffpa.a
#	./files.a
#
if `test ! -s ./a-box`
then
echo "writing ./a-box"
sed 's/^X//' > ./a-box << '\Rogue\Monster\'
X
Xsave
X
X/A { /simplex findfont 100 scalefont setfont
X     300 100 moveto
X     (A) true charpath
X     stroke
X   } def
X
X/B { 100 100 moveto
X     100 200 lineto
X     200 200 lineto
X     200 100 lineto
X     closepath
X     stroke
X   } def
X
X 2 pencolor 18 setlinewidth  B  A
X 1 pencolor  8 setlinewidth  B  A
X 3 pencolor  4 setlinewidth  B  A
X
Xrestore
X
\Rogue\Monster\
else
  echo "will not over write ./a-box"
fi
if [ `wc -c ./a-box | awk '{printf $1}'` -ne 346 ]
then
echo `wc -c ./a-box | awk '{print "Got " $1 ", Expected " 346}'`
fi
if `test ! -s ./color-chart`
then
echo "writing ./color-chart"
sed 's/^X//' > ./color-chart << '\Rogue\Monster\'
X
X% Set up colors and show chart
X
Xsave
X1 penmode
X
Xerasepage
X
X/xpos 0 def
X/ypos 364 def
X
X/boxwidth 10 def
X/boxheight 20 def
X
X/nextx { /xpos xpos boxwidth add def } def
X/nexty { /xpos 0 def /ypos ypos boxheight sub def } def
X
X/onebox {
X   xpos ypos xpos boxwidth add ypos boxheight sub box
X   nextx
X   } def
X
X/fourbox {
X   .6 setgray onebox
X   .3 setgray onebox
X   .1 setgray onebox
X   0  setgray onebox
X   } def
X
X/boxrow {
X   0 1 15
X   { pencolor fourbox }
X   for
X   } def
X
X/allbox {
X   0 1 15
X   { penbcolor boxrow nexty }
X   for
X   } def
X
X 0 pencolor  2  2  2 setrgbcolor    % black
X 1 pencolor 11 11 11 setrgbcolor    % white
X 2 pencolor  3 12  3 setrgbcolor    % green
X 3 pencolor 13  4  2 setrgbcolor    % red
X 4 pencolor  0  0 15 setrgbcolor    % blue
X 5 pencolor 12 12  0 setrgbcolor    % yellow
X 6 pencolor  0  8  2 setrgbcolor    % olive
X 7 pencolor 10  0  9 setrgbcolor    % wine
X 8 pencolor  6  2  0 setrgbcolor    % rust
X 9 pencolor  0  6  6 setrgbcolor    % sea
X10 pencolor  9 15  1 setrgbcolor    % apple
X11 pencolor 14 11  0 setrgbcolor    % orange
X12 pencolor 12  0  4 setrgbcolor    % fire
X13 pencolor  9  2 15 setrgbcolor    % grape
X14 pencolor 12  7  7 setrgbcolor    % salmon
X15 pencolor  0 15  8 setrgbcolor    % sky
X
X  allbox
X
X
X 2 pencolor 0 penbcolor 1 penmode
X/topaz findfont 8 scalefont setfont
X/theight  364 boxheight sub 6 add def
X/txpos 2 def
X/nexttext { txpos theight moveto
X            /txpos txpos 4 boxwidth mul add def
X            /theight theight boxheight sub def
X          } def
X
X  nexttext (black)  show
X  nexttext (white)  show
X  nexttext (green)  show
X  nexttext (red)    show
X  nexttext (blue)   show
X  nexttext (yellow) show
X  nexttext (olive)  show
X  nexttext (wine)   show
X  nexttext (rust)   show
X  nexttext (sea)    show
X  nexttext (apple)  show
X  nexttext (orange) show
X  nexttext (fire)   show
X  nexttext (grape)  show
X  nexttext (salmon) show
X  nexttext (sky)    show
X
Xrestore
X
X
\Rogue\Monster\
else
  echo "will not over write ./color-chart"
fi
if [ `wc -c ./color-chart | awk '{printf $1}'` -ne 1925 ]
then
echo `wc -c ./color-chart | awk '{print "Got " $1 ", Expected " 1925}'`
fi
if `test ! -s ./console.a`
then
echo "writing ./console.a"
sed 's/^X//' > ./console.a << '\Rogue\Monster\'
X
X
X   xref     abortps
X   xref     the_window
X
X*   xdef     con_signal_number
X
X   section  one
X
X   include  "ps.h"
X
X
X   lref  FindTask,45
X   lref  AllocSignal,51
X   lref  FreeSignal,52
X   lref  AddPort,55
X   lref  RemPort,56
X   lref  GetMsg,58
X   lref  OpenDevice,70
X   lref  CloseDevice,71
X   lref  DoIO,72
X   lref  SendIO,73
X
Xcallex   macro
X         move.l   A6,-(SP)
X         move.l   4,A6
X         jsr      _LVO\1(A6)
X         move.l   (SP)+,A6
X         endm
X
X   xdef     start_console
X   xdef     stop_console
X   xdef     conmayread
X   xdef     conputchar
X   xdef     conputstr
X
Xnt_msgport  equ   4
X
Xpa_signal   equ   0
Xpa_ignore   equ   2
X
Xcmd_reset   equ   1
Xcmd_read    equ   2
Xcmd_write   equ   3
Xcmd_update  equ   4
Xcmd_clear   equ   5
Xcmd_stop    equ   6
Xcmd_start   equ   7
Xcmd_flush   equ   8
X
X
Xstart_console
X   move.l   the_window,o_window
X
X   move.l   #128,o_length
X*
X   lea      console_name,A0
X   moveq    #0,D0             unit
X   lea      out_request,A1    IORequest
X   moveq    #0,D1             flags
X   callex   OpenDevice
X*
X
X   tst.l    D0
X   bne      abortps
X
X* was opened
X   move.b   #nt_msgport,ln_type
X*   clr.b     port_flags
X   move.b   #pa_ignore,port_flags
X
X   moveq    #-1,D0
X   callex   AllocSignal
X   move.b   D0,con_signal_number
X
X   moveq    #0,D0       current task
X   move.l   D0,A1
X   callex   FindTask
X   move.l   D0,this_task
X
X   lea      console_port,A1
X   callex   AddPort
X
X   move.l   #console_port,reply_port
X
X   move.l   #out_request,A1
X   move.l   #in_request,A0
X   moveq    #11,D2
X1$ move.l   (A1)+,(A0)+
X   dbra     D2,1$
X
X   bra      conin
X
X
X
Xstop_console
X   moveq    #0,D0
X   move.b   con_signal_number,D0
X   bls      1$
X   callex   FreeSignal
X1$
X
X   lea      console_port,A1
X   callex   RemPort
X
X   lea      out_request,A1
X   callex   CloseDevice
X   rts       
X
X
Xconmayread
X   lea      console_port,A0
X   callex   GetMsg
X   tst.l    D0
X   bne      1$
X   moveq    #-1,D0
X   rts
X1$
X   moveq    #0,D0
X   move.b   con_in_buffer,D0
X   move.l   D0,-(SP)
X   bsr      conin
X   move.l   (SP)+,D0
X   rts
X
Xconin
X   move.w    #cmd_read,i_command
X   move.l    #con_in_buffer,i_data
X   moveq     #1,D0
X   move.l    D0,i_length
X
X   lea      in_request,A1
X   callex   SendIO
X
X   rts
X
X
Xconputchar
X   move.w   #cmd_write,o_command
X   lea      con_out_buffer,A0
X   move.b   D0,(A0)
X   move.l   A0,o_data
X   moveq    #1,D0
X   move.l   D0,o_length
X   lea      out_request,A1
X   callex   DoIO
X   rts
X
X
Xconputstr
X   move.w   #cmd_write,o_command
X   move.l   D2,o_data
X   move.l   D3,o_length
X   lea      out_request,A1
X   callex   DoIO
X   move.l   o_actual,D0
X   rts
X
X
Xconsole_name
X   dc.b      'console.device',0
X
X   section  two,bss
X
Xout_request
X   ds.b     14    LN
Xreply_port
X   ds.l     1     reply port
X   ds.w     1     length
X   ds.l     2     device node pointer & unit
Xo_command
X   ds.w     1
X   ds.b     2     flags & error
Xo_actual
X   ds.l     1     actual length
Xo_length
X   ds.l     1
Xo_window
Xo_data
X   ds.l     2
X
X
X
Xin_request
X   ds.b     14    LN
X   ds.l     1
X   ds.w     1
X   ds.l     2
Xi_command
X   ds.w     1
X   ds.b     2
X   ds.l     1
Xi_length
X   ds.l     1
Xi_data
X   ds.l     2
X
X* message port
Xconsole_port
X* LN = A A B B A
X   ds.l     1
X   ds.l     1
X* type of LN & pri & name
Xln_type
X   ds.b     1
X   ds.b     1
X   ds.l     1
Xport_flags
X   ds.b     1     ;flags
Xcon_signal_number
X   ds.b     1     ;signal bit num
Xthis_task
X   ds.l     3     ;task & next 14b. is LH
X   ds.b     6
X* end of message port
X
Xcon_in_buffer
X   ds.b     2
Xcon_out_buffer
X   ds.b     2
X
X   end
X
\Rogue\Monster\
else
  echo "will not over write ./console.a"
fi
if [ `wc -c ./console.a | awk '{printf $1}'` -ne 3523 ]
then
echo `wc -c ./console.a | awk '{print "Got " $1 ", Expected " 3523}'`
fi
if `test ! -s ./control.a`
then
echo "writing ./control.a"
sed 's/^X//' > ./control.a << '\Rogue\Monster\'
X
X   xref  ipop
X   xref  popnum
X   xref  r.ipush
X   xref  msg
X   xref  reinterp
X   xref  type_mismatch
X
X   section one
X
X   include  "ps.h"
X
X   xdef  initloops
X
X
X
X  DEF    exec
X   bsr      ipop
X   cmp.w    #ICode,D2
X   bne      r.ipush
X   move.l   D0,A0
X   jmp      (A0)
X
X  DEF    if
X  ARG    ICode
X   move.l   D0,-(SP)
X  ARG    Boolean
X   tst.l    D0
X   bne      1$
X   addq     #4,SP
X1$ rts
X
X  DEF    ifelse
X  ARG    ICode
X   move.l   D0,D1
X  ARG    ICode
X   move.l   D0,D3
X  ARG    Boolean
X   tst.l    D0
X   bne      1$
X   move.l   D1,A0
X   jmp      (A0)
X1$ move.l   D3,A0
X   jmp      (A0)
X
X  DEF    for
X  ARG    ICode
X   bsr      makeloop
X
X   bsr      popnum
X   move.l   D0,4(SP)   limit
X   bsr      popnum
X   move.l   D0,8(SP)   incr
X   bsr      popnum
X   move.l   D0,12(SP)  init
X
X1$ move.l   12(SP),D0
X   move.l   8(SP),D1
X   move.l   4(SP),D2
X
X   tst.l    D1
X   bmi      2$
X   cmp.l    D2,D0
X   bra      3$
X2$ cmp.l    D0,D2
X3$ bgt      _exit
X
X   move.w   #Integer,D2
X   bsr      r.ipush
X
X   add.l    D1,D0
X   move.l   D0,12(SP)
X
X   move.l   (SP),A0
X   jsr      (A0)
X   bra      1$
X
X  DEF    repeat
X  ARG    ICode
X   bsr      makeloop
X   bsr      popnum
X1$ subq.l   #1,D0
X   bmi      _exit
X   move.l   D0,4(SP)
X   move.l   (SP),A0
X   jsr      (A0)
X   move.l   4(SP),D0
X   bra      1$
X
X  DEF    loop
X  ARG    ICode
X   bsr      makeloop
X1$ move.l   (SP),A0
X   jsr      (A0)
X   bra      1$
X
X* stack while looping:
X*  ret after loop
X*  save exitsp           16(SP)
X*  init                  12(SP) <- addr for looping proc
X*  incr                   8(SP)
X*  limit                  4(SP)
X*  proc                    (SP)
X*  ret for next repeat
X
X
X  DEF    exit
X   move.w   loops,D0
X   beq      1$
X   subq.w   #1,D0
X   move.w   D0,loops
X   move.l   exitsp,D0
X   beq      1$               this should be impossible
X   move.l   D0,SP
X   move.l   (SP)+,exitsp
X   rts
X1$ ERR      no_loop
X
Xmakeloop
X   move.l   (SP)+,A0         ret address to loop requestor
X   move.l   exitsp,-(SP)
X   move.l   SP,exitsp        for possible call to _exit
X   lea      -12(SP),SP       room for init, incr, limit
X   move.l   D0,-(SP)         procedure to loop on
X   move.w   loops,D0         note one more nesting level
X   addq.w   #1,D0
X   move.w   D0,loops
X   jmp      (A0)             return
X
Xinitloops
X   moveq    #0,D0
X   move.w   D0,loops
X   move.l   D0,exitsp
X   rts
X
Xloops    dc.w  0
Xexitsp   dc.l  0
X
X
X  DEF    stop
X   move.l   stopsave,D0
X   beq      type_mismatch     change
X   move.l   D0,SP
X   rts
X
X  DEF    stopped
X  ARG    ICode
X   pea      ..stop
X   move.l   SP,stopsave
X   move.l   D0,A0
X   jsr      (A0)
X   addq.l   #4,SP
X   moveq    #0,D0
X  RETURN    Boolean
X
Xstopsave    dc.l  0
X
X..stop
X   moveq    #-1,D0
X  RETURN    Boolean
X
X  DEF    countexecstack
X   move.w   #Integer,D2
X   moveq    #0,D0
X  RETURN    Integer
X
X  DEF    execstack
X   rts
X
X
X  DEF    start
X   rts
X
X
X   bstr     no_loop,<exit outside loop>
X
X   end
X
\Rogue\Monster\
else
  echo "will not over write ./control.a"
fi
if [ `wc -c ./control.a | awk '{printf $1}'` -ne 2908 ]
then
echo `wc -c ./control.a | awk '{print "Got " $1 ", Expected " 2908}'`
fi
if `test ! -s ./dict.a`
then
echo "writing ./dict.a"
sed 's/^X//' > ./dict.a << '\Rogue\Monster\'
X
X
X
X   idnt  dict
X
X   section  one
X
X   include  "ps.h"
X
X   xref  _hex
X   xref  _quit
X   xref  _run
X   xref  _print
X   xref  _equalsprint
X   xref  _file
X   xref  _read
X   xref  _write
X
X   xref  _string
X   xref  _dict
X   xref  _begin
X   xref  _end
X   xref  _array
X   xref  _maxlength
X   xref  _length
X   xref  _get
X   xref  _put
X
X   xref  _mark
X   xref  _rbracket
X
X   xref  _save
X   xref  _restore
X
X   xref  _eq
X   xref  _ne
X   xref  _ge
X   xref  _gt
X   xref  _le
X   xref  _lt
X   xref  _add
X   xref  _sub
X   xref  _mul
X   xref  _idiv
X   xref  _div
X   xref  _mod
X   xref  _abs
X   xref  _neg
X   xref  _ceiling
X   xref  _floor
X   xref  _round
X   xref  _truncate
X
X   xref  _sqrt
X   xref  _ln
X   xref  _log
X   xref  _exp
X   xref  _pow
X   xref  _tanh
X   xref  _cosh
X   xref  _sinh
X   xref  _tan
X   xref  _cos
X   xref  _sin
X   xref  _atan
X
X   xref  _currentpoint
X   xref  _gsave
X   xref  _grestore
X   xref  _translate
X   xref  _scale
X   xref  _rotate
X   xref  _concat
X   xref  _concatmatrix
X   xref  _transform
X   xref  _dtransform
X
X   xref  _def
X   xref  _pop
X   xref  _exch
X   xref  _dup
X   xref  _copy
X   xref  _index
X   xref  _roll
X   xref  _count
X   xref  _clear
X   xref  _true
X   xref  _false
X
X   xref  _exec
X   xref  _if
X   xref  _ifelse
X   xref  _for
X   xref  _repeat
X   xref  _loop
X   xref  _exit
X   xref  _stop
X   xref  _stopped
X   xref  _countexecstack
X   xref  _execstack
X   xref  _start
X
X   xref  _cvr
X   xref  _cvi
X   xref  _cvs
X
X   xref  _stringwidth
X   xref  _charpath
X   xref  _strokepath
X   xref  _setlinewidth
X   xref  _currentlinewidth
X   xref  _setlinecap
X   xref  _currentlinecap
X   xref  _setlinejoin
X   xref  _currentlinejoin
X   xref  _setflat
X   xref  _currentflat
X   xref  _show
X   xref  _moveto
X   xref  _rmoveto
X   xref  _lineto
X   xref  _rlineto
X   xref  _curveto
X   xref  _rcurveto
X   xref  _closepath
X   xref  _newpath
X   xref  _setgray
X   xref  _currentgray
X   xref  _greyline
X   xref  _flood
X   xref  _fill
X   xref  _stroke
X   xref  _erasepage
X   xref  _pencolor
X   xref  _penbcolor
X   xref  _penmode
X   xref  _penpattern
X   xref  _box
X   xref  _currentrgbcolor
X   xref  _setrgbcolor
X   xref  _findfont
X   xref  _scalefont
X   xref  _makefont
X   xref  _setfont
X   xref  _currentfont
X   xref  _pixel
X
X******************
X
X   xdef     systemdict
X   xdef     fdict
X   xdef     enddict
X   xdef     .true
X   xdef     .false
X
X******************
X
Xdentry   macro
X         dc.l  .\1
X         dc.w  ICode
X         dc.l  _\1
X         endm
X
Xnentry   macro
X.\1      dc.b  1$-*-1
X         dc.b  '\1'
X1$
X         endm
X
Xsystemdict
X   dentry   hex
X   dentry   quit
X   dentry   run
X   dentry   print
X   dentry   equalsprint
X   dentry   file
X   dentry   read
X   dentry   write
X
X
X   dentry   string
X   dentry   dict
X   dentry   begin
X   dentry   end
X   dentry   array
X   dentry   maxlength
X   dentry   length
X   dentry   get
X   dentry   put
X
X   dentry   mark
X*   dentry   lbracket
X         dc.l  .lbracket
X         dc.w  ICode
X         dc.l  _mark
X   dentry   rbracket
X
X   dentry   save
X   dentry   restore
X
X   dentry   eq
X   dentry   ne
X   dentry   ge
X   dentry   gt
X   dentry   le
X   dentry   lt
X   dentry   add
X   dentry   sub
X   dentry   mul
X   dentry   idiv
X   dentry   div
X   dentry   mod
X   dentry   abs
X   dentry   neg
X   dentry   ceiling
X   dentry   floor
X   dentry   round
X   dentry   truncate
X
X   dentry   sqrt
X   dentry   ln
X   dentry   log
X   dentry   exp
X   dentry   pow
X   dentry   tanh
X   dentry   cosh
X   dentry   sinh
X   dentry   tan
X   dentry   cos
X   dentry   sin
X   dentry   atan
X
X   dentry   currentpoint
X   dentry   gsave
X   dentry   grestore
X   dentry   translate
X   dentry   scale
X   dentry   rotate
X   dentry   concat
X   dentry   concatmatrix
X   dentry   transform
X   dentry   dtransform
X
X   dentry   def
X   dentry   pop
X   dentry   exch
X   dentry   dup
X   dentry   copy
X   dentry   index
X   dentry   roll
X   dentry   count
X   dentry   clear
X   dentry   true
X   dentry   false
X
X   dentry   exec
X   dentry   if
X   dentry   ifelse
X   dentry   for
X   dentry   repeat
X   dentry   loop
X   dentry   exit
X   dentry   stop
X   dentry   stopped
X   dentry   countexecstack
X   dentry   execstack
X   dentry   start
X
X   dentry   cvr
X   dentry   cvi
X   dentry   cvs
X
X   dentry   stringwidth
X   dentry   charpath
X   dentry   strokepath
X   dentry   setlinewidth
X   dentry   currentlinewidth
X   dentry   setlinecap
X   dentry   currentlinecap
X   dentry   setlinejoin
X   dentry   currentlinejoin
X   dentry   setflat
X   dentry   currentflat
X
X   dentry   show
X   dentry   moveto
X   dentry   rmoveto
X   dentry   lineto
X   dentry   rlineto
X   dentry   curveto
X   dentry   rcurveto
X   dentry   closepath
X   dentry   newpath
X   dentry   setgray
X   dentry   currentgray
X   dentry   greyline
X   dentry   flood
X   dentry   fill
X   dentry   stroke
X   dentry   erasepage
X   dentry   pencolor
X   dentry   penbcolor
X   dentry   penmode
X   dentry   penpattern
X   dentry   box
X   dentry   currentrgbcolor
X   dentry   setrgbcolor
X   dentry   findfont
X   dentry   scalefont
X   dentry   makefont
X   dentry   setfont
X   dentry   currentfont
X   dentry   pixel
X
Xfdict
X   dcb.w    5*SizeDict,0
Xenddict
X   dcb.w    10,0
X
Xsarea
X   nentry   hex
X   nentry   quit
X   nentry   run
X   nentry   print
X*   nentry   equalsprint
X.equalsprint      dc.b  1,'='
X   nentry   file
X   nentry   read
X   nentry   write
X
X   nentry   string
X   nentry   dict
X   nentry   begin
X   nentry   end
X   nentry   array
X   nentry   maxlength
X   nentry   length
X   nentry   get
X   nentry   put
X
X   nentry   mark
X*  nentry   lbracket
X.lbracket   dc.b  1,'['
X*  nentry   rbracket
X.rbracket   dc.b  1,']'
X
X   nentry   save
X   nentry   restore
X
X   nentry   eq
X   nentry   ne
X   nentry   ge
X   nentry   gt
X   nentry   le
X   nentry   lt
X   nentry   add
X   nentry   sub
X   nentry   mul
X   nentry   idiv
X   nentry   div
X   nentry   mod
X   nentry   abs
X   nentry   neg
X   nentry   ceiling
X   nentry   floor
X   nentry   round
X   nentry   truncate
X
X   nentry   sqrt
X   nentry   ln
X   nentry   log
X   nentry   exp
X   nentry   pow
X   nentry   tanh
X   nentry   cosh
X   nentry   sinh
X   nentry   tan
X   nentry   cos
X   nentry   sin
X   nentry   atan
X
X   nentry   currentpoint
X   nentry   gsave
X   nentry   grestore
X   nentry   translate
X   nentry   scale
X   nentry   rotate
X   nentry   concat
X   nentry   concatmatrix
X   nentry   transform
X   nentry   dtransform
X
X   nentry   def
X   nentry   pop
X   nentry   exch
X   nentry   dup
X   nentry   copy
X   nentry   index
X   nentry   roll
X   nentry   count
X   nentry   clear
X   nentry   true
X   nentry   false
X
X   nentry   exec
X   nentry   if
X   nentry   ifelse
X   nentry   for
X   nentry   repeat
X   nentry   loop
X   nentry   exit
X   nentry   stop
X   nentry   stopped
X   nentry   countexecstack
X   nentry   execstack
X   nentry   start
X
X   nentry   cvr
X   nentry   cvi
X   nentry   cvs
X
X   nentry   stringwidth
X   nentry   charpath
X   nentry   strokepath
X   nentry   setlinewidth
X   nentry   currentlinewidth
X   nentry   setlinecap
X   nentry   currentlinecap
X   nentry   setlinejoin
X   nentry   currentlinejoin
X   nentry   setflat
X   nentry   currentflat
X   nentry   show
X   nentry   moveto
X   nentry   rmoveto
X   nentry   lineto
X   nentry   rlineto
X   nentry   curveto
X   nentry   rcurveto
X   nentry   closepath
X   nentry   newpath
X   nentry   setgray
X   nentry   currentgray
X   nentry   greyline
X   nentry   flood
X   nentry   fill
X   nentry   stroke
X   nentry   erasepage
X   nentry   pencolor
X   nentry   penbcolor
X   nentry   penmode
X   nentry   penpattern
X   nentry   box
X   nentry   currentrgbcolor
X   nentry   setrgbcolor
X   nentry   findfont
X   nentry   scalefont
X   nentry   makefont
X   nentry   setfont
X   nentry   currentfont
X   nentry   pixel
X
X   cnop  0,2
X
X   end
X
\Rogue\Monster\
else
  echo "will not over write ./dict.a"
fi
if [ `wc -c ./dict.a | awk '{printf $1}'` -ne 7654 ]
then
echo `wc -c ./dict.a | awk '{print "Got " $1 ", Expected " 7654}'`
fi
if `test ! -s ./fan`
then
echo "writing ./fan"
sed 's/^X//' > ./fan << '\Rogue\Monster\'
X
Xsave
X
X/h {350 100 moveto} def
X
X 50 10 200
X { h 400 exch lineto stroke} for
X
X 390 -10 250
X { h 200 lineto stroke} for
X
X 190 -10 50
X { h 250 exch lineto stroke} for
X
X 260 10 390
X { h 50 lineto stroke} for
X
Xrestore
X
\Rogue\Monster\
else
  echo "will not over write ./fan"
fi
if [ `wc -c ./fan | awk '{printf $1}'` -ne 214 ]
then
echo `wc -c ./fan | awk '{print "Got " $1 ", Expected " 214}'`
fi
if `test ! -s ./ffpa.a`
then
echo "writing ./ffpa.a"
sed 's/^X//' > ./ffpa.a << '\Rogue\Monster\'
X
X   xdef  FFPAFP
X   xdef  FFPFPA
X
X   section  one
X
XFFPAFP
X   moveq     #0,D7
X   moveq     #0,D6
X   bsr       R0004CA
X   beq       lab0448
X   bcs       lab042E
X   cmp.b     #'-',D5
X   seq       D6
X   swap      D6
X   bsr       R0004CA
X   beq       lab0448
Xlab042E
X   cmp.b     #'.',D5
X   bne       lab043A
X   bsr       R0004CA
X   beq       lab04A4
Xlab043A
X   subq.l    #1,A0
X   or.b     #1,CCR
X   rts       
Xlab0442
X   bsr       R0004CA
X   bne       lab049A
Xlab0448
X   bsr       R0004AC
X   bcc       lab0442
Xlab044C
X   addq.w    #1,D6
X   bsr       R0004CA
X   beq       lab044C
X   cmp.b     #'.',D5
X   bne       lab045C
Xlab0458
X   bsr       R0004CA
X   beq       lab0458
Xlab045C
X   cmp.b     #'E',D5
X   bne       lab0492
X   bsr       R0004CA
X   beq       lab0476
X   bcs       lab043A
X   rol.l     #8,D6
X   cmp.b     #'-',D5
X   seq       D6
X   ror.l     #8,D6
X   bsr       R0004CA
X   bne       lab043A
Xlab0476
X   move.w    D5,D4
Xlab0478
X   bsr       R0004CA
X   bne       lab048A
X   mulu      #$0A,D4
X   cmp.w     #$07D0,D4
X   bhi       lab043A
X   add.w     D5,D4
X   bra       lab0478
Xlab048A
X   tst.l     D6
X   bpl       lab0490
X   neg.w     D4
Xlab0490
X   add.w     D4,D6
Xlab0492
X   subq.l    #1,A0
X   jmp       FFPDBF
Xlab049A
X   cmp.b     #'.',D5
X   bne       lab045C
Xlab04A0
X   bsr       R0004CA
X   bne       lab045C
Xlab04A4
X   bsr       R0004AC
X   bcs       lab0458
X   subq.w    #1,D6
X   bra       lab04A0
X
XR0004AC
X   move.l    D7,D3
X   lsl.l     #1,D3
X   bcs       lab04C8
X   lsl.l     #1,D3
X   bcs       lab04C8
X   lsl.l     #1,D3
X   bcs       lab04C8
X   add.l     D7,D3
X   bcs       lab04C8
X   add.l     D7,D3
X   bcs       lab04C8
X   add.l     D5,D3
X   bcs       lab04C8
X   move.l    D3,D7
Xlab04C8
X   rts       
X
XR0004CA
X   moveq     #0,D5
X   move.b    (A0)+,D5
X   cmp.b     #'+',D5
X   beq       lab04F0
X   cmp.b     #'-',D5
X   beq       lab04F0
X   cmp.b     #'0',D5
X   bcs       lab04F6
X   cmp.b     #'9',D5
X   bhi       lab04F6
X   and.b     #$0F,D5
X   move      #4,CCR
X   rts       
Xlab04F0
X   move      #0,CCR
X   rts       
Xlab04F6
X   move      #1,CCR
X   rts       
X
X
X
XFFPDBF
X   moveq     #$20,D5
X   tst.l     D7
X   beq       lab0330
X   bmi       lab02B6
X   moveq     #$1F,D5
Xlab02B0
X   add.l     D7,D7
X   dbmi      D5,lab02B0
Xlab02B6
X   cmp.w     #$12,D6
X   bgt       lab033A
X   cmp.w     #$FFE4,D6
X   blt       lab0332
X   move.w    D6,D4
X   neg.w     D4
X   muls      #6,D4
X   move.l    A0,-(SP)
X   lea       .wmidtable,A0
X   add.w     0(A0,D4.w),D5
X   move.w    D5,D6
X   move.l    2(A0,D4.w),D3
X   move.l    (SP),A0
X   move.l    D3,(SP)
X   move.w    D7,D5
X   mulu      D3,D5
X   clr.w     D5
X   swap      D5
X   moveq     #0,D4
X   swap      D3
X   mulu      D7,D3
X   add.l     D3,D5
X   addx.b    D4,D4
X   swap      D7
X   move.w    D7,D3
X   mulu      2(SP),D3
X   add.l     D3,D5
X   bcc       lab0300
X   addq.b    #1,D4
Xlab0300
X   move.w    D4,D5
X   swap      D5
X   mulu      (SP),D7
X   lea       4(SP),SP
X   add.l     D5,D7
X   bmi       lab0312
X   add.l     D7,D7
X   subq.w    #1,D6
Xlab0312
X   add.l     #$00000080,D7
X   bcc       lab031E
X   roxr.l    #1,D7
X   addq.w    #1,D6
Xlab031E
X   moveq     #9,D3
X   move.w    D6,D4
X   asl.w     D3,D6
X   bvs       lab0336
X   eor.w     #$8000,D6
X   lsr.l     D3,D6
X   move.b    D6,D7
X   beq       lab0332
Xlab0330
X   rts       
Xlab0332
X   moveq     #0,D7
X   rts       
Xlab0336
X   tst.w     D4
X   bmi       lab0332
Xlab033A
X   moveq     #-1,D7
X   swap      D6
X   roxr.b    #1,D6
X   roxr.b    #1,D7
X   tst.b     D7
X   or.b      #2,CCR
X   rts       
X
X
XFFPFPA
X   lea       -$0A(SP),SP
X   move.l    $0A(SP),-(SP)
X   move.w    #0,-(SP)
X   tst.b     D7
X   movem.l   D2-D6/A0/A1,-(SP)
X   bne       lab0512
X   moveq     #$41,D7
Xlab0512
X   move.w    #$2B2E,$22(SP)
X   move.b    D7,D6
X   bpl       lab0520
X   addq.b    #2,$22(SP)
Xlab0520
X   add.b     D6,D6
X   move.b    #$80,D7
X   eor.b     D7,D6
X   ext.w     D6
X   asr.w     #1,D6
X   moveq     #1,D3
X   lea       .wmidtable,A0
X   cmp.w     (A0),D6
X   blt       lab0554
X   bgt       lab0546
Xlab053A
X   cmp.l     2(A0),D7
X   bcc       lab0560
Xlab0540
X   addq.w    #6,A0
X   subq.w    #1,D3
X   bra       lab0560
Xlab0546
X   lea       -6(A0),A0
X   addq.w    #1,D3
X   cmp.w     (A0),D6
X   bgt       lab0546
X   beq       lab053A
X   bra       lab0540
Xlab0554
X   lea       6(A0),A0
X   subq.w    #1,D3
X   cmp.w     (A0),D6
X   blt       lab0554
X   beq       lab053A
Xlab0560
X   move.l    #$452B3030,$2C(SP)
X   move.w    D3,D2
X   bpl       lab0572
X   neg.w     D2
X   addq.b    #2,$2D(SP)
Xlab0572
X   cmp.w     #$0A,D2
X   bcs       lab0580
X   addq.b    #1,$2E(SP)
X   sub.w     #$0A,D2
Xlab0580
X   or.b      D2,$2F(SP)
X   moveq     #7,D2
X   lea       $24(SP),A1
X   tst.l     D7
X   bpl       lab0594
X   tst.b     5(A0)
X   bne       lab0596
Xlab0594
X   clr.b     D7
Xlab0596
X   move.w    D6,D4
X   sub.w     (A0)+,D4
X   move.l    (A0)+,D5
X   lsr.l     D4,D5
X   moveq     #9,D4
Xlab05A0
X   sub.l     D5,D7
X   dbcs      D4,lab05A0
X   bcs       lab05AA
X   clr.b     D4
Xlab05AA
X   add.l     D5,D7
X   sub.b     #9,D4
X   neg.b     D4
X   or.b      #'0',D4
X   move.b    D4,(A1)+
X   dbra      D2,lab0596
X   move.w    D3,D7
X   ext.l     D7
X   movem.l   (SP)+,D2-D6/A0/A1
X   addq.l    #2,SP
X   rts       
X
X   section  two,data
X
X.wFFP10TBL
X   dc.w      $40,$8AC7,$2305,$3C,$DE0B,$6B3A
X   dc.w      $39,$B1A2,$BC2F,$36,$8E1B,$C9BF
X   dc.w      $32,$E35F,$A932,$2F,$B5E6,$20F5
X   dc.w      $2C,$9184,$E72A,$28,$E8D4,$A510
X   dc.w      $25,$BA43,$B740,$22,$9502,$F900
X   dc.w      $1E,$EE6B,$2800,$1B,$BEBC,$2000
X   dc.w      $18,$9896,$8000,$14,$F424,0,$11
X   dc.w      $C350,0,$0E,$9C40,0,$0A,$FA00
X   dc.w      0,7,$C800,0,4,$A000,0
X.wmidtable
X   dc.w      1,$8000,0,$FFFD,$CCCC,$CCCD,$FFFA
X   dc.w      $A3D7,$0A3D,$FFF7,$8312,$6E98
X   dc.w      $FFF3,$D1B7,$1759,$FFF0,$A7C5
X   dc.w      $AC47,$FFED,$8637,$BD06,$FFE9
X   dc.w      $D6BF,$94D6,$FFE6,$ABCC,$7712
X   dc.w      $FFE3,$8970,$5F41,$FFDF,$DBE6
X   dc.w      $FECF,$FFDC,$AFEB,$FF0C,$FFD9
X   dc.w      $8CBC,$CC09,$FFD5,$E12E,$1342
X   dc.w      $FFD2,$B424,$DC35,$FFCF,$901D
X   dc.w      $7CF7,$FFCB,$E695,$94BF,$FFC8
X   dc.w      $B877,$AA32,$FFC5,$9392,$EE8F
X   dc.w      $FFC1,$EC1E,$4A7E,$FFBE,$BCE5
X   dc.w      $0865,$FFBB,$971D,$A050,$FFB7
X   dc.w      $F1C9,$81,$FFB4,$C16D,$9A01,$FFB1
X   dc.w      $9ABE,$14CD,$FFAD,$F796,$87AE
X   dc.w      $FFAA,$C612,$0625,$FFA7,$9E74
X   dc.w      $D1B8,$FFA3,$FD87,$B5F3
X
X   end
X
\Rogue\Monster\
else
  echo "will not over write ./ffpa.a"
fi
if [ `wc -c ./ffpa.a | awk '{printf $1}'` -ne 6330 ]
then
echo `wc -c ./ffpa.a | awk '{print "Got " $1 ", Expected " 6330}'`
fi
if `test ! -s ./files.a`
then
echo "writing ./files.a"
sed 's/^X//' > ./files.a << '\Rogue\Monster\'
X
X* file input
X
X* in console.o
X   xref  start_console
X   xref  stop_console
X   xref  conmayread
X   xref  conputchar
X   xref  conputstr
X
X* in ps.o
X   xref  ihandle,ohandle
X   xref  rastport,wbscreen
X   xref  intuitionbase
X   xref  graphicsbase
X   xref  mathffpbase
X   xref  mathtransbase
X
X   xref  _quit
X
X   xref  type_mismatch
X   xref  reinterp
X   xref  ipop
X   xref  r.ipush
X
X* in lmath.o
X   xref  lmoddivu
X* in ffpa.o
X   xref  FFPFPA
X
X
X   xdef  the_window
X   xdef  viewport
X   xdef  abortps
X
X   xdef  readln
X   xdef  runclose    called by _quit
X
X   xdef  showreal
X   xdef  show8x
X   xdef  showdec
X   xdef  newline
X   xdef  getstr
X   xdef  msg,longmsg
X   xdef  ioinit
X   xdef  endio
X
X
X   section  one
X
X   include  "ps.h"
X
X
X
X   lref     CloseScreen,7
X   lref     CloseWindow,8
X   lref     OpenScreen,29
X   lref     OpenWindow,30
X
Xintuit   macro
X      move.l   A6,-(SP)
X      move.l   intuitionbase,A6
X      jsr      _LVO\1(A6)
X      move.l   (SP)+,A6
X      endm
X
X
XSysBase  equ   4
X
X   lref     OpenLibrary,88
X
X
X   lref     Output,6
X   lref     Input,5
X   lref     Write,4
X   lref     Read,3
X   lref     DeleteFile,8
X   lref     Open,1
X   lref     Close,2
X   lref     IoErr,18
X   lref     LoadSeg,21
X   lref     UnLoadSeg,22
X   lref     IsInteractive,32
X
X
XIbufLen     equ   80
XRnameLen    equ   30
X
Xabortps
X   print    leaving
X   bra      _quit
X
X
X  DEF   run
X   bsr      ipop
X   cmp.w    #String,D2
X   bne      type_mismatch
X
X   lea      runflag,A0
X   tst.b    (A0)
X   bne      .rierr
X
X   move.l   D0,A0
X   move.w   (A0)+,D3
X   beq      .rnerr
X   cmp.w    #RnameLen,D3
X   bhi      .rnerr
X   lea      runname,A1
X   move.l   A1,D1
X   bra      2$
X1$ move.b   (A0)+,(A1)+
X2$ dbra     D3,1$
X   clr.b    (A1)
X   move.l   #1005,D2
X   call     Open
X   tst.l    D0
X   beq      .opnerr
X
X   move.b   #$FF,runflag
X
X* save standard input data
X   move.l   ihandle,s_ihandle
X   move.l   bufptr,s_bufptr
X   move.b   bufchcount,s_bufchcount
X   move.w   #IbufLen+4,D3
X   lea      ilen,A0
X   lea      s_ibuf,A1
X   bra      4$
X3$ move.b   (A0)+,(A1)+
X4$ dbra     D3,3$
X
X* initialize for run file
X   move.l   D0,ihandle
X   lea      ibuf,A0
X   move.l   A0,bufptr
X   clr.b    bufchcount
X   rts
X
Xrunclose
X   st       D0          signal exhausted
X   lea      runflag,A0
X   tst.b    (A0)
X   bne      1$
X   lea      backgroundflag,A0
X   tst.b    (A0)
X   beq      5$
X   clr.b    (A0)
X   moveq    #0,D0
X   rts
X
X1$ clr.b    (A0)
X
X   move.l   ihandle,D1
X   call     Close
X
X* restore standard input data
X   move.l   s_ihandle,ihandle
X   move.l   s_bufptr,bufptr
X   move.b   s_bufchcount,bufchcount
X   move.w   #IbufLen+4,D3
X   lea      ilen,A1
X   lea      s_ibuf,A0
X   bra      4$
X3$ move.b   (A0)+,(A1)+
X4$ dbra     D3,3$
X   move.b   bufchcount,D0
X5$ rts
X
X.rierr
X   print    ri_err
X   bra      reinterp
X.rnerr
X   print    rn_err
X   bra      reinterp
X.opnerr
X   print    op_err
X   bra      reinterp
X
X   bstr     ri_err,<can''t imbed run files>
X   bstr     rn_err,<bad file name>
X   bstr     op_err,<can''t open file>
X   bstr     leaving,<problem of some sort>
X   cnop     0,2
X
X* return A0 pointing to line and D3 length of line
Xreadln
X   move.l   bufptr,A0
X   move.l   A0,-(SP)
X   moveq    #0,D3       * no chars in line yet
X* back to here when was necessary to read more from file
X.rdln.cont
X   moveq    #0,D2
X   move.b   bufchcount,D2
X   bmi      5$          * this means file is exhausted
X   beq      .rdln.more
X
X   subq.b   #1,D2
X2$ cmp.b    #10,(A0)+
X   beq      4$
X   addq.b   #1,D3
X3$ dbra     D2,2$
X* ran out of chars -- go get more
X   bra      .rdln.more
X* have one line -- check not empty
X4$ tst.b    D3
X   bne      5$
X   move.l   A0,(SP)     * replace pointer to ret.
X   bra      3$
X5$ move.l   A0,bufptr
X   move.b   D2,bufchcount
X   move.l   (SP)+,A0
X   rts
X
X
X.rdln.more
X* have partial line in buffer with D3 chars in it
X   move.l   (SP)+,A1    * beginning of partial line
X* while D3>0 move chars back to beginning of buffer
X   lea      ibuf,A0
X   move.l   A0,-(SP)    * for ret.
X   move.l   D3,-(SP)
X   subq.b   #1,D3
X   bmi      8$          * if line was of 0 length
X6$ move.b   (A1)+,(A0)+
X   dbra     D3,6$
X
X* fill remainder of buffer with 80-(D3) chars
X8$ move.l   #IbufLen,D3
X   move.l   (SP)+,D0
X   sub.b    D0,D3
X   move.l   D0,-(SP)
X
X   lea      ibuf,A1
X   add.l    D0,A1
X* save where to continue processing line
X   move.l   A1,-(SP)
X
X   move.l   ihandle,D1
X   move.l   A1,D2
X*   call     Read
X   bsr      nread
X
X   tst.b    D0
X   bne      9$
X   bsr      runclose
X9$ move.b   D0,bufchcount
X
X   move.l   (SP)+,A0       * continue processing here
X   move.l   (SP)+,D3       * chars scanned so far
X   bra      .rdln.cont
X
X
Xshowreal
X   move.l   D0,D7
X   jsr      FFPFPA
X   lea      olen,A1
X   move.l   A1,A0
X   move.b   #14,(A1)+
X   moveq    #6,D1
X1$ move.w   (SP)+,(A1)+
X   dbra     D1,1$
X   bsr      fmtfloat
X*   bra      msg
X   rts
X
Xfmtfloat
X   cmp.b    #'0',13(A0)    would be too many digits?
X   bne      10$
X   cmp.b    #'4',10(A0)    last digit often wrong
X   bhi      89$
X   move.b   #'0',10(A0)
X89$
X   cmp.b    #'-',12(A0)
X   bne      100$
X   moveq    #10,D2
X   moveq    #0,D1
X90$
X   cmp.b    #'0',0(A0,D2.w)
X   bne      91$
X   subq.l   #1,D2
X   addq.l   #1,D1
X   bra      90$
X91$
X   move.b   14(A0),D3
X   sub.b    #'0',D3
X   cmp.b    D1,D3
X   bgt      10$
X   move.l   D2,D1
X   add.l    D3,D1
X92$
X   move.b   0(A0,D2.w),D0
X   cmp.b    #'.',D0
X   bne      93$
X   move.b   #'0',D0
X   addq     #1,D2
X93$
X   move.b   D0,0(A0,D1.w)
X   subq     #1,D2
X   subq     #1,D1
X   cmp      #2,D1
X   bne      92$
X
X   move.b   #'0',14(A0)
X
X100$
X   move.b   #'0',11(A0)
X   moveq    #0,D3
X   move.b   14(A0),D3
X   sub.b    #'0',D3
X   movem.l  A0/A1,-(SP)
X   lea      2(A0),A1
X   lea      3(A0),A0
X   bra      2$
X1$ move.b   (A0)+,(A1)+
X2$ dbra     D3,1$
X   move.b   #'.',(A1)
X   movem.l  (SP)+,A0/A1
X
X   moveq    #11,D3
X   move.b   D3,(A0)
X3$ cmp.b    #'0',0(A0,D3.w)
X   bne      4$
X   sub.b    #1,(A0)
X   subq     #1,D3
X   bra      3$
X
X4$ cmp.b    #'.',0(A0,D3.w)
X   bne      5$
X   sub.b    #1,(A0)
X   cmp.b    #1,(A0)
X   bne      5$
X   move.b   #'0',1(A0)
X   rts
X5$
X
X10$
X   cmp.b    #'+',1(A0)     remove initial +
X   bne      11$
X   move.b   (A0)+,D0
X   subq.b   #1,D0
X   move.b   D0,(A0)
X11$
X   rts
X
Xshow8x
X   bsr      binhex
X   lea      olen,A0
X
X   move.l   A0,A1
X   move.b   (A1)+,D1
X1$ cmp.b    #'0',(A1)+
X   bne      2$         *msg
X   subq.b   #1,D1
X   beq      2$         *msg
X   addq.l   #1,A0
X   move.b   D1,(A0)
X   bra      1$
X2$ rts
X
Xshowdec
X   lea      obuf,A2
X   lea      10(A2),A2
X   moveq    #8,D3
X   move.l   D0,-(SP)
X   move.l   D0,D1
X   bpl      3$
X   neg.l    D1
X3$ moveq    #10,D2
X   jsr      lmoddivu    D1/D2->D1, rem in D0
X   move.b   D0,-(A2)
X   add.b    #'0',(A2)
X   dbra     D3,3$
X
X   moveq    #9,D1
X4$ cmp.b    #'0',(A2)
X   bne      6$
X   subq     #1,D1
X   beq      5$
X   addq.l   #1,A2
X   bra      4$
X5$ addq     #1,D1
X6$ move.l   (SP)+,D0
X   bpl      7$
X   move.b   #'-',-(A2)
X   addq     #1,D1
X7$ move.b   D1,-(A2)
X   move.l   A2,A0
X*   bra      msg
X   rts
X
X* D0 to hex in obuf
Xbinhex
X   move.b   #8,olen
X   lea      obuf,A0
X   add.l    #8,A0
X   lea      hextab,A1
X   moveq    #7,D1
X1$ move.l   D0,D2
X   and.l    #15,D2
X   move.b   0(A1,D2),-(A0)
X   lsr.l    #4,D0
X   dbra     D1,1$
X   rts
X
Xhextab   dc.b  '0123456789ABCDEF'
X
Xnread
X   tst.w    runflag     i.e., run or background
X   beq      conreadln
X   call     Read
X   rts
X
XCSI      equ   $9B
X
Xconreadln
X   move.l   D4,-(SP)
X   move.l   D2,A0
X   moveq    #0,D1
X   move.l   D1,D4
X
X   tst.l    D3
X   beq      6$
X
X1$ movem.l  D1/A0,-(SP)
X2$ bsr      conmayread
X   tst.l    D0
X   bmi      2$
X   cmp.b    #13,D0
X   bne      3$
X   move.b   #10,D0
X3$
X   bsr      echochar
X   movem.l  (SP)+,D1/A0
X   bsr      csicheck
X   beq      1$
X   cmp.b    #10,D0
X   beq      41$
X   cmp.b    #8,D0
X   bne      4$
X   tst.l    D1
X   beq      5$
X   subq.l   #1,A0
X   subq.l   #1,D1
X   bra      5$
X4$
X   cmp.b    #' ',D0
X   bcs      5$
X41$
X   or.b     D4,D0
X   move.b   D0,(A0)+
X   addq.l   #1,D1
X5$
X   cmp.l    D3,D1
X   beq      6$
X   cmp.b    #10,D0
X   bne      1$
X6$ move.l   (SP)+,D4
X   move.l   D1,D0
X   rts
X
Xechochar
X   move.w   D0,-(SP)
X   cmp.b    #CSI,D0
X   beq      8$
X   cmp.b    #' ',D0
X   bcc      6$
X   cmp.b    #10,D0
X   beq      6$
X   cmp.b    #8,D0
X   beq      6$
X   cmp.b    #14,D0      shift in
X   bne      1$
X   move.b   #$80,D4
X   bra      6$
X1$
X   cmp.b    #15,D0      shift out
X   bne      8$
X   clr.b    D4
X6$
X   bsr      conputchar
X8$
X   move.w   (SP)+,D0
X   rts
X
Xcsicheck
X   cmp.b    #CSI,D0
X   bne      100$
X   movem.l  D1/A0,-(SP)
X1$ bsr      conmayread
X   tst.l    D0
X   bmi      1$
X   cmp.b    #'A',D0     up
X   beq      3$
X   cmp.b    #'B',D0     down
X   beq      3$
X   cmp.b    #'C',D0     left
X   beq      3$
X   cmp.b    #'D',D0     right
X   beq      3$
X2$ bsr      conmayread
X   tst.l    D0
X   bmi      2$
X   cmp.b    #'~',D0
X   bne      2$
X3$
X   movem.l  (SP)+,D1/A0
X100$
X   rts
X
Xgetstr
X   bsr      readln
X   tst.l    D3
X   beq      _quit
X   move.l   A0,A1
X   lea      -1(A1,D3.W),A0
X   cmp.b    #10,(A0)       case of file that does not end w. NL
X   beq      1$
X   addq.l   #1,A0
X1$ move.b   #0,(A0)
X   rts
X
X
X  DEF    file
X  ARG    String
X   move.l   D0,A1
X  ARG    String
X   move.l   D0,A0
X   move.w   (A1)+,D3
X   subq.w   #1,D3
X   bne      5$
X   move.b   (A1),D1
X   lea      stdinname,A1
X   bsr      st01cmp
X   bne      2$
X   cmp.b    #'r',D1
X   bne      5$
X   moveq    #1,D0
X   bra      4$
X2$ lea      stdoutname,A1
X   bsr      st01cmp
X   bne      6$
X   cmp.b    #'w',D1
X   bne      5$
X   moveq    #2,D0
X4$ RETURN    File
X5$ ERR    badfa
X6$ ERR    badfn
X
X  DEF    read
X  ARG    File
X   subq.l   #1,D0
X   bne      3$
X1$ bsr      conmayread
X   tst.l    D0
X   bmi      1$
X   bsr      2$
X   moveq    #-1,D0
X   RETURN    Boolean
X2$ RETURN    Integer
X3$ ERR   filerr
X
X
X  DEF    write
X  ARG    Integer
X   move.l   D0,D1
X  ARG    File
X   exg      D0,D1
X   subq.l   #2,D1
X   beq      conputchar
X  ERR   filerr
X
Xst01cmp
X   move.l   A0,-(SP)
X   move.w   (A0)+,D3
X   cmp.b    (A1)+,D3
X   bne      2$
X   subq.l   #1,D3
X1$ cmp.b    (A0)+,(A1)+
X   dbne     D3,1$
X2$ move.l   (SP)+,A0
X   rts
X
Xstdinname   dc.b  6,'%stdin'
Xstdoutname  dc.b  7,'%stdout'
X   cnop     0,2
X
Xnewline
X   move.b   #10,D0
Xprtchr
X   move.b   D0,obuf
X   move.l   ohandle,D1
X   lea      obuf,A1
X   move.l   A1,D2
X   moveq    #1,D3
X   bra      .msg1
X
X*  message to console
Xmsg
X   clr.l    D3
X   move.b   (A0)+,D3
Xlongmsg
X   move.l   ohandle,D1
X   move.l   A0,D2
X.msg1
X*   call     Write
X   bra      conputstr
X*   rts
X
X* obtain pointer to AmigaDOS
Xioinit
X   move.l   SysBase,A6        * ready call to OpenLibrary
X
X   lea      ilibname,A1
X   moveq    #0,D0
X   call     OpenLibrary
X   move.l   D0,intuitionbase
X   move.l   D0,A0
X   lea      $3C(A0),A0
X   move.l   (A0),A0
X   move.l   A0,wbscreen
X
X   lea      $2C(A0),A1
X   move.l   A1,viewport
X
X   lea      4(A0),A0
X
X   move.l   (A0),A0
X*   move.l   A0,thiswindow
X1$ move.l   (A0),D0
X   beq      2$
X   move.l   D0,A0
X   bra      1$
X2$
X*   move.l   A0,doswindow
X
X   lea      $32(A0),A0
X   move.l   (A0),rastport
X
X   lea      glibname,A1
X   moveq    #0,D0
X   call     OpenLibrary
X   move.l   D0,graphicsbase
X
X   lea      mlibname,A1
X   moveq    #0,D0
X   call     OpenLibrary
X   move.l   D0,mathffpbase
X
X   lea      tlibname,A1
X   moveq    #0,D0
X   call     OpenLibrary
X   move.l   D0,mathtransbase
X
X   lea      libname,A1
X   moveq    #0,D0
X   call     OpenLibrary
X   move.l   D0,A6
X*   move.l   D0,DOS_point
X* obtain file handles for output and input opened by CLI
X   call     Output
X   move.l   D0,ohandle
X   call     Input
X   move.l   D0,ihandle
X
X   move.l   D0,D1
X   call     IsInteractive
X   tst.l    D0
X   bne      .ii1
X   move.b   #$FF,backgroundflag
X.ii1
X
X
X   ifne     HiRes
X   lea      my_screen,A0
X   intuit   OpenScreen
X   move.l   D0,the_screen
X   move.l   D0,the_screenb
X
X   move.l   D0,A0
X   lea      $2C(A0),A0
X   move.l   A0,viewport
X
X   lea      my_bwindow,A0
X   intuit   OpenWindow
X   move.l   D0,the_bwindow
X
X* ShowTitle(FALSE) around here
X   move.l   D0,A0
X   lea      $32(A0),A0
X   move.l   (A0),rastport
X
X   lea      my_window,A0
X   intuit   OpenWindow
X   move.l   D0,the_window
X
X   bsr      start_console
X
X   endc
X
X   rts
X
X
Xendio
X
X   ifne  HiRes
X   bsr      stop_console
X
X   move.l   the_window,A0
X   intuit   CloseWindow
X
X   move.l   the_bwindow,A0
X   intuit   CloseWindow
X
X   move.l   the_screen,A0
X   intuit   CloseScreen
X   endc
X   rts
X
X
X
X
X   section  fdata,data
X
Xbufptr         dc.l  ibuf
Xbufchcount     dc.b  0,0
X
Xs_ihandle      dc.l  0
Xs_bufptr       dc.l  0
Xs_bufchcount   dc.b  0,0
Xrunflag        dc.b  0
Xbackgroundflag dc.b  0
X
Xiihandle    dc.l     0
Xcloseit     dc.l     0
X
X   bstr  badfa,<unknown file attribute>
X   bstr  badfn,<only files %stdin/out>
X   bstr  filerr,<file error>
X
X
X*wname       dc.b     'CON:0/0/640/40/'
Xsignature    dc.b  ' ps  PostScript emulator, ) Greg Lee, April, 1986 ',0
X            cnop     0,2
X
X
X
X; ======================================================================== 
X; === NewScreen ========================================================== 
X; ======================================================================== 
X* STRUCTURE NewScreen,0
X*
X*    WORD ns_LeftEdge      ; initial Screen dimensions
X*    WORD ns_TopEdge      ; initial Screen dimensions
X*    WORD ns_Width      ; initial Screen dimensions
X*    WORD ns_Height      ; initial Screen dimensions
X*    WORD ns_Depth      ; initial Screen dimensions
X*
X*    BYTE ns_DetailPen      ; default rendering pens (for Windows too)
X*    BYTE ns_BlockPen      ; default rendering pens (for Windows too)
X*
X*    WORD ns_ViewModes      ; display "modes" for this Screen
X*
X*    WORD ns_Type      ; Intuition Screen Type specifier
X*
X*    APTR ns_Font      ; default font for Screen and Windows
X*
X*    APTR ns_DefaultTitle   ; Title when Window doesn't care
X*
X*    APTR ns_Gadgets      ; Your own initial Screen Gadgets
X*
X*    ; if you are opening a CUSTOMSCREEN and already have a BitMap 
X*    ; that you want used for your Screen, you set the flags CUSTOMBITMAP in
X*    ; the Types variable and you set this variable to point to your BitMap
X*    ; structure.  The structure will be copied into your Screen structure,
X*    ; after which you may discard your own BitMap if you want
X*    APTR ns_CustomBitMap;
X*
X* LABEL    ns_SIZEOF
X*
X*
X
X
Xviewport       dc.l  0
X
X   ifne  HiRes
Xthe_window     dc.l  0
X
Xmy_screen
X   dc.w     0,0,640,400
X
X   dc.w     NumPlanes         depth
X   dc.b     0,1
X   dc.w     $C004             modes
X   dc.w     $0F               type = custon
X   dc.l     screenfont        font
X   dc.l     signature         title
X   dc.l     0                 no gadgets
X   dc.l     0                 no bitmap
X*
X
Xthe_bwindow    dc.l  0
X
Xmy_bwindow
X
X   dc.w     0,0,640,400
X   dc.b     0,1
X   dc.l     0
X
X* flag req. (backdrop,) borderless, smart refresh, nocarerefresh
X   dc.l     $0800+$20000   (+$0100)
X*
X   dc.l      0             first gadget
X   dc.l      0             check mark
X   dc.l      signature      title
X
Xthe_screenb
X   dc.l      0             screen
X
X   dc.l      0             bitmap
X   dc.w     0,0         minimum width and height
X   dc.w     0,0         maximum width and height
X
X   dc.w     $0F            type = customscreen
X
X
X
Xmy_window
X
X   dc.w     100,10,300,100
X   dc.b     0,2
X   dc.l     0              initial IDCMP state
X
X* flags req. sizing, drag,
X* smart refresh , and activate
X   dc.l     $001003+$20000
X*
X   dc.l      0             first gadget
X   dc.l      0             check mark
X   dc.l      .amsname      title
X
Xthe_screen
X   dc.l      0             screen
X
X   dc.l      0             bitmap
X   dc.w     100,45         minimum width and height
X   dc.w     300,100        maximum width and height
X
X   dc.w     $0F            type = customscreen
X
Xscreenfont
X   dc.l     dfname
X   dc.w     9
X   dc.b     0
X   dc.b     %01
Xdfname   dc.b  'topaz.font',0
X
X.amsname    dc.b   ' ps'
X            dcb.b  30,' '
X            dc.b   0
X
X
X   endc
X
Xlibname        dc.b  'dos.library',0
Xilibname       dc.b  'intuition.library',0
Xglibname       dc.b  'graphics.library',0
Xmlibname       dc.b  'mathffp.library',0
Xtlibname       dc.b  'mathtrans.library',0
X
X**************************
X
X
X
X   section  fstr,bss
X
X            ds.b  1     align ibuf
Xilen        ds.b  1
Xibuf        ds.b  IbufLen+2
X
X
X            ds.b  1     align obuf
Xolen        ds.b  1
Xobuf        ds.b  80
X
Xrunname     ds.b  RnameLen+2
X
Xs_ibuf      ds.b  IbufLen+4
X
X   end
X
\Rogue\Monster\
else
  echo "will not over write ./files.a"
fi
if [ `wc -c ./files.a | awk '{printf $1}'` -ne 16356 ]
then
echo `wc -c ./files.a | awk '{print "Got " $1 ", Expected " 16356}'`
fi
echo "Finished archive 3 of 3"
# if you want to concatenate archives, remove anything after this line
exit