* 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, bstr rn_err, bstr op_err, bstr leaving, 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, bstr badfn, bstr filerr, *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