home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
AMIGA PD 1
/
AMIGA-PD-1.iso
/
Programme_zum_Heft
/
Anwendungen
/
Kurztests
/
PostScript
/
PsIntrp
/
files.a
< prev
next >
Wrap
Text File
|
1987-09-06
|
16KB
|
891 lines
* 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