VolksForth/sources/cpm/PRINTER.FB.src
Carsten Strotmann 3dd6197fbf CPM Source files
2020-06-20 18:59:14 +02:00

273 lines
17 KiB
Plaintext

Screen 0 not modified
0 \\ Printer Interface 08Nov86
1
2 Dieses File enthaelt das Printer Interface zwischen volksFORTH
3 und dem Drucker.
4
5 Damit ist es moeglich Source-Texte auf bequeme Art und Weise
6 in uebersichtlicher Form auszudrucken (6 auf eine Seite).
7
8 In Verbindung mit dem Multitasker ist es moeglich, auch Texte im
9 Hintergrund drucken zu lassen und trotztdem weiterzuarbeiten.
10
11
12
13
14
15
Screen 1 not modified
0 \ Printer Interface Epson RX80 18Aug86
1 \ angepasst auf M 130i 07dec85we
2
3 Onlyforth
4
5 Variable shadow capacity 2/ shadow ! \ s. Editor
6
7 Vocabulary Printer Printer definitions also
8 | Variable printsem printsem off
9
10 01 +load 04 0C +thru \ M 130i - Printer
11 \ 01 03 +thru 06 0C +thru \ Fujitsu - Printer
12
13 Onlyforth
14
15
Screen 2 not modified
0 \ Printer p! and controls UH 02Nov87
1
2 | : ready? ( -- f ) [ Dos ] 0 &15 biosa 0= not ;
3
4 : p! ( n --) BEGIN pause
5 stop? IF printsem unlock true abort" stopped! " THEN
6 ready? UNTIL [ Dos ] 5 bios ;
7
8 | : ctrl: ( 8b --) Create c, Does> ( --) c@ p! ;
9
10 07 ctrl: BEL 7F | ctrl: DEL 0D | ctrl: RET
11 1B | ctrl: ESC 0A ctrl: LF 0C ctrl: FF
12 0F | ctrl: (+17cpi 12 | ctrl: (-17cpi
13
14
15
Screen 3 not modified
0 \ Printer Escapes 24dec85
1
2 | : esc: ( 8b --) Create c, does> ( --) ESC c@ p! ;
3
4 Ascii 0 esc: 1/8" Ascii 1 esc: 1/10"
5 Ascii 2 esc: 1/6" Ascii T esc: suoff
6 Ascii N esc: +jump Ascii O esc: -jump
7 Ascii G esc: +dark Ascii H esc: -dark
8 \ Ascii 4 esc: +cursive Ascii 5 esc: -cursive
9
10
11 | : ESC2 ( 8b0 8b1 --) ESC p! p! ;
12
13 | : on: ( 8b --) Create c, does> ( --) ESC c@ p! 1 p! ;
14 | : off: ( 8b --) Create c, does> ( --) ESC c@ p! 0 p! ;
15
Screen 4 not modified
0 \ Printer Escapes 29jan86
1
2 Ascii W on: +wide Ascii W off: -wide
3 Ascii - on: +under Ascii - off: -under
4 Ascii S on: sub Ascii S off: super
5 Ascii P on: (10cpi Ascii P off: (12cpi
6
7 : 10cpi (-17cpi (10cpi ;
8 : 12cpi (-17cpi (12cpi ;
9 : 17cpi (10cpi (+17cpi ;
10
11 : lines ( #.of.lines --) Ascii C ESC2 ;
12 : "long ( inches --) 0 lines p! ;
13 : american 0 Ascii R ESC2 ;
14 : german 2 Ascii R ESC2 ;
15 : normal 12cpi american suoff 1/6" 0C "long RET ;
Screen 5 not modified
0 \ Printer Escapes 16Jul86
1
2 | : esc: ( 8b --) Create c, does> ( --) ESC c@ p! ;
3
4 Ascii 0 esc: 1/8" Ascii 1 esc: 1/10"
5 Ascii 2 esc: 1/6" Ascii T esc: suoff
6 Ascii N esc: +jump Ascii O esc: -jump
7 Ascii G esc: +dark Ascii H esc: -dark
8 Ascii 4 esc: +cursive Ascii 5 esc: -cursive
9 Ascii M esc: 12cpi Ascii P | esc: (-12cpi
10
11 : 10cpi (-12cpi (-17cpi ;
12 : 17cpi (-12cpi (+17cpi ;
13
14 ' 10cpi Alias pica ' 12cpi Alias elite
15
Screen 6 not modified
0 \ Printer Escapes 16Jul86
1
2 | : ESC2 ( 8b0 8b1 --) ESC p! p! ;
3
4 | : on: ( 8b --) Create c, does> ( --) ESC c@ p! 1 p! ;
5 | : off: ( 8b --) Create c, does> ( --) ESC c@ p! 0 p! ;
6
7 Ascii W on: +wide Ascii W off: -wide
8 Ascii - on: +under Ascii - off: -under
9 Ascii S on: sub Ascii S off: super
10 Ascii p on: +prop Ascii p off: -prop
11 : lines ( #.of.lines --) Ascii C ESC2 ;
12 : "long ( inches --) 0 lines p! ;
13 : american 0 Ascii R ESC2 ;
14 : german 2 Ascii R ESC2 ;
15 : normal 12cpi american suoff 1/6" 0C "long RET ;
Screen 7 not modified
0 \ Printer Output 04Jul86
1
2 : prinit ; \ initializing Printer
3
4 | Variable pcol pcol off | Variable prow prow off
5 | : pemit ( 8b --) p! 1 pcol +! ;
6 | : pcr ( --) RET LF 1 prow +! pcol off ;
7 | : pdel ( --) DEL pcol @ 1- 0 max pcol ! ;
8 | : ppage ( --) FF prow off pcol off ;
9 | : pat ( row col --) over prow @ < IF ppage THEN
10 swap prow @ - 0 ?DO pcr LOOP
11 dup pcol @ < IF RET pcol off THEN pcol @ - spaces ;
12 | : pat? ( -- row col) prow @ pcol @ ;
13 | : ptype ( adr len --)
14 dup pcol +! bounds ?DO I c@ p! LOOP ;
15
Screen 8 not modified
0 \ Printer output 28Jun86
1
2 | Output: >printer pemit pcr ptype pdel ppage pat pat? ;
3
4 Forth definitions
5
6 : print >printer normal ;
7
8 : printable? ( char -- f) bl Ascii ~ uwithin ;
9
10
11
12
13
14
15
Screen 9 not modified
0 \ Variables and Setup 23Oct86
1
2 Printer definitions
3
4 $00 | Constant logo | Variable pageno
5 | Create scr#s $0E allot \ enough room for 6 screens
6
7 | : header ( -- )
8 12cpi 4 spaces ." Page No " +dark pageno @ 2 .r
9 $0D spaces ." volksFORTH83 der FORTH-Gesellschaft eV "
10 5 spaces file? -dark 1 pageno +! 17cpi ;
11
12
13
14
15
Screen 10 not modified
0 \ Print 2 screens across on a page 03dec85
1
2 | : text? ( scr# -- f) block dup c@ printable?
3 IF b/blk -trailing nip 0= THEN 0= ;
4
5 | : pr ( scr# --) dup capacity 1- u> IF drop logo THEN
6 1 scr#s +! scr#s dup @ 2* + ! ;
7
8 | : 2pr ( scr#1 scr#2 line# --) cr dup 2 .r space c/l * >r
9 pad $101 bl fill swap block r@ + pad c/l cmove
10 block r> + pad c/l + 1+ c/l cmove pad $101 -trailing type ;
11
12 | : 2scr ( scr#1 scr#2 --) cr cr $1E spaces
13 +wide +dark over 4 .r $1C spaces dup 4 .r -wide -dark
14 cr l/s 0 DO 2dup I 2pr LOOP 2drop ;
15
Screen 11 not modified
0 \ Printer 6 screens on a page 03dec85
1
2 | : pr-start ( --) scr#s off 1 pageno ! ;
3
4 | : pagepr ( --) header scr#s off scr#s 2+
5 3 0 DO dup @ over 6 + @ 2scr 2+ LOOP drop page ;
6
7 | : shadowpr ( --) header scr#s off scr#s 2+
8 3 0 DO dup @ over 2+ @ 2scr 4 + LOOP drop page ;
9
10 | : pr-flush ( -- f) scr#s @ dup \ any screens left over?
11 IF BEGIN scr#s @ 5 < WHILE -1 pr REPEAT logo pr THEN
12 0<> ;
13
14
15
Screen 12 not modified
0 \ Printer 6 screens on a page 23Nov86
1 Forth definitions
2
3 : pthru ( first last --)
4 printsem lock output push print pr-start 1+ swap
5 ?DO I text? IF I pr THEN scr#s @ 6 = IF pagepr THEN
6 LOOP pr-flush IF pagepr THEN printsem unlock ;
7
8 : document ( first last --)
9 isfile@ IF capacity 2/ shadow ! THEN
10 printsem lock output push print pr-start 1+ swap
11 ?DO I text? IF I pr I shadow @ + pr THEN
12 scr#s @ 6 = IF shadowpr THEN LOOP
13 pr-flush IF shadowpr THEN printsem unlock ;
14
15 : listing ( --) 0 capacity 2/ 1- document ;
Screen 13 not modified
0 \ Printerspool 03Nov86
1
2 \needs Task \\
3
4 | Input: noinput 0 false drop 2drop ;
5
6
7 $100 $200 noinput Task spooler
8
9 keyboard
10
11 : spool ( from to -- )
12 isfile@ spooler 3 pass isfile ! pthru stop ;
13
14
15
Screen 14 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 15 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15