home *** CD-ROM | disk | FTP | other *** search
-
- * file input
-
- * in console.o
- xref start_console
- xref stop_console
- xref conmayread
- xref conputchar
- xref conputstr
-
- * in ps.o
- xref ihandle,ohandle
- xref rastport,wbscreen
- xref intuitionbase
- xref graphicsbase
- xref mathffpbase
- xref mathtransbase
-
- xref _quit
-
- xref type_mismatch
- xref reinterp
- xref ipop
- xref r.ipush
-
- * in lmath.o
- xref lmoddivu
- * in ffpa.o
- xref FFPFPA
-
-
- xdef the_window
- xdef viewport
- xdef abortps
-
- xdef readln
- xdef runclose called by _quit
-
- xdef showreal
- xdef show8x
- xdef showdec
- xdef newline
- xdef getstr
- xdef msg,longmsg
- xdef ioinit
- xdef endio
-
-
- section one
-
- include "ps.h"
-
-
-
- lref CloseScreen,7
- lref CloseWindow,8
- lref OpenScreen,29
- lref OpenWindow,30
-
- intuit macro
- move.l A6,-(SP)
- move.l intuitionbase,A6
- jsr _LVO\1(A6)
- move.l (SP)+,A6
- endm
-
-
- SysBase equ 4
-
- lref OpenLibrary,88
-
-
- lref Output,6
- lref Input,5
- lref Write,4
- lref Read,3
- lref DeleteFile,8
- lref Open,1
- lref Close,2
- lref IoErr,18
- lref LoadSeg,21
- lref UnLoadSeg,22
- lref IsInteractive,32
-
-
- IbufLen equ 80
- RnameLen equ 30
-
- abortps
- print leaving
- bra _quit
-
-
- DEF run
- bsr ipop
- cmp.w #String,D2
- bne type_mismatch
-
- lea runflag,A0
- tst.b (A0)
- bne .rierr
-
- move.l D0,A0
- move.w (A0)+,D3
- beq .rnerr
- cmp.w #RnameLen,D3
- bhi .rnerr
- lea runname,A1
- move.l A1,D1
- bra 2$
- 1$ move.b (A0)+,(A1)+
- 2$ dbra D3,1$
- clr.b (A1)
- move.l #1005,D2
- call Open
- tst.l D0
- beq .opnerr
-
- move.b #$FF,runflag
-
- * save standard input data
- move.l ihandle,s_ihandle
- move.l bufptr,s_bufptr
- move.b bufchcount,s_bufchcount
- move.w #IbufLen+4,D3
- lea ilen,A0
- lea s_ibuf,A1
- bra 4$
- 3$ move.b (A0)+,(A1)+
- 4$ dbra D3,3$
-
- * initialize for run file
- move.l D0,ihandle
- lea ibuf,A0
- move.l A0,bufptr
- clr.b bufchcount
- rts
-
- runclose
- st D0 signal exhausted
- lea runflag,A0
- tst.b (A0)
- bne 1$
- lea backgroundflag,A0
- tst.b (A0)
- beq 5$
- clr.b (A0)
- moveq #0,D0
- rts
-
- 1$ clr.b (A0)
-
- move.l ihandle,D1
- call Close
-
- * restore standard input data
- move.l s_ihandle,ihandle
- move.l s_bufptr,bufptr
- move.b s_bufchcount,bufchcount
- move.w #IbufLen+4,D3
- lea ilen,A1
- lea s_ibuf,A0
- bra 4$
- 3$ move.b (A0)+,(A1)+
- 4$ dbra D3,3$
- move.b bufchcount,D0
- 5$ rts
-
- .rierr
- print ri_err
- bra reinterp
- .rnerr
- print rn_err
- bra reinterp
- .opnerr
- print op_err
- bra reinterp
-
- bstr ri_err,<can''t imbed run files>
- bstr rn_err,<bad file name>
- bstr op_err,<can''t open file>
- bstr leaving,<problem of some sort>
- cnop 0,2
-
- * return A0 pointing to line and D3 length of line
- readln
- move.l bufptr,A0
- move.l A0,-(SP)
- moveq #0,D3 * no chars in line yet
- * back to here when was necessary to read more from file
- .rdln.cont
- moveq #0,D2
- move.b bufchcount,D2
- bmi 5$ * this means file is exhausted
- beq .rdln.more
-
- subq.b #1,D2
- 2$ cmp.b #10,(A0)+
- beq 4$
- addq.b #1,D3
- 3$ dbra D2,2$
- * ran out of chars -- go get more
- bra .rdln.more
- * have one line -- check not empty
- 4$ tst.b D3
- bne 5$
- move.l A0,(SP) * replace pointer to ret.
- bra 3$
- 5$ move.l A0,bufptr
- move.b D2,bufchcount
- move.l (SP)+,A0
- rts
-
-
- .rdln.more
- * have partial line in buffer with D3 chars in it
- move.l (SP)+,A1 * beginning of partial line
- * while D3>0 move chars back to beginning of buffer
- lea ibuf,A0
- move.l A0,-(SP) * for ret.
- move.l D3,-(SP)
- subq.b #1,D3
- bmi 8$ * if line was of 0 length
- 6$ move.b (A1)+,(A0)+
- dbra D3,6$
-
- * fill remainder of buffer with 80-(D3) chars
- 8$ move.l #IbufLen,D3
- move.l (SP)+,D0
- sub.b D0,D3
- move.l D0,-(SP)
-
- lea ibuf,A1
- add.l D0,A1
- * save where to continue processing line
- move.l A1,-(SP)
-
- move.l ihandle,D1
- move.l A1,D2
- * call Read
- bsr nread
-
- tst.b D0
- bne 9$
- bsr runclose
- 9$ move.b D0,bufchcount
-
- move.l (SP)+,A0 * continue processing here
- move.l (SP)+,D3 * chars scanned so far
- bra .rdln.cont
-
-
- showreal
- move.l D0,D7
- jsr FFPFPA
- lea olen,A1
- move.l A1,A0
- move.b #14,(A1)+
- moveq #6,D1
- 1$ move.w (SP)+,(A1)+
- dbra D1,1$
- bsr fmtfloat
- * bra msg
- rts
-
- fmtfloat
- cmp.b #'0',13(A0) would be too many digits?
- bne 10$
- cmp.b #'4',10(A0) last digit often wrong
- bhi 89$
- move.b #'0',10(A0)
- 89$
- cmp.b #'-',12(A0)
- bne 100$
- moveq #10,D2
- moveq #0,D1
- 90$
- cmp.b #'0',0(A0,D2.w)
- bne 91$
- subq.l #1,D2
- addq.l #1,D1
- bra 90$
- 91$
- move.b 14(A0),D3
- sub.b #'0',D3
- cmp.b D1,D3
- bgt 10$
- move.l D2,D1
- add.l D3,D1
- 92$
- move.b 0(A0,D2.w),D0
- cmp.b #'.',D0
- bne 93$
- move.b #'0',D0
- addq #1,D2
- 93$
- move.b D0,0(A0,D1.w)
- subq #1,D2
- subq #1,D1
- cmp #2,D1
- bne 92$
-
- move.b #'0',14(A0)
-
- 100$
- move.b #'0',11(A0)
- moveq #0,D3
- move.b 14(A0),D3
- sub.b #'0',D3
- movem.l A0/A1,-(SP)
- lea 2(A0),A1
- lea 3(A0),A0
- bra 2$
- 1$ move.b (A0)+,(A1)+
- 2$ dbra D3,1$
- move.b #'.',(A1)
- movem.l (SP)+,A0/A1
-
- moveq #11,D3
- move.b D3,(A0)
- 3$ cmp.b #'0',0(A0,D3.w)
- bne 4$
- sub.b #1,(A0)
- subq #1,D3
- bra 3$
-
- 4$ cmp.b #'.',0(A0,D3.w)
- bne 5$
- sub.b #1,(A0)
- cmp.b #1,(A0)
- bne 5$
- move.b #'0',1(A0)
- rts
- 5$
-
- 10$
- cmp.b #'+',1(A0) remove initial +
- bne 11$
- move.b (A0)+,D0
- subq.b #1,D0
- move.b D0,(A0)
- 11$
- rts
-
- show8x
- bsr binhex
- lea olen,A0
-
- move.l A0,A1
- move.b (A1)+,D1
- 1$ cmp.b #'0',(A1)+
- bne 2$ *msg
- subq.b #1,D1
- beq 2$ *msg
- addq.l #1,A0
- move.b D1,(A0)
- bra 1$
- 2$ rts
-
- showdec
- lea obuf,A2
- lea 10(A2),A2
- moveq #8,D3
- move.l D0,-(SP)
- move.l D0,D1
- bpl 3$
- neg.l D1
- 3$ moveq #10,D2
- jsr lmoddivu D1/D2->D1, rem in D0
- move.b D0,-(A2)
- add.b #'0',(A2)
- dbra D3,3$
-
- moveq #9,D1
- 4$ cmp.b #'0',(A2)
- bne 6$
- subq #1,D1
- beq 5$
- addq.l #1,A2
- bra 4$
- 5$ addq #1,D1
- 6$ move.l (SP)+,D0
- bpl 7$
- move.b #'-',-(A2)
- addq #1,D1
- 7$ move.b D1,-(A2)
- move.l A2,A0
- * bra msg
- rts
-
- * D0 to hex in obuf
- binhex
- move.b #8,olen
- lea obuf,A0
- add.l #8,A0
- lea hextab,A1
- moveq #7,D1
- 1$ move.l D0,D2
- and.l #15,D2
- move.b 0(A1,D2),-(A0)
- lsr.l #4,D0
- dbra D1,1$
- rts
-
- hextab dc.b '0123456789ABCDEF'
-
- nread
- tst.w runflag i.e., run or background
- beq conreadln
- call Read
- rts
-
- CSI equ $9B
-
- conreadln
- move.l D4,-(SP)
- move.l D2,A0
- moveq #0,D1
- move.l D1,D4
-
- tst.l D3
- beq 6$
-
- 1$ movem.l D1/A0,-(SP)
- 2$ bsr conmayread
- tst.l D0
- bmi 2$
- cmp.b #13,D0
- bne 3$
- move.b #10,D0
- 3$
- bsr echochar
- movem.l (SP)+,D1/A0
- bsr csicheck
- beq 1$
- cmp.b #10,D0
- beq 41$
- cmp.b #8,D0
- bne 4$
- tst.l D1
- beq 5$
- subq.l #1,A0
- subq.l #1,D1
- bra 5$
- 4$
- cmp.b #' ',D0
- bcs 5$
- 41$
- or.b D4,D0
- move.b D0,(A0)+
- addq.l #1,D1
- 5$
- cmp.l D3,D1
- beq 6$
- cmp.b #10,D0
- bne 1$
- 6$ move.l (SP)+,D4
- move.l D1,D0
- rts
-
- echochar
- move.w D0,-(SP)
- cmp.b #CSI,D0
- beq 8$
- cmp.b #' ',D0
- bcc 6$
- cmp.b #10,D0
- beq 6$
- cmp.b #8,D0
- beq 6$
- cmp.b #14,D0 shift in
- bne 1$
- move.b #$80,D4
- bra 6$
- 1$
- cmp.b #15,D0 shift out
- bne 8$
- clr.b D4
- 6$
- bsr conputchar
- 8$
- move.w (SP)+,D0
- rts
-
- csicheck
- cmp.b #CSI,D0
- bne 100$
- movem.l D1/A0,-(SP)
- 1$ bsr conmayread
- tst.l D0
- bmi 1$
- cmp.b #'A',D0 up
- beq 3$
- cmp.b #'B',D0 down
- beq 3$
- cmp.b #'C',D0 left
- beq 3$
- cmp.b #'D',D0 right
- beq 3$
- 2$ bsr conmayread
- tst.l D0
- bmi 2$
- cmp.b #'~',D0
- bne 2$
- 3$
- movem.l (SP)+,D1/A0
- 100$
- rts
-
- getstr
- bsr readln
- tst.l D3
- beq _quit
- move.l A0,A1
- lea -1(A1,D3.W),A0
- cmp.b #10,(A0) case of file that does not end w. NL
- beq 1$
- addq.l #1,A0
- 1$ move.b #0,(A0)
- rts
-
-
- DEF file
- ARG String
- move.l D0,A1
- ARG String
- move.l D0,A0
- move.w (A1)+,D3
- subq.w #1,D3
- bne 5$
- move.b (A1),D1
- lea stdinname,A1
- bsr st01cmp
- bne 2$
- cmp.b #'r',D1
- bne 5$
- moveq #1,D0
- bra 4$
- 2$ lea stdoutname,A1
- bsr st01cmp
- bne 6$
- cmp.b #'w',D1
- bne 5$
- moveq #2,D0
- 4$ RETURN File
- 5$ ERR badfa
- 6$ ERR badfn
-
- DEF read
- ARG File
- subq.l #1,D0
- bne 3$
- 1$ bsr conmayread
- tst.l D0
- bmi 1$
- bsr 2$
- moveq #-1,D0
- RETURN Boolean
- 2$ RETURN Integer
- 3$ ERR filerr
-
-
- DEF write
- ARG Integer
- move.l D0,D1
- ARG File
- exg D0,D1
- subq.l #2,D1
- beq conputchar
- ERR filerr
-
- st01cmp
- move.l A0,-(SP)
- move.w (A0)+,D3
- cmp.b (A1)+,D3
- bne 2$
- subq.l #1,D3
- 1$ cmp.b (A0)+,(A1)+
- dbne D3,1$
- 2$ move.l (SP)+,A0
- rts
-
- stdinname dc.b 6,'%stdin'
- stdoutname dc.b 7,'%stdout'
- cnop 0,2
-
- newline
- move.b #10,D0
- prtchr
- move.b D0,obuf
- move.l ohandle,D1
- lea obuf,A1
- move.l A1,D2
- moveq #1,D3
- bra .msg1
-
- * message to console
- msg
- clr.l D3
- move.b (A0)+,D3
- longmsg
- move.l ohandle,D1
- move.l A0,D2
- .msg1
- * call Write
- bra conputstr
- * rts
-
- * obtain pointer to AmigaDOS
- ioinit
- move.l SysBase,A6 * ready call to OpenLibrary
-
- lea ilibname,A1
- moveq #0,D0
- call OpenLibrary
- move.l D0,intuitionbase
- move.l D0,A0
- lea $3C(A0),A0
- move.l (A0),A0
- move.l A0,wbscreen
-
- lea $2C(A0),A1
- move.l A1,viewport
-
- lea 4(A0),A0
-
- move.l (A0),A0
- * move.l A0,thiswindow
- 1$ move.l (A0),D0
- beq 2$
- move.l D0,A0
- bra 1$
- 2$
- * move.l A0,doswindow
-
- lea $32(A0),A0
- move.l (A0),rastport
-
- lea glibname,A1
- moveq #0,D0
- call OpenLibrary
- move.l D0,graphicsbase
-
- lea mlibname,A1
- moveq #0,D0
- call OpenLibrary
- move.l D0,mathffpbase
-
- lea tlibname,A1
- moveq #0,D0
- call OpenLibrary
- move.l D0,mathtransbase
-
- lea libname,A1
- moveq #0,D0
- call OpenLibrary
- move.l D0,A6
- * move.l D0,DOS_point
- * obtain file handles for output and input opened by CLI
- call Output
- move.l D0,ohandle
- call Input
- move.l D0,ihandle
-
- move.l D0,D1
- call IsInteractive
- tst.l D0
- bne .ii1
- move.b #$FF,backgroundflag
- .ii1
-
-
- ifne HiRes
- lea my_screen,A0
- intuit OpenScreen
- move.l D0,the_screen
- move.l D0,the_screenb
-
- move.l D0,A0
- lea $2C(A0),A0
- move.l A0,viewport
-
- lea my_bwindow,A0
- intuit OpenWindow
- move.l D0,the_bwindow
-
- * ShowTitle(FALSE) around here
- move.l D0,A0
- lea $32(A0),A0
- move.l (A0),rastport
-
- lea my_window,A0
- intuit OpenWindow
- move.l D0,the_window
-
- bsr start_console
-
- endc
-
- rts
-
-
- endio
-
- ifne HiRes
- bsr stop_console
-
- move.l the_window,A0
- intuit CloseWindow
-
- move.l the_bwindow,A0
- intuit CloseWindow
-
- move.l the_screen,A0
- intuit CloseScreen
- endc
- rts
-
-
-
-
- section fdata,data
-
- bufptr dc.l ibuf
- bufchcount dc.b 0,0
-
- s_ihandle dc.l 0
- s_bufptr dc.l 0
- s_bufchcount dc.b 0,0
- runflag dc.b 0
- backgroundflag dc.b 0
-
- iihandle dc.l 0
- closeit dc.l 0
-
- bstr badfa,<unknown file attribute>
- bstr badfn,<only files %stdin/out>
- bstr filerr,<file error>
-
-
- *wname dc.b 'CON:0/0/640/40/'
- signature dc.b ' ps PostScript emulator, ) Greg Lee, April, 1986 ',0
- cnop 0,2
-
-
-
- ; ========================================================================
- ; === NewScreen ==========================================================
- ; ========================================================================
- * STRUCTURE NewScreen,0
- *
- * WORD ns_LeftEdge ; initial Screen dimensions
- * WORD ns_TopEdge ; initial Screen dimensions
- * WORD ns_Width ; initial Screen dimensions
- * WORD ns_Height ; initial Screen dimensions
- * WORD ns_Depth ; initial Screen dimensions
- *
- * BYTE ns_DetailPen ; default rendering pens (for Windows too)
- * BYTE ns_BlockPen ; default rendering pens (for Windows too)
- *
- * WORD ns_ViewModes ; display "modes" for this Screen
- *
- * WORD ns_Type ; Intuition Screen Type specifier
- *
- * APTR ns_Font ; default font for Screen and Windows
- *
- * APTR ns_DefaultTitle ; Title when Window doesn't care
- *
- * APTR ns_Gadgets ; Your own initial Screen Gadgets
- *
- * ; if you are opening a CUSTOMSCREEN and already have a BitMap
- * ; that you want used for your Screen, you set the flags CUSTOMBITMAP in
- * ; the Types variable and you set this variable to point to your BitMap
- * ; structure. The structure will be copied into your Screen structure,
- * ; after which you may discard your own BitMap if you want
- * APTR ns_CustomBitMap;
- *
- * LABEL ns_SIZEOF
- *
- *
-
-
- viewport dc.l 0
-
- ifne HiRes
- the_window dc.l 0
-
- my_screen
- dc.w 0,0,640,400
-
- dc.w NumPlanes depth
- dc.b 0,1
- dc.w $C004 modes
- dc.w $0F type = custon
- dc.l screenfont font
- dc.l signature title
- dc.l 0 no gadgets
- dc.l 0 no bitmap
- *
-
- the_bwindow dc.l 0
-
- my_bwindow
-
- dc.w 0,0,640,400
- dc.b 0,1
- dc.l 0
-
- * flag req. (backdrop,) borderless, smart refresh, nocarerefresh
- dc.l $0800+$20000 (+$0100)
- *
- dc.l 0 first gadget
- dc.l 0 check mark
- dc.l signature title
-
- the_screenb
- dc.l 0 screen
-
- dc.l 0 bitmap
- dc.w 0,0 minimum width and height
- dc.w 0,0 maximum width and height
-
- dc.w $0F type = customscreen
-
-
-
- my_window
-
- dc.w 100,10,300,100
- dc.b 0,2
- dc.l 0 initial IDCMP state
-
- * flags req. sizing, drag,
- * smart refresh , and activate
- dc.l $001003+$20000
- *
- dc.l 0 first gadget
- dc.l 0 check mark
- dc.l .amsname title
-
- the_screen
- dc.l 0 screen
-
- dc.l 0 bitmap
- dc.w 100,45 minimum width and height
- dc.w 300,100 maximum width and height
-
- dc.w $0F type = customscreen
-
- screenfont
- dc.l dfname
- dc.w 9
- dc.b 0
- dc.b %01
- dfname dc.b 'topaz.font',0
-
- .amsname dc.b ' ps'
- dcb.b 30,' '
- dc.b 0
-
-
- endc
-
- libname dc.b 'dos.library',0
- ilibname dc.b 'intuition.library',0
- glibname dc.b 'graphics.library',0
- mlibname dc.b 'mathffp.library',0
- tlibname dc.b 'mathtrans.library',0
-
- **************************
-
-
-
- section fstr,bss
-
- ds.b 1 align ibuf
- ilen ds.b 1
- ibuf ds.b IbufLen+2
-
-
- ds.b 1 align obuf
- olen ds.b 1
- obuf ds.b 80
-
- runname ds.b RnameLen+2
-
- s_ibuf ds.b IbufLen+4
-
- end
-
-