`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JتPצERROR =>RETURN to exit ADMERG:RXץV  צ"Name of Data file you will create:PV"ˡopening Output fileYUUYéUyÍצName of Input file:BADMERG .CODE Ǡ PLOTTEST.TEXT GDIABLO-DOC.TEXTY  PRTPAGE.TEXT " EPSON.UNIT.TEXTӤEPSON.UNIT.CODEӤ CONCORD.TEXT Ӥ CONCORD.CODE ӤSETUPMX80.TEXT# SCRNBYT.TEXT q DIAPLOT.TEXT G DIABLO.TEXT  MINIPUB.TEXT Ǡ MINIPUB9OWP.TEXT OXWP.CODE ءXfDOC.TEXT BfiTIGER.UNIT.CODEim TIGER.TEXT qmu TEXTPNT.TEXT Wuy TEXTPNT.CODE Wy} LINEFEED.TEXT x}PRINT.HOWTO.USE PR737.TEXTSYDR-PR  ADMERG.CODE # ADMERG.TEXT #PASCALZAP.TEXTPASCALZAP.CODE$ FILEIO.TEXT f$' FILEIO.CODE f'- PRINT.TEXT j-3 PRINTSET.TEXT 39 SETINT.TEXT &꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&,P,"ˡopening Input file V V Another Input file? Y)es, N)o :UVVzzZ` ADMERG.CODE.CODE[*]B2WRK:SYSTEM.SWAPDISKN^s#N^Z&WRITE('Another Input file? Y)es, N)o :'); $ READLN(CH) $END; "CLOSE(OUTDATA,LOCK)  END.  N &WRITE('Name of Input file:'); &READLN(IDNAME); &RESET(INDATA,IDNAME); &IF IORESULT<>0 THEN (ERROR('opening Input file'); &WHILE NOT EOF(INDATA) DO (BEGIN ( OUTDATA^:=INDATA^; *PUT(OUTDATA); *GET(INDATA) (END; &CLOSE(INDATA); MERG:'); $READLN; $EXIT(ADMERG) "END; " "  BEGIN  WRITE('Name of Data file you will create:'); "READLN(ODNAME);  REWRITE(OUTDATA,ODNAME);  IF IORESULT<>0 THEN $ERROR('opening Output file'); "CH:='Y'; "WHILE (CH='Y') OR (CH='y') DO $BEGI"TYPE " $DEVREC=ARRAY[0..8] OF INTEGER; $ "VAR " $IDNAME,ODNAME:STRING; $CH:CHAR; $INDATA,OUTDATA:FILE OF DEVREC; " $(* Any error aborts the program *) "PROCEDURE ERROR(ST:STRING); "BEGIN $WRITELN('ERROR =>',ST); $WRITE('RETURN to exit AD (*$I-*)  PROGRAM ADMERG;   (* This program is short and sweet and not very robust. It is that $way to make it easy to type in. Now you know the record size of $ATTACH.DATA files, you are welcome to make it more robust yourself. *)  " " PROGRAM PASCALZAP; !(*BY PHILIP B ENDER - CALL APPLE JAN 81, P47 *)  (* PRINT MODULE ADDED BY G.KELTZ, 1 MAR 8S *)   CONST SP=' '; &HEXES='0123456789ABCDEF';  VAR BUF :PACKED ARRAY[0..511] OF 0..255; $HEX :PACKED ARRAY[0..15] OF CHAR; $HEXI :PALN; !WRITELN('ENTER CHOICE: ')  END;   BEGIN (*MAIN PROGRAM*) !HEX:='0123456789ABCDEF'; !READBLOCK; !REPEAT "MENU; "READ(CHOICE);WRITELN; "CASE CHOICE OF "'R':READBLOCK; "'W':WRITEBLOCK; "'D':DISPLAY; "'P':PRINT;  'A':ASCIICHANGE; "'H':H!WRITELN; !WRITELN(SP:5,'R)EAD BLOCK'); !WRITELN(SP:5,'W)RITE BLOCK'); !WRITELN(SP:5,'D)ISPLAY BUFFER'); !WRITELN(SP:5,'P)RINT BUFFER'); !WRITELN(SP:5,'A)SCII CHANGE'); !WRITELN(SP:5,'H)EX CHANGE'); !WRITELN(SP:5,'Q)UIT'); !WRITELN;WRITE(ELSE !BEGIN "IF L<>0 THEN BEGIN "IF L=1 THEN #HEXSTR:=CONCAT('0',HEXSTR); "HEXADEC; "BUF[BYTE]:=DEC;BYTE:=BYTE+1 /END !END !UNTIL L=0  END;   PROCEDURE MENU;  BEGIN !WRITELN(CHR(12)); !WRITELN;WRITELN; !WRITELN(SP:5,'MENU OF OPTIONS'); 1+I2*16  END;   PROCEDURE HEXCHANGE;  VAR L:INTEGER;  BEGIN !HEADER; !REPEAT !DECAHEX(BUF[BYTE]); !WRITELN(BYTE:3,': ',HEXI); !WRITE(BYTE:3,': '); !READLN(HEXSTR); !WRITELN; L:=LENGTH(HEXSTR); !IF L>2 THEN $WRITELN('HEX VALUE TOO LONG') EXIT'); %IF CH<>SP THEN &BUF[BYTE]:=ORD(CH); %BYTE:=BYTE+1 !UNTIL CH=SP  END;   PROCEDURE HEXADEC;  VAR I1,I2:INTEGER; $STR:STRING;  BEGIN !STR:=COPY(HEXSTR,2,1); !I1:=POS(STR,HEXES)-1; !STR:=COPY(HEXSTR,1,1); !I2:=POS(STR,HEXES)-1; !DEC:=IEND;   PROCEDURE ASCIICHANGE;  VAR KAR:CHAR;  BEGIN !HEADER; !REPEAT "IF (BUF[BYTE]>31) AND %(BUF[BYTE]<127) THEN %KAR:=CHR(BUF[BYTE]) ' ELSE %KAR:='.'; %WRITELN(BYTE:3,': ',KAR); %WRITE(BYTE:3,': '); %READLN(CH); %WRITELN('SP-&AND (BUF[ROW+COL]<127) THEN (WRITE(P,CHR(BUF[ROW+COL])) ELSE (WRITE(P,'.'); "WRITELN(P);  ROW:=ROW+16; !UNTIL ROW>496; !CLOSE(P);  END;   PROCEDURE HEADER; !BEGIN "WRITELN(CHR(12)); "WRITE('BYTE TO BE CHANGED? '); "READLN(BYTE);WRITELN !PRINTER:'); !ROW:=0; !WRITELN(P,CHR(12)); !WRITELN(P,'BLOCK ',BLOCK:3); !REPEAT "WRITE(P,ROW:3,':'); "FOR COL:=0 TO 15 DO BEGIN #DECAHEX(BUF[ROW+COL]); #WRITE(P,HEXI:3) END; "WRITE(P,SP);  FOR COL:=0 TO 15 DO #IF (BUF[ROW+COL]>31) XIT'); $READ(CH);WRITELN(CHR(12)); $IF (CH='E') OR (CH='E') THEN 'EXIT(DISPLAY) #END !UNTIL ROW>504; !WRITELN('BLOCK ',BLOCK:3,': SP-MENU'); !READ(CH);WRITELN  END;   PROCEDURE PRINT; !VAR ROW,COL:INTEGER; %P:INTERACTIVE;  BEGIN !REWRITE(P,'(HEXI:3) END; "WRITE(SP);  FOR COL:=0 TO 7 DO #IF (BUF[ROW+COL]>31) &AND (BUF[ROW+COL]<127) THEN (WRITE(CHR(BUF[ROW+COL])) ELSE (WRITE('.'); "WRITELN;  ROW:=ROW+8; J:=J+1; "IF J MOD 22=0 THEN #BEGIN $WRITELN('BLOCK ',BLOCK:3,': SP-CONT; E-E!WRITELN('READING BLOCK ',BLOCK:3); !UNITREAD(5,BUF,512,BLOCK,0)  END;   PROCEDURE DISPLAY; !VAR ROW,COL,I,J:INTEGER;  BEGIN !ROW:=0;J:=0; !WRITELN(CHR(12)); !REPEAT "WRITE(ROW:3,':'); "FOR COL:=0 TO 7 DO BEGIN #DECAHEX(BUF[ROW+COL]); #WRITEK:3,SP:2); !READLN(STR); WRITELN; !IF STR='YES' THEN "UNITWRITE(5,BUF,512,BLOCK,0) !END;   PROCEDURE READBLOCK;  BEGIN !WRITELN(CHR(12)); !WRITELN;WRITELN; !WRITE('WHICH BLOCK IS TO BE READ? '); !READLN(BLOCK);WRITELN; (BEGIN *DOIT(I DIV 16); *HEXI[L]:=HEX[I MOD 16]; (END; $END; (*DOIT*) !BEGIN #L:=0; #HEXI:='00'; #DOIT(I); !END; (*DECAHEX*)   PROCEDURE WRITEBLOCK;  BEGIN !WRITELN(CHR(12));(*CLEAR PAGE*) !WRITELN('RESPONDE YES TO WRITE ','TO BLOCK ',BLOCCKED ARRAY[0..1] OF CHAR; $STR,HEXSTR:STRING; $BLOCK, $ BYTE, &DEC:INTEGER; $CHOICE,CH:CHAR; $   PROCEDURE DECAHEX(I:INTEGER);  VAR L:INTEGER; "PROCEDURE DOIT(I:INTEGER); $BEGIN &IF I<16 THEN (BEGIN *HEXI[L]:=HEX[I]; *L:=L+1; (END &ELSEEXCHANGE END !UNTIL (CHOICE='Q') OR (CHOICE='Q')  END.   PASCALZA N^fbbJFB> : 6AW. 2"B&(*,HbQébQÍRx fh6P 6    W)RITE BLOCK צD)ISPLAY BUFFER P)RINT BUFFER צA)SCII CHANGE H)EX CHANGE צQ)UITENTER CHOICE:  ץ0123456789ABCDEF __áT   MENU OF OPTIONS צ R)EAD BLOCK  W)RITE BLOCK צD)ISPLAY BUFFER DEF^l __ צ:  _ :  P š(HEX VALUE TOO LONGDˡ?á צ0 QP _^ǹ._ צ: _ צ: aSP-EXITa ˡ_a__a á  ,,Pצ0123456789ABCDEF ,,Pצ0123456789ABC0ȡB؂ť؂Ʉ؂ .šo` BYTE TO BE CHANGED? _ V_ť_Ʉ_LOCK `  : SP-MENUaz,d Ɓ/PRINTER: צBLOCK `  :́0ʁ0ȡ ؂  ́0ʁ  ȡDڂťڂɄڂ .áqBLOCK ` : SP-CONT; E-EXITa aEéaEÍšB WHICH BLOCK IS TO BE READ? ` READING BLOCK ` `  :ȡ!ڂɡ  B 00ר RESPONDE YES TO WRITE  TO BLOCK `  5P5צYES `"PROGRAM TESTFILES;  TYPE "RESIDENT=RECORD ,NAME: STRING[10]; ,STRNUM: INTEGER; ,STREET: STRING[13]; ,MEMBER: BOOLEAN; +END; +  VAR "RES: RESIDENT; "RESFILE: FILE OF RESIDENT; "MAXREC,RECNUM: INTEGER; "FILENAME: STRING[10]; "SUCCESSFUL: BOOLEAN^xjצSTREET:  MEMBER: (T/F) VVTáצ צ OMNAME: צ ADDRESS:    TVFVצMEMBER: V1 JO"ëUUSTART NEW FILE? VVYáOMNAME:  צ STREET NUM:  צSTREET:  MEMBER: (T/F) VVTáצ צ OMNAME: צ ADDRESS:    TVFVצ>NM צENTER FILENAME: O O"ëUUSTART NEW FILE? VVYáOMNAME:  צ STREET NUM:  "*R TESTFILE TH RES DO $BEGIN &WRITELN('NAME: ',NAME); &WRITELN('ADDRESS: ',STRNUM,' ',STREET); &IF MEMBER THEN CH:='T' )ELSE CH:='F'; &WRITELN('MEMBER: ',CH); &WRITELN $END; "CLOSE(RESFILE,LOCK)  (*$I+*) (* TURN ON IO CHECKING *)  END. LE^:=RES; *PUT(RESFILE); *WRITELN (END $END; "CLOSE(RESFILE,LOCK); "WITH RES DO $BEGIN &NAME:=''; STRNUM:=0;STREET:='' $END; "(* NOW OPEN FILE FOR READING *) "RESET(RESFILE,FILENAME); "SEEK(RESFILE,RECNUM); "GET(RESFILE); "RES:=RESFILE^; "WI-WRITE('STREET NUM: ');READ(STRNUM);READLN; -WRITE('STREET: ');READ(STREET);READLN; -WRITE('MEMBER: (T/F) ');READ(CH);READLN; -IF CH='T' THEN MEMBER:=TRUE 0ELSE MEMBER:=FALSE; +(* NOTE YOU CANNOT READ OR WRITE BOOLEAN VARS DIRECTLY *) +END; *RESFIEADLN(CH); &IF CH='Y' THEN (BEGIN *REWRITE(RESFILE,FILENAME);(* THIS PREPARES NEW FILE FOR REWRITING*) *SEEK(RESFILE,RECNUM); (* POSITION READ/WRITE HEAD *) *WITH RES DO +BEGIN (* ENTER DATA FOR RECORD *) -WRITE('NAME: ');READ(NAME);READLN; T I-, PROGRAM WILL END & SYSTEM RE-INIT *) " "RESET(RESFILE,FILENAME); (* TRY TO OPEN OLD FILE *) "SUCCESSFUL:=(IORESULT=0); (* IF FILE NOT PRESENT THEN IORESULT=0 *) "IF NOT SUCCESSFUL THEN (* START NEW FILE *) $BEGIN &WRITELN('START NEW FILE? ');RN; "CH: CHAR; "  BEGIN "MAXREC:=5;RECNUM:=0; "CLOSE(RESFILE,LOCK); (* IN CASE IT'S OPEN *) "PAGE(OUTPUT); (* CLEAR SCREEN *) "WRITELN('ENTER FILENAME: ');READLN(FILENAME); " "(*$I-*) (* TURN OFF IO CHECK IN CASE FILE DOESN'T EXIST *) "(* WITHOUPROGRAM PRINTSET;  (*$C PAUL NORRIS, 752-7926, SEPT. 1980 *)   CONST ESCAPE=27; (*INITIALIZE FOR SOFTWARE SWITCH*) (NORMAL=19; (*SOFTWARE SWITCHES*) (PROPORTIONAL=17; (CONDENSED=20; (CR=13; (*CARRIAGE RETURN*) (  VAR ANSWER: N^ END.  THEN &SKIP(PAGELEN - LINENO)  END;   BEGIN #REWRITE(PRINTER, 'PRINTER:'); #WRITE('FILE TO PRINT?:'); #READLN(NAME); #WHILE NAME <> '' DO BEGIN &RESET(INFILE, NAME); &FPRINT; &WRITE('FILE TO PRINT?:'); &READLN(NAME); &CLOSE(INFILE) #END 'PAGE ', PAGENO); )SKIP(MARGIN2); )LINENO := MARGIN1 + MARGIN2 + 1 &END; &READLN(INFILE, LINE); &WRITELN(PRINTER, ' ', LINE); &LINENO := LINENO + 1; &IF LINENO >= BOTTOM THEN BEGIN )SKIP(PAGELEN - LINENO); )LINENO := 0 &END #END; #IF LINENO > 0 = 62; #PAGELEN = 66;   VAR #PAGENO, LINENO: INTEGER; #LINE: STRING;   BEGIN #PAGENO := 0; #LINENO := 0; #WHILE NOT EOF(INFILE) DO BEGIN &IF LINENO = 0 THEN BEGIN )SKIP(MARGIN1); )PAGENO := PAGENO + 1; )WRITELN(PRINTER, NAME: 22, ' ': 48, PROGRAM PRINT;   VAR #NAME: STRING; #PRINTER, INFILE: TEXT;   PROCEDURE SKIP(N: INTEGER);   VAR #I: INTEGER;   BEGIN #FOR I := 1 TO N DO &WRITELN(PRINTER, ' ')  END;   PROCEDURE FPRINT;   CONST #MARGIN1 = 2; #MARGIN2 = 2; #BOTTOM CHAR;  $I (*INDEX*): INTEGER; $ $LINE: STRING; $ $S (*SWITCHES*): FILE OF CHAR;   BEGIN  PAGE(OUTPUT);  GOTOXY(0,8);  WRITELN('SELECT THE PRINTSET THAT YOU WANT');  WRITELN;  WRITELN(' A) NORMAL');  WRITELN(' B) PROPORTIONAL');  WRITELN(' C) CONDENSED');  WRITELN;  WRITELN('PRESS KEY A,B, OR C TO CHOOSE PRINTSET');  WRITELN('PRESS ANY OTHER KEY TO EXIT PROGRAM.');   READ(KEYBOARD,ANSWER);   IF NOT (ANSWER IN ['A','B','C'])  THEN EXIT(PRINTSET);  WRITELN(S,'THIS LINE IS OUTPUT IN THE PRINTSET YOU HAVE CHOSEN.');   CLOSE(S)   END.(*PRINTSET*)   ONLY WORKS BECAUSE FILE  S IS INTERACTIVE. *)   WRITE(S,CHR(ESCAPE));   CASE ANSWER OF " "'A':WRITELN(S,CHR(NORMAL)); " "'B':WRITELN(S,CHR(PROPORTIONAL)); " "'C':WRITELN(S,CHR(CONDENSED)) "  END; (*OF THE CASE*) " ;  WRITELN('PRESS KEY A,B, OR C TO CHOOSE PRINTSET');  WRITELN('PRESS ANY OTHER KEY TO EXIT PROGRAM.');   READ(KEYBOARD,ANSWER);   IF NOT (ANSWER IN ['A','B','C'])  THEN EXIT(PRINTSET);   RESET(S,'PRINTER:');  (*REWRITE ALSO WORKS HERE. RESETTEGER; $ $S (*SWITCHES*): INTERACTIVE; $   BEGIN  PAGE(OUTPUT);  GOTOXY(0,8);  WRITELN('SELECT THE PRINTSET THAT YOU WANT');  WRITELN;  WRITELN(' A) NORMAL');  WRITELN(' B) PROPORTIONAL');  WRITELN(' C) CONDENSED');  WRITELN PROGRAM PRINTSET;   (*$C PAUL NORRIS, 752-7926, SEPT. 1980 *)   CONST ESCAPE=27; (*INITIALIZE FOR SOFTWARE SWITCH*) (NORMAL=19; (*SOFTWARE SWITCHES*) (PROPORTIONAL=17; (CONDENSED=20; (  VAR ANSWER: CHAR;  $I (*INDEX*): INN^LINE IS OUTPUT IN THE PRINTSET YOU HAVE CHOSEN.';   FOR I:=1 TO LENGTH(LINE) DO #BEGIN %S^:=LINE[I]; %PUT(S) #END; #  S^:=CHR(CR);PUT(S); (*OUTPUT CARRIAGE RETURN*)   CLOSE(S)   END.(*PRINTSET*)   'S^:=CHR(ESCAPE);PUT(S); 'S^:=CHR(NORMAL);PUT(S) &END; " "'B':BEGIN 'S^:=CHR(ESCAPE);PUT(S); 'S^:=CHR(PROPORTIONAL);PUT(S) &END; " "'C':BEGIN 'S^:=CHR(ESCAPE);PUT(S); 'S^:=CHR(CONDENSED);PUT(S) &END; " "END; (*OF THE CASE*) "  LINE:='THIS   REWRITE(S,'PRINTER:');  (*HERE IS THE CRUX OF THE PROGRAM. HOW TO  SEND OUTPUT TO THE PRINTER. PG.133 OF THE  WHITE MANUAL INDICATES THAT RESET WOULD  ALSO WORK. IT AIN'T SO. A RUN-TIME  ERROR RESULTS.*)   CASE ANSWER OF " "'A':BEGIN &IF (X>WIDTH) AND (STEP=1) THEN X:=NONBLK; &IF (X0 DO $BEGIN &IF COPY(OUTLINE,X,1)<>' ' THEN X:=X+STEP (ELSE BEGIN (INSERT(' ',OUTLINE,X); (BLANKS:=BLANKS-1; (WHILE (COPY(OUTLINE,X,1)=' ') AND (X>=NONBLK) DO X:=X+STEP; (END; "BEGIN; $COUNT:=LENGTH(OUTLINE); $BLANKS:=WIDTH-COUNT; $NONBLK:=1; $IF OUTLINE[1]=' ' THEN $ WHILE OUTLINE[NONBLK]=' ' DO NONBLK:=NONBLK+1 $ ELSE IF INDFLAG THEN NONBLK:=INDENT+1; $IF STEP=1 THEN BEGIN; &STEP:=-1; &X:=WIDTH; $END $ELSE BEGIN; GIN; "TEMP:=ORD(S[LENGTH(S)])-48; "FOR I:=1 TO (LENGTH(S)-1) DO "BEGIN; $TEMP:=TEMP+(ORD(S[I])-48)*ROUND(PWROFTEN(LENGTH(S)-I)); "END; "DEC:=TEMP;  END(*DEC*);   PROCEDURE JUST;  VAR BLANKS,COUNT,NONBLK,X:INTEGER;  BEGIN; "IF NOT NLFLAG THEN %BYTEFACE=RECORD CASE BOOLEAN OF .TRUE: (INT: INTEGER); .FALSE:(PTR: ^PAB); .END;  VAR BCHEAT: BYTEFACE;  BEGIN; "BCHEAT.INT:=-16384;  KEYPRESS:=(BCHEAT.PTR^[0]>127);  END(*KEYPRESS*); FUNCTION DEC (S:STRING):INTEGER;  VAR I,TEMP:INTEGER;  BEFLAG THEN SENDPRINTER(2); $WRITELN(OUTFILE); $WRITELN(OUTFILE); $PGLINES:=3; "END;  END(*PAGEUP*);  PROCEDURE ENDPGM;  BEGIN; "GOTOXY(0,0); "PAGE(OUTPUT);  END(*ENDPGM*);   FUNCTION KEYPRESS:BOOLEAN;  TYPE PAB=PACKED ARRAY[0..1] OF 0..255; ;   PROCEDURE PAGEUP;  BEGIN; "SENDPRINTER(12); (*FF*) "PGLINES:=0; "WRITELN(OUTFILE); "WRITELN(OUTFILE);  IF TITLFLAG THEN BEGIN; $IF BIGTITLFLAG AND NOT ENHANCFLAG THEN SENDPRINTER(1); $WRITELN(OUTFILE,TITLE); $IF BIGTITLFLAG AND NOT ENHANCITLFLAG,DSFLAG,ENHANCFLAG,ILFLAG,INDFLAG,JUSTFLAG:BOOLEAN;  MORE,NLFLAG,TITLFLAG,UCFLAG:BOOLEAN;   PROCEDURE SENDPRINTER(SEND:INTEGER);  CONST PRINTER=6;  BEGIN; "IF OUTPUTFILE='PRINTER:' THEN UNITWRITE(PRINTER,SEND,1,0,12);  END(*SENDPRINTER*) (*6/17/80*)   PROGRAM WORDPROC;   VAR INTSTRING,WORD,INLINE,INPUTFILE,OUTLINE,OUTPUTFILE,TEMPSTRING,TITLE:STRING; $CMDLIST: STRING[120]; $INFILE,OUTFILE:TEXT;  INDENT,LINES,NUMCOPIES,PGLINES,PGSIZE,POSIT,STEP,WIDTH:INTEGER;  AIFLAG,BIGTN^LSE FLAGCASE:=0; "TEMPWORD:=WORD; "J:=1; "FOR I:=1 TO LENGTH(WORD) DO "BEGIN; $IF (WORD[I]<>'/') AND (WORD[I]<>'^') THEN BEGIN; &IF WORD[I] IN ['A'..'Z'] THEN (TEMPWORD[J]:=CHR(ORD(WORD[I])+FLAGCASE) $ ELSE TEMPWORD[J]:=WORD[I]; &J:=J+1; $ IF NOT UCFLAG THEN FLAGCASE:=32 ELSE FLAGCASE:=0; $END $ELSE IF WORD[I]='/' THEN FLAGCASE:=0 " ELSE BEGIN; &TEMPWORD[J]:=WORD[I+1]; " I:=I+1; $ J:=J+1; $END; "END; "WORD:=COPY(TEMPWORD,1,J-1);  END(*UPLOW*);   PROCEDURE SENDOUT;  PROCEDURE"POSIT:=LENGTH(INLINE); "WHILE NOT (EOF(INFILE)) DO "BEGIN;  IF KEYPRESS THEN $BEGIN; &READ(KEYBOARD,CH); $ IF CH>=' ' THEN &BEGIN; (WRITE(CHR(7),'TERMINATE? ',CHR(7)); (READ(INPUT,CH); (IF CH='Y' THEN (BEGIN; *NUMCOPIES:=1; *EXIT(PROCESH:CHAR;  PROCEDURE NEXTIN;  BEGIN;  IF POSIT=LENGTH(INLINE) THEN "BEGIN; $INLINE:=''; $WHILE NOT(EOF(INFILE)) AND (LENGTH(INLINE)<1) DO READLN(INFILE,INLINE); $INLINE:=CONCAT(INLINE,' '); $POSIT:=1; "END;  END(*NEXTIN*);  BEGIN(*PROCESS*); IN; 0IF NUM>WIDTH THEN NUM:=NUM-WIDTH; 0NUM:=NUM-LENGTH(OUTLINE); 0TAB; .END; #31: (*TI*) IF LENGTH(OUTLINE)>0 THEN NL; #32: (*UC*) UCFLAG:=TRUE; #33: (*UL*) UCFLAG:=FALSE; #END;  END(*COMMAND*);   PROCEDURE PROCESS;  VAR TEMP:INTEGER;  C; #24: (*PP*) FOR I:=1 TO 3 DO NL; #25: (*PS*) PGSIZE:=NUM; #26: (*RS*) BEGIN; 0WIDTH:=66; 0INDENT:=5; 0PGSIZE:=55; .END; #27: (*SK*) IF NUM>0 THEN FOR I:=1 TO NUM DO NL; #28: (*SS*) DSFLAG:=FALSE; #29: (*ST*) BIGTITLFLAG:=FALSE; #30: (*TB*) BEG#22: (*PD*) IF NUM IN [8,10,12,16] THEN .BEGIN; 0IF NUM=8 THEN SENDPRINTER(28) 2ELSE IF NUM=10 THEN SENDPRINTER(29) 4ELSE IF NUM=12 THEN SENDPRINTER(30) 6ELSE SENDPRINTER(31); .END; #23: (*PG*) BEGIN; 0IF LENGTH(OUTLINE)>0 THEN NL; 0PAGEUP; .END) TITLFLAG:=TRUE; #16: (*JS*) JUSTFLAG:=TRUE; #17: (*LC*) UCFLAG:=FALSE; #18: (*LW*) WIDTH:=NUM; #19: (*NL*) NL; #20: (*NM*) IF ENHANCFLAG THEN .BEGIN; 0ENHANCFLAG:=FALSE; 0SENDPRINTER(2); .END; #21: (*NT*) TITLFLAG:=FALSE; EGIN; 0TITLE:=OUTLINE; 0OUTLINE:=''; 0TITLFLAG:=TRUE; .END; #11: (*IF*) IF (PGSIZE-PGLINES)0 THEN NL; 0PAGEUP; .END; #12: (*IL*) ILFLAG:=TRUE; #13: (*IM*) INDFLAG:=TRUE; #14: (*IS*) INDENT:=NUM; #15: (*IT* $6: (*EI*) INDFLAG:=FALSE; $7: (*EJ*) JUSTFLAG:=FALSE; $8: (*EL*) BEGIN; 0ILFLAG:=FALSE; 0NUM:=INDENT-LENGTH(OUTLINE); 0IF NUM>0 THEN TAB; .END; $9: (*EM*) IF NOT ENHANCFLAG THEN .BEGIN; 0ENHANCFLAG:=TRUE; 0SENDPRINTER(1); .END; #10: (*ET*) B"IF LENGTH(WORD)>4 THEN NUM:=DEC(COPY(WORD,4,LENGTH(WORD)-4)); "CASE (1+POS(COPY(WORD,1,3),CMDLIST) DIV 3) OF $1: (*AI*) AIFLAG:=TRUE; $2: (*BT*) BIGTITLFLAG:=TRUE; $3: (*CM*) POSIT:=LENGTH(INLINE); $4: (*DS*) DSFLAG:=TRUE; $5: (*EA*) AIFLAG:=FALSE;END(*TAB*);  PROCEDURE NL;  VAR I:INTEGER;  BEGIN; "NLFLAG:=TRUE; "SENDOUT; "IF INDFLAG AND NOT(ILFLAG) AND (INDENT>0) THEN $FOR I:=1 TO INDENT DO OUTLINE:=CONCAT(OUTLINE, ' ');  END(*NL*);  BEGIN; RD);  END(*PLACEIN*); PROCEDURE COMMAND;  VAR I,NUM:INTEGER;  PROCEDURE TAB;  BEGIN; "IF NUM>0 THEN "BEGIN; $WORD:=''; $FOR I:=1 TO NUM DO WORD:=CONCAT(WORD,' '); $PLACEIN; "END "ELSE IF NUM<0 THEN DELETE(OUTLINE,NUM+LENGTH(OUTLINE),-1*NUM);  (OUTLINE[1]=' ')) THEN &DELETE(OUTLINE,1,INDENT); "IF LENGTH(WORD)+LENGTH(OUTLINE)>WIDTH+1 THEN "BEGIN; $SENDOUT; $IF INDFLAG AND NOT(ILFLAG) AND (INDENT>0) THEN &FOR I:=1 TO INDENT DO OUTLINE:=CONCAT(OUTLINE,' '); "END; "OUTLINE:=CONCAT(OUTLINE,WO"IF JUSTFLAG THEN JUST; "WRITELN(OUTFILE,OUTLINE); "INCLINE; "IF DSFLAG THEN "BEGIN; $WRITELN(OUTFILE); $INCLINE; "END; "OUTLINE:='';  END(*SENDOUT*);   PROCEDURE PLACEIN;  VAR I:INTEGER;  BEGIN; "IF LENGTH(OUTLINE)>0 THEN $IF (ILFLAG AND INCLINE;  BEGIN;  PGLINES:=PGLINES+1; "IF PGLINES>PGSIZE THEN PAGEUP;  END(*INCLINE*);   BEGIN; "IF LENGTH(OUTLINE)>0 THEN $WHILE ((OUTLINE[LENGTH(OUTLINE)]=' ') AND (LENGTH(OUTLINE)>1)) DO &DELETE(OUTLINE,LENGTH(OUTLINE),1); S); (END; (WRITELN; $ END; $END; $NEXTIN; $WORD:=' '; $WHILE NOT EOF(INFILE) AND (COPY(INLINE,POSIT,1)=' ') DO $BEGIN; &POSIT:=POSIT+1; &IF AIFLAG THEN PLACEIN; &NEXTIN; $END;  IF NOT EOF(INFILE) THEN $BEGIN; &TEMP:=POSIT; &WHILE ((POSIT' ')) DO &BEGIN; (POSIT:=POSIT+1; &END; &WORD:=COPY(INLINE,TEMP,POSIT-TEMP+1); &IF WORD[LENGTH(WORD)-1] IN ['.',':','?','!'] THEN &BEGIN; (WORD:=CONCAT(WORD,' '); (IF POSIT+1<=LENGTH(INLINE) THEN *IF INLINE[P WORDPROC "ENDPGM;  END. ='CONSOLE:')) THEN (CLOSE(OUTFILE,LOCK) (ELSE CLOSE(OUTFILE); &CLOSE(INFILE); &SENDPRINTER(12); (*FF*) $END; " WRITELN; $WRITE('MORE? '); $READLN(TEMPSTRING); $IF LENGTH(TEMPSTRING)<1 THEN MORE:=FALSE &ELSE MORE:=NOT(TEMPSTRING[1]<>'Y'); "END;CPI*) "WRITELN(OUTFILE); "WRITELN(OUTFILE);  END(*INIT*);   BEGIN(*MAIN*); "MORE:=TRUE; "WHILE MORE DO "BEGIN; $GETFILES; $WHILE NUMCOPIES>0 DO $BEGIN; &INIT; &PROCESS; &NUMCOPIES:=NUMCOPIES-1; &IF NOT((OUTPUTFILE='PRINTER:') OR (OUTPUTFILE"INLINE:=''; "JUSTFLAG:=FALSE; "LINES:=0; "NLFLAG:=FALSE; "OUTLINE:=''; "PGLINES:=0; "PGSIZE:=55; "STEP:=1; "TITLE:=''; "TITLFLAG:=FALSE; "UCFLAG:=FALSE; "WIDTH:=66; "SENDPRINTER(2); (*DEFAULT NORMAL DENSITY*) "SENDPRINTER(29); (*DEFAULT 10 BT^CM^DS^EA^EI^EJ^EL^EM^ET^IF^IL^IM^IS^IT^JS^LC^LW'; "CMDLIST:=CONCAT(CMDLIST,'^NL^NM^NT^PD^PG^PP^PS^RS^SK^SS^ST^TB^TI^UC^UL'); "AIFLAG:=FALSE; "BIGTITLFLAG:=FALSE; "DSFLAG:=FALSE; "ENHANCFLAG:=FALSE; "ILFLAG:=FALSE; "INDENT:=5; "INDFLAG:=FALSE; G);  IF LENGTH(TEMPSTRING)<1 THEN TEMPSTRING:='1';  IF TEMPSTRING[1]=CHR(27) THEN EXIT(PROGRAM); "NUMCOPIES:=DEC(TEMPSTRING);  END(*GETFILES*);   PROCEDURE INIT;  BEGIN; "RESET(INFILE,INPUTFILE); "REWRITE(OUTFILE,OUTPUTFILE); "CMDLIST:='^AI^OUTPUTFILE:=CONCAT(OUTPUTFILE,'.TEXT') &ELSE IF COPY(OUTPUTFILE,LENGTH(OUTPUTFILE)-4,5)<>'.TEXT' THEN (OUTPUTFILE:=CONCAT(OUTPUTFILE,'.TEXT'); "END; "WRITELN(' PASCAL WORD PROCESSOR USES ',OUTPUTFILE); "WRITE('NUMBER OF COPIES? '); "READLN(TEMPSTRIN"WRITE('OUTPUT FILE? '); "READLN(OUTPUTFILE); "IF LENGTH(OUTPUTFILE)<1 THEN OUTPUTFILE:='PRINTER:'; "IF OUTPUTFILE[1]=CHR(27) THEN EXIT(PROGRAM); "IF (OUTPUTFILE<>'CONSOLE:') AND (OUTPUTFILE<>'PRINTER:') THEN "BEGIN; $IF LENGTH(OUTPUTFILE)<6 THEN &(INPUTFILE:=CONCAT('#4:',INPUTFILE); (RESET(INFILE,INPUTFILE); (IOSUCCESS:=(IORESULT=0); &END; $END; $IF NOT IOSUCCESS THEN WRITELN('FILE NOT FOUND'); $(*I+*) "END; "CLOSE(INFILE); "WRITELN(' PASCAL WORD PROCESSOR USES ',INPUTFILE); PROGRAM); " CLOSE(INFILE); $(*$I-*) $RESET(INFILE,INPUTFILE); $IOSUCCESS:=(IORESULT=0); $IF NOT IOSUCCESS THEN $BEGIN; &INPUTFILE:=CONCAT(INPUTFILE,'.TEXT'); $ RESET(INFILE,INPUTFILE); &IOSUCCESS:=(IORESULT=0); &IF NOT IOSUCCESS THEN &BEGIN; FAULTS'); "WRITELN(',CR TO TERMINATE'); "WRITELN; "IOSUCCESS:=FALSE; "WHILE NOT IOSUCCESS DO "BEGIN; $WRITE('INPUT FILE? '); $READLN(INPUTFILE); $IF LENGTH(INPUTFILE)<1 THEN INPUTFILE:='#4:SYSTEM.WRK.TEXT'; $IF INPUTFILE[1]=CHR(27) THEN EXIT( VAR IOSUCCESS:BOOLEAN;  BEGIN; "PAGE(OUTPUT); "WRITELN('PASCAL WORD PROCESSOR - 6/11/80'); "WRITELN; "WRITELN('INPUT DEFAULT IS SYSTEM.WRK.TEXT'); "WRITELN('OUTPUT DEFAULT IS PRINTER:'); "WRITELN('COPIES DEFAULT IS 1'); "WRITELN('CR TO UTILIZE DEOSIT+1]<>' ' THEN DELETE(WORD,LENGTH(WORD),1); &END; &IF (WORD[1]='^') AND (NOT(WORD[2] IN ['/','^'])) THEN COMMAND &ELSE BEGIN; (UPLOW; (PLACEIN;  END; $END; "END; "NLFLAG:=TRUE; "SENDOUT;  END(*PROCESS*);   PROCEDURE GETFILES; "UצPRINTER:  " 楁A暑퓄暑퓄'f @ڪP0-././ȡ!-.0.$UצPRINTER:UCONSOLE:ׯ  MORE? ,P,ɡ ,Y˓` @  V <$Kצ6^AI^BT^CM^DS^EA^EI^EJ^EL^EM^ET^IF^IL^IM^IS^IT^JS^LC^LWxKKxצ-^NL^NM^NT^PD^PG^PP^PS^RS^SK^SS^ST^TB^TI^UC^ULǥx륀ЦתP~צP7תPBšJ.TEXT׷UUPצ.TEXTUP PASCAL WORD PROCESSOR USES UNUMBER OF COPIES? ,P,ɡ,1P,á,X UKצ6^AI^BT^CM^DS^EA^EI^EJ^EL^EM^ET^IF^IL^צFILE NOT FOUND PASCAL WORD PROCESSOR USES צ OUTPUT FILE? UPUɡUPRINTER:תPUáUCONSOLE:׷UצPRINTER:dUɡ!UUP.TEXTUP;UUؓ INPUT FILE? Pɡצ#4:SYSTEM.WRK.TEXTPá"ؓfPצ.TEXTUP"ؓ0#4:SP"ؓWORD PROCESSOR - 6/11/80צ INPUT DEFAULT IS SYSTEM.WRK.TEXTצOUTPUT DEFAULT IS PRINTER:צCOPIES DEFAULT IS 1CR TO UTILIZE DEFAULTS,CR TO TERMINATE 䥀ɥЩ䛾 ˄ ةؕP@DP QPȡЩ ˡ ^å@   ~V PASCAL ɄPP QPMR h䥂 Y ġJ TERMINATE? Yá P  䩃 ȡ ثB7šȡ |ةšةإ~ b~šVPJE!ByuqmiTG6 |xt\RNNV 䥀áRצP쩃~š 퓡~P~תP婃ɡ ~šثثس!á á á~š šCצPȡ'Pצ QP ɡ~~NTn  멃쓄ń/ȡ"~~Pצ QP *V PšK ~š~~ å~ń ~~~  ~צP+T d ~š~ Ä ~~šA 멃쓄ń/ȡ"~~Pצ QP~~PǠPF **P+,-,-ȡ,/˥,^˄O,+,* +,++ **+,/á*+,,,++,,-+-P 橃橃š-..-.XR~ڕ~ á~ٛ á á 㩃ši~  ة- ץ~P~ Ą ةةũÄɩÄ yMZIM^IS^IT^JS^LC^LWxKKxצ-^NL^NM^NT^PD^PG^PP^PS^RS^SK^SS^ST^TB^TI^UC^ULǥx륀ЦתP~צP7תPBšJN^qB /ENDS THE RIGHT-JUSTIFY MODE.  ^CM EL  ^PP ^IL ^^/E/L ^EL  /FLAGS THE END OF A LABEL.  ^CM EM  ^PP ^IL ^^/E/M ^EL  /ENTER THE ENHANCED PRINTING MODE.  ^CM ET  ^PP ^IL ^^/E/T ^EL  /ENDS THE TITLE.  ^CM IF  ^PP ^IL ^^/I/FNN ^EL  /CONDITIONAL NEWWILL BE REGARDED AS A  COMMENT AND WILL NOT BE PROCESSED.  ^CM DS  ^PP ^IL ^^/D/S ^EL  /SET DOUBLE SPACE MODE.  ^CM EA  ^PP ^IL ^^/E/A ^EL  /END THE /AS-/IS MODE.  ^CM EI  ^PP ^IL ^^/E/I ^EL  /ENDS THE INDENT MODE.  ^CM EJ  ^PP ^IL ^^/E/J ^EL  /ENTER THE /AS-/IS MODE. /THIS WILL  DEFEAT THE EXTRA SPACE SUPPRESSION  FEATURE OF THE NORMAL PARAGRAPH  MODE OF OPERATION.  ^CM BT  ^PP ^IL ^^/B/T ^EL  /FLAGS TITLE TO BE PRINTED IN ENHANCED  MODE.  ^CM CM  ^PP ^IL ^^/C/M ^EL  /REST OF LINE PRINTING  MODES CANNOT BE MIXED ON THE SAME LINE.  ^PP /THE FORMAT COMMANDS ARE LISTED  ON THE FOLLOWING PAGES.  ^PG ^EJ ^NL  ^IM ^IS20 ^IL ^UC COMMAND ^EL FUNCTION  ^LC ^NL ^IL ------- ^EL --------  ^CM AI  ^JS ^PP ^IL ^^/A/I ^EL WORD /PROCESSOR IS  DESIGNED TO BE USED IN CONJUNCTION WITH  THE /INTEGRAL /DATA /SYSTEM PRINTER  /MODEL 440.  /SPECIAL COMMANDS ARE INCLUDED TO ALLOW  PRINTING IN DIFFERENT PRINT DENSITIES  AND^/OR IN ENHANCED MODE.  /NOTE THAT ENHANCED AND NORMAL IT CAN  WITHOUT VIOLATING THE LINE WIDTH LIMITS.  /THUS ALL EXTRA SPACES WILL BE  SUPPRESSED ON PRINT OUT.  /OTHER COMMANDS SUCH AS ^^/A/I  (/AS-IS /MODE) ARE USED TO SUPPRESS  THIS PARAGRAPH MODE OF OPERATION.  ^PP /THIS VERSION OF  THE /PASCAL / /EACH TIME THE /PASCAL /WORD /PROCESSOR  ENCOUNTERS ^^/P/P, IT WILL SKIP  TWO LINES AND BEGIN A NEW PARAGRAPH.  /TEXT WITHIN A PARAGRAPH IS ENTIRELY  FREE FORM. /THE /PASCAL /WORD  /PROCESSOR WILL FIT THE MAXIMUM NUMBER  OF WORDS ON EACH LINE THATAS A CASE SHIFT.  /THUS IF THE USER IS IN THE NORMAL  LOWER CASE MODE, THEN ^/THE WILL  PRINT /THE.  ^PP  /THE BASIC UNIT OF TEXT IS THE  PARAGRAPH.  /NEW PARAGRAPHS ARE SIGNALLED BY  ^^/P/P AT THE BEGINNING. T MATERIAL ITSELF AS WELL AS  IMBEDDED FORMAT COMMANDS.  /THESE FORMAT COMMANDS ARE OF THE  FORM ^^/A/A (WHERE /A/A REPRESENTS TWO  ALPHABETIC CHARACTERS).  /THE /PASCAL /WORD /PROCESSOR ALSO  RECOGNIZES ^//A (WHERE /A IS ANY  ALPHABETIC CHARACTER) TEXT TO BE  PRINTED (ALONG WITH FORMAT COMMANDS)  USING THE /PASCAL /EDITOR.  /ANY ERRORS IN TEXT OR FORMAT ARE ALSO  CORRECTED USING THE /PASCAL /EDITOR.  ^PP /THE TEXTUAL MATERIAL ENTERED USING  THE /PASCAL /EDITOR PROGRAM WILL CONSIST  OF THE TEX^TI ^UC PASCAL WORD PROCESSOR ^LC ^ET  ^BT ^PG ^JS ^NL /THE /PASCAL /WORD  /PROCESSOR ALLOWS THE USER TO PRINT  NEATLY FORMATTED REPORTS, MANUALS,  DOCUMENTS ETC.  /IT IS USED IN CONJUNCTION WITH THE  /PASCAL /EDITOR PROGRAM.  /THE USER ENTERS THE PAGE. /AVOIDS  PRINTING OF HEADINGS AS THE LAST  LINES ON A PAGE. /SKIPS IF LINE IS  WITHIN THE LAST NN LINES.  ^CM IL  ^PP ^IL ^^/I/L ^EL  /START A LABEL AT THE LEFT MARGIN DURING  INDENT MODE.  ^CM IM  ^PP ^IL ^^/I/M ^EL  /INDENTS ALL SUBSEQUENT TEXT. /THE  INDENT WILL BE 5 SPACES UNLESS RESET  BY THE ^^/I/S COMMAND.  ^CM IS  ^PP ^IL ^^/I/S ^EL  /SETS THE INDENT VALUE TO NN.  ^CM IT  ^PP ^IL ^^/I/T ^EL  /RE-ACTIVATES PRINTING OF TITLE ON ALL  SUBSEQUENT PAGES.  PROCEDURE PRINTHIRES; IMPLEMENTATION E .CODE.CODEPDISKWAPDISKԍ֍br r b^br APP`b6 6 ^``Pb6 r  G@ TIGER  TITLE ON THE FIRST PAGE).  ^CM UC  ^PP ^IL ^^/U/C ^EL  /SET UPPER CASE MODE.  ^EJ E PRINT HEAD TO COLUMN NN.  /OVERRIDES THE PARAGRAPH MODE.  ^CM TI  ^PP ^IL ^^/T/I ^EL  /FLAGS THE FOLLOWING TEXT AS A TITLE  TO BE PRINTED ON EACH PAGE.  (NOTE: TITLE MUST BE FOLLOWED BY A  ^^/P/G COMMAND TO ENSURE PRINTING GTH(55), AND /INDENT(5).  ^CM SK  ^PP ^IL ^^/S/KNN ^EL  /SKIP NN LINES.  ^CM SS  ^PP ^IL ^^/S/S ^EL  /ENTER SINGLE SPACE MODE.  ^CM ST  ^PP ^IL ^^/S/T ^EL  /PRINT TITLE IN NORMAL MODE (SMALL  TITLE).  ^CM TB  ^PP ^IL ^^/T/BNN ^EL  /POSITION THE FIRST COLUMN AND START A NEW  PARAGRAPH.  ^CM PS  ^PP ^IL ^^/P/SNN ^EL  /SET THE NUMBER OF PRINTED LINES PER  PAGE TO NN. /THE DEFAULT NUMBER OF  PRINTED LINES IS 55.  ^CM RS  ^PP ^IL ^^/R/S ^EL  /RESET TO DEFAULT /PAGE /WIDTH(66),  /PAGE /LEN /PRINTER. 8, 10, 12, OR 16 CHARACTERS  PER INCH MAY BE SELECTED AS NN.  /DEFAULT SETTING IS 10 /C/P/I.  ^CM PG  ^PP ^IL ^^/P/G ^EL  /EXECUTE A FORM FEED (LINE PRINTER).  ^CM PP  ^PP ^IL ^^/P/P ^EL  /SKIP TWO LINES. /POSITION PRINT HEAD  AT TH /ENDS THE ENHANCED PRINTING MODE.  ^CM NT  ^PP ^IL ^^/N/T ^EL  /SUPPRESSES THE TITLE ON ALL SUBSEQUENT  PAGES.  ^CM PD  ^PP ^IL ^^/P/DNN ^EL  /ALLOWS SELECTION OF DIFFERENT PRINT  DENSITIES FOR THE /PAPER /TIGER WIDTH TO NN. /THE  DEFAULT LINE WIDTH IS 66 CHARACTERS.  ^CM NL  ^PP ^IL ^^/N/L ^EL  /EXECUTE A CARRIAGE-RETURN AND LINE FEED  TO POSITION THE PRINT HEAD AT THE  BEGINNING OF A NEW LINE. /OVERRIDES  PARAGRAPH RULES.  ^CM NM  ^PP ^IL ^^/N/M ^EL  ^CM JS  ^PP ^IL ^^/J/S ^EL  /ENTER THE /RIGHT-/JUSTIFICATION MODE.  /TEXT WILL BE RIGHT JUSTIFIED BY  ADDING SPACES WITHIN THE TEXT.  ^CM LC OR UL  ^PP ^IL ^^/L/C OR ^^/U/L ^EL  /SET LOWER CASE MODE.  ^CM LW  ^PP ^IL ^^/L/WNN ^EL  /SET THE LINE APPLE2T TIGER.CODEz6 z|z6 PPb6 *,, TIGER.CODETEM.SWAPDISKQܡ ޢۆTIGER.TEXT/(tT-  TIGER.CODEK.CODE[*]^APPLE2:SYSTEM.SWAPDISK{  ȡ& á   ǿš `Z h4h5hhhhhhhh G)% 8fHJH5H4H`H)JJh & & fPROGRAM TEXTPNT;  (*PRINTS TEXT FILES WITH PAGE NUMBERS &*)  (*AND JUSTIFICATION OPTIONS.^N=>OFF,^J=*)  (*ON.BY DAVID M.BARTON,CIDER PRESS,JUNE81*)   CONST #MAXLINES = 52; (*TEXT LINES PER PAGE*) #MAXJUST = 10;  TYPE #CHARSET = SET OF CHAR;  VN^WW UNITWRITE(PRINTER,SEND,2,0,12); (* RESTORE TO NORMAL PRINTER MODE *) END; (* PRINTHIRES *) BEGIN; END.  279 DO BEGIN N:=SCRNBYT(X,Y); UNITWRITE(PRINTER,N,1,0,12); IF N=3 THEN UNITWRITE(PRINTER,N,1,0,12); END; UNITWRITE(PRINTER,SEND,2,0,12); (* SEND[0..1] = NEW LINE OR CR *) Y:=Y+6; UNTIL Y>191; SEND[1]:=2; R=6; VAR SEND: PACKED ARRAY[0..3] OF 0..255; N,X,Y: INTEGER; BEGIN SEND[0]:=3; SEND[1]:=11; UNITWRITE(PRINTER,SEND,1,0,12); (* SEND[0] = CHANGE PRINTER TO GRAPHICS MODE *) Y:=0; REPEAT FOR X:= 0 TO (*$S+*) UNIT TIGER; INTRINSIC CODE 25; INTERFACE PROCEDURE PRINTHIRES; IMPLEMENTATION FUNCTION SCRNBYT(X,Y: INTEGER): INTEGER; EXTERNAL; PROCEDURE PRINTHIRES; (* DUMP HIRES GRAPHICS PAGE TO THE PAPER TIGER PRINTER *) CONST PRINTEN^qq) #i `g6 PPb6 *,, TIGER.CODETEM.SWAPDISKQܡ ޢۆTIGER.TEXT/(tT-  TIGER.CODEK.CODE[*]^APPLE2:SYSTEM.SWAPDISK{AR #SOURCE, DEST : TEXT;  NUMOFCOL, LINES, PAGENUM, #RTPAGEPOS : INTEGER; #FILENAME : STRING[20]; #STR : STRING[80]; #LINE : STRING; #CH : CHAR; #IOGOOD, JUSTEN, JUSTON : BOOLEAN; #  PROCEDURE GETLINE;  BEGIN #READLN (SOURCE, LINE); #(*CHECK FOR COMMAND LINE*) #IF (COPY(LINE,1,1) = '^') AND JUSTEN THEN %BEGIN (IF COPY (LINE,2,1) = 'J' THEN *JUSTON := TRUE (ELSE JUSTON := FALSE; % READLN (SOURCE, LINE); %END; %(*REMOVE BLANKS FROM END OF LINE*) #WHILE (COPY(LINE,LENGTH(LINE),10a"ëC#NOT FOUND,PRESS ANY KEY TO CONTINUE0NUMBER OF COLUMNS : ` `ũ`PɄ"Ä@'ILLEGAL INPUT,PRESS ANY KEY TO CONTINUEצRIGHT JUSTIFY? (Y//P/ Q/P٥lɥl`Ʉ,l.. ץlP-R|ץ/0\צSOURCE FILE : a.TEXTץaá%a¥¥a¦.TEXTª0P0^/J0P0 lP:R-l`ɥl` Ą٥l-"l..  - P..ȡ"BpTEXTPNT ITELN(DEST,'PAGE',RTPAGEPOS,PAGENUM:4); 0WRITELN(DEST);WRITELN(DEST) +END; )GETLINE; &END;  PAGE(DEST);  END. & T EOF(SOURCE) DO &BEGIN )IF JUSTON THEN JUSTIFY; )WRITELN(DEST,STR); )LINES := LINES + 1; )IF LINES>MAXLINES THEN +BEGIN .LINES := 0; .PAGENUM := PAGENUM + 1; .PAGE (DEST); .IF (PAGENUM MOD 2) = 0 THEN 0WRITELN(DEST,'PAGE',PAGENUM:4) .ELSE 0WRTRUE #ELSE %JUSTEN := FALSE; #JUSTON := JUSTEN; # #REWRITE(DEST,'CONSOLE:'); #WRITE(DEST,' '); #LINES := 1; #PAGENUM := 1; #RTPAGEPOS := NUMOFCOL - 5; #WRITELN(DEST,'PAGE':RTPAGEPOS,PAGENUM:4); #WRITELN(DEST);WRITELN(DEST); #GETLINE; #WHILE NO/(NUMOFCOL<80) AND /(IORESULT=0); %IF NOT IOGOOD THEN 'BEGIN *WRITELN('ILLEGAL INPUT,PRESS ANY KEY TO CONTINUE'); *READ(KEYBOARD,CH) 'END #UNTIL IOGOOD; #(*$I+*) #WRITE('RIGHT JUSTIFY? (YN) '); #READ(KEYBOARD,CH); #IF CH = 'Y' THEN %JUSTEN := D := (IORESULT=0); %IF NOT IOGOOD THEN 'BEGIN *WRITELN('NOT FOUND,PRESS ANY KEY TO CONTINUE'); *CLOSE (SOURCE); *READ (KEYBOARD,CH) 'END #UNTIL IOGOOD; ) #REPEAT %WRITELN('NUMBER OF COLUMNS : '); %READ (NUMOFCOL); %IOGOOD := (NUMOFCOL>15) AND 1; (COL := 1; (STARTJUST := FALSE (END  END; (*JUSTIFY*) )  BEGIN (*MAIN*) #(*$I-*) #REPEAT %WRITE('SOURCE FILE : '); %READLN(FILENAME); %IF (POS('.TEXT',FILENAME)=0) THEN 'FILENAME := CONCAT(FILENAME,'.TEXT'); %RESET(SOURCE,FILENAME); %IOGOO )S := ' '; )FOR I := 1 TO PASS DO ,S := CONCAT(S,' '); )WHILE (COL= (NUMOFCOL-MAXJUST)) DO &BEGIN )WHILE (COL ' ' THEN 1BEGIN 4STARTJUST := TRUE; 4COL := COL + 3 1END /ELSE 1COL := COL + 1 ,END;)=' ')DO 'DELETE (LINE,LENGTH(LINE),1); #STR := COPY (LINE,1,LENGTH(LINE));  END; (*GETLINE*) %  PROCEDURE JUSTIFY;  VAR #I, COL, PASS : INTEGER; #S : STRING; #STARTJUST : BOOLEAN;  BEGIN #PASS := 1; #COL := 1; #STARTJUST :=FALSE; N) YáCONSOLE: _^`]צPAGE]^ 0 𩂿l___4š{_^^ ^á#צPAGE^ ,PAGE] ^  0UMNS : ` `ũ`PɄ"Ä@'ILLEGAL INPUT,PRESS ANY KEY TO CONTINUEצRIGHT JUSTIFY? (Y7^C1^EC/HOW TO /PRINT /TEXT^C2^NC   %1. /PREPARE YOUR TEXT BY GOING INTO THE /EDITOR.  %2. /IF YOU HAVE A FILE ALREADY CREATED, ENTER THAT NAME, OTHERWISE TYPE  RETURN TO START A NEW ONE.  %3. /SET /ENVIRONMENT (TYPE /S THEN /E). /NEXT CHAN^OFACE;   BEGIN  CHEAT.INT := -16625;  IF LNF  THEN CHEAT.PTR^[0] := 0 $ELSE CHEAT.PTR^[0] := 255;  END;   BEGIN  END.  THEN THE LINE-FEEDS WILL BE PASSED.   *)   PROGRAM LINEFEED;    PROCEDURE LF(LNF : BOOLEAN);   TYPE PA=PACKED ARRAY[0..1] OF 0..255; %TWOFACE=RECORD CASE BOOLEAN OF -TRUE : (INT : INTEGER); -FALSE : (PTR : ^PA); -END; -  VAR CHEAT : TW(*  THIS PROGRAM INITIALIZES BIOS TO FILTER OUT ANY LINE-FEEDS SENT TO THE PRINTER.   UCSD SYSTEM OF 23 FEB 79 FOR APPLE II HAS A LINE-FEED FLAG AT LOCATION $BF0F  IF THIS FLAG IS SET TO 255, LINE-FEEDS WILL BE SUPRESSED, IF IT IS SET TO 0  (DEFAULT)N^xN) YáCONSOLE: _^`]צPAGE]^ 0 𩂿l___4š{_^^ ^á#צPAGE^ ,NGE /AUTO-INDENT TO  /FALSE (TYPE /A THEN /F) AND /FILLING TO /TRUE (TYPE /F THEN /T). /TYPE  CTRL-/C TO GET BACK TO THE MAIN /EDITOR.  4. /TYPE IN YOUR TEXT USING /INSERT. /PUT A SLASH (//) IN FRONT OF  CAPITAL LETTERS. /IF YOU HAVE A LOT OF CAPITALS IN A ROLL, YOU CAN "SHIFT  LOCK" BY TYPING /^/U/C (UPPER CASE), TYPE THE LETTERS, THEN /^/L/C TO UNLOCK  SHIFT (LOWER CASE).  )/SAVE YOUR FILE (/Q TO QUIT, EITHER /U TO SAVE IT IN A WORKFILE  ^UCSYSTEM.WRK.TEXT^LC OR /W TO WRITE IT TO A WHITE MANUAL INDICATES THAT RESET WOULD  ALSO WORK. IT AIN'T SO. A RUN-TIME  ERROR RESULTS.*)   CASE ANSWER OF " "'A':BEGIN 'S^:=CHR(ESCAPE);PUT(S); 'S^:=CHR(NORMAL);PUT(S) &END; " "'B':BEGIN 'S^:=CHR(ESCAPE);PUT(S); 'S^:=CHR(PROPORTIONALLN('PRESS ANY OTHER KEY TO EXIT PROGRAM.');   READ(KEYBOARD,ANSWER);   IF NOT (ANSWER IN ['A','B','C'])  THEN EXIT(PR737);   REWRITE(S,'PRINTER:');  (*HERE IS THE CRUX OF THE PROGRAM. HOW TO  SEND OUTPUT TO THE PRINTER. PG.133 OF THE OUTPUT);  GOTOXY(0,8);  WRITELN('SELECT THE PRINTSET THAT YOU WANT');  WRITELN;  WRITELN(' A) NORMAL');  WRITELN(' B) PROPORTIONAL');  WRITELN(' C) CONDENSED');  WRITELN;  WRITELN('PRESS KEY A,B, OR C TO CHOOSE PRINTSET');  WRITENORMAL=19; (*SOFTWARE SWITCHES*) (PROPORTIONAL=17; (CONDENSED=20; (CR=13; (*CARRIAGE RETURN*) (  VAR ANSWER: CHAR;  $I (*INDEX*): INTEGER; $ $LINE: STRING; $ $S (*SWITCHES*): FILE OF CHAR;   BEGIN  PAGE(  PROGRAM PR737; (* BY PAUL NORRIS *)   (* WORKS FOR CENTRONICS 737 PRINTER.*)  (* SIMPLY CHANGING THE FOLLOWING CONSTANTS  SHOULD MAKE THIS ROUTINE WORK FOR #ANY OTHER PRINTER. *) #  CONST ESCAPE=27; (*INITIALIZE FOR SOFTWARE SWITCH*) (N^ZAVEN'T,  THEN IT IS ^UCSYSTEM.WRK.TEXT^LC AND YOU ONLY HAVE TO HIT RETURN. /THE  OUTPUT FILE NAME IS USUALLY ^UCPRINTER^LC: BUT CAN BE A NEW DISK FILE NAME.   %/^/E/C ^EC/ENHANCED /CHARACTERS (DOUBLE WIDTH)^NC  %/^/N/C /NORMAL /CHARACTERS (OPPOSITE OF ENHANCED)  %6. /NEXT, /X (E/XECUTE) THE PROGRAM ^UCPRINT^LC. /IT WILL ASK FOR THE  INPUT FILE NAME. IF YOU HAVE NAMED IT, TYPE IN THE NAME. /IF YOU H SPECIFIC FILE).  %5. /SPECIAL FEATURES: (FOR /PAPER /TIGER PRINTER)  %/^/C8 ^C88.3 CHARACTERS PER INCH^C2  %/^/C1 ^C110 CHARACTERS PER INCH^C2  %/^/C2 ^C212 CHARACTERS PER INCH  %/^/C6 ^C616 CHARACTERS PER INCH^C2  );PUT(S) &END; " "'C':BEGIN 'S^:=CHR(ESCAPE);PUT(S); 'S^:=CHR(CONDENSED);PUT(S) &END; " "END; (*OF THE CASE*) "  LINE:='THIS LINE IS OUTPUT IN THE PRINTSET YOU HAVE CHOSEN.';   FOR I:=1 TO LENGTH(LINE) DO #BEGIN %S^:=LINE[I]; %PUT(S) #END; #  S^:=CHR(CR);PUT(S); (*OUTPUT CARRIAGE RETURN*)   CLOSE(S)   END.(*PR737*)   @ EPSON  begin {main}  end. ;  var #num : integer;  begin  num := 0; #if cent <> CENTER then num := 8; #if rotate <> ROT then num := num + 4; #if size <> LARGE then num := num + 2; #if pol = POSITIVE &then send_cmd(num, 'R') &else send_cmd(num, 'H')  end; {printpic}  (5, 'M')  end; {italics}   procedure dblstrike;  begin #if switch = ON &then send_cmd(14, 'M') &else send_cmd(15, 'M')  end; {dblstrike}   procedure changecols;  begin #send_cmd(num_columns, 'F')  end; {changecols}    procedure printpic#unitwrite(6, chars, 5, 0, 12)  end; {send_cmd}   procedure emphasis;  begin #if switch = ON &then send_cmd(12, 'M') &else send_cmd(13, 'M')  end; {emphasis}   procedure italics;  begin #if switch = ON &then send_cmd(4, 'M') &else send_cmd= chr(9); {wake-up mx80 and/or controller} #str(n,s); #for i := 1 to length(s) do chars[i+1] := chr(ord(s[i])); #i := 2 + length(s); {next free character in chars} #chars[i] := cmd; #while i < 5 do begin &i := i + 1; &chars[i] := chr(0) #end; ITY; CENT:CENTERING; 3ROTATE:ROTATION; SIZE:PRINT_SIZE);    IMPLEMENTATION   type ch_array = packed array [1..5] of char;  procedure send_cmd(n : integer; cmd : char);  var s : string;  i : integer; $chars : ch_array;  begin #chars[1] :ARGE,SMALL); #OPTIONS_SWITCH = (ON,OFF);   PROCEDURE EMPHASIS(SWITCH:OPTIONS_SWITCH);  PROCEDURE ITALICS(SWITCH:OPTIONS_SWITCH);  PROCEDURE DBLSTRIKE(SWITCH:OPTIONS_SWITCH);  PROCEDURE CHANGECOLS(NUM_COLUMNS:INTEGER);  PROCEDURE PRINTPIC(POL:POLAR {$S+}   UNIT EPSON; INTRINSIC CODE 17;  {REQUIRES AN INTERACTIVE STRUCTURES EP12 INTERFACE BOARD}   INTERFACE   TYPE #POLARITY = (POSITIVE,NEGATIVE); #CENTERING = (CENTER,LEFT); #ROTATION = (ROT,NOROT); #PRINT_SIZE = (LO^<ӤBB   TYPE #POLARITY = (POSITIVE,NEGATIVE); #CENTERING = (CENTER,LEFT); #ROTATION = (ROT,NOROT); #PRINT_SIZE = (LARGE,SMALL); #OPTIONS_SWITCH = (ON,OFF);   PROCEDURE EMPHASIS(SWITCH:OPTIONS_SWITCH);  PROCEDURE ITALICS(SWITCH:end; {add_list} "     Procedure Print_list(start:ptr);  begin "if start = nil then exit(print_list); "with start^ do begin %print_list(left_ptr); %writeln(count:5, ' ', name); %print_list(right_ptr) "end  end; {print_list}     Proce %if name = word then begin (write('.'); (count := count + 1 %end %else if word < name (then if left_ptr = nil +then make_entry(left_ptr) +else add_list(left_ptr) (else if right_ptr = nil +then make_entry(right_ptr) +else add_list(right_ptr)  "new(new_entry); "attatch := new_entry; "with new_entry^ do begin %name := word; %writeln; %write(word); %count := 1; %left_ptr := nil; %right_ptr := nil "end  end; {make_entry}     Procedure Add_List(start: ptr);  begin "with start^ do %s := copy(charset,ord(ch)-31,1); %word := concat(word,s); %if eof(in_file) then exit(read_word); {have just done last char} %read(in_file,ch) "until (not (ch in goodset))  end; {read_word}     Procedure Make_entry(var attatch:ptr);  begin "while (not eof(in_file)) and (not (ch in goodset)) %do read(in_file,ch); "if (eof(in_file)) and (not (ch in goodset)) then exit(read_word); "{throw away last break character} " "word := ''; "repeat {collect characters until break character or eof}tring; #in_file : text; #word : word_type; #new_entry,start_list : ptr; #goodset : goodchar;  charset : string[95];  # #  Procedure Read_word;  var "ch:char; "s:word_type;  begin " "{skip until a good character found} "read(in_file,ch);Program Concordance;  Uses smarterm;  Const #word_len = 30;  Type #word_type = string[word_len]; #ptr = ^entry; #entry = record )name : word_type; )count : integer; )left_ptr, right_ptr : ptr &end; &goodchar = set of char;  Var #filename : sO^uӤˡáRH6L^| PROCEDURE CHANGECOLS(NUM_COLUMNS:INTEGER);  PROCEDURE PRINTPIC(POL:POLARITY; CENT:CENTERING; 3ROTATE:ROTATION; SIZE:PRINT_SIZE);    IMPLEMENTATION E L2:SYSTEM.SWAPDISK- P ,0,0ȡ-,,,,,-,ؿ,ɡ,,-,- %[\ á M MáMMáMMF ˡˡOPTIONS_SWITCH);  PROCEDURE DBLSTRIKE(SWITCH:OPTIONS_SWITCH);  PROCEDURE CHANGECOLS(NUM_COLUMNS:INTEGER);  PROCEDURE PRINTPIC(POL:POLARITY; CENT:CENTERING; 3ROTATE:ROTATION; SIZE:PRINT_SIZE);    IMPLEMENTATION L E L2:SYSTEM.SWAPDISKdure Initialize;  begin #goodset := ['_','0'..'9','A'..'Z','a'..'z'];  charset := ' !"#$%&''()*+,-./0123456789:;<=>?@'; #charset := concat(charset,'ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^'); #charset := concat(charset,'_`abcdefghijklmnopqrstuvwxyz{|}~'); #start_list := nil; #write('Read what file ? '); #readln(filename); #filename := concat(filename,'.text'); #reset(in_file,filename); #cursoroff  end;     begin #initialize; #read_word; #make_entry(start_list); {make start} #repeat &read_(* LPRINTER:*)  (*$S+*) (* Q+*)   PROGRAM setupmx80;  (*------------------------------------------------------------------*)  (* Program to set up Epson MX-80 printer while using Pascal. *)  (* O^#J4PV\4| ٣á٢٣X؟á٣٣ צ ٣Jk{צ! !"#$%&'()*+,-./0123456789:;<=>?@_{{_ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^}_{{_ _`abcdefghijklmnopqrstuvwxyz{|}~_iRead what file ? PP.textUP,$C,Xii, i,٢٣0Yٵ٣á٢٣٣á٢٣X؟á٣٣ צ ٣Jk{צ! !"#$%&'()*+,-./0123456789:;<=>?@_{{_ABCDEFGHIJKLMNOPQRS,, إk ,, إkYצ{YY<, ,إkQ jةjj٥YY٢٢٢B٥Y.B&CONCORDA word; &add_list(start_list) #until eof(in_file); #writeln; #print_list(start_list); #cursoron  end. *)  (* NOTE: The MX-80 generally remembers what the software settings *)  (* you send are. However, Epson intentionally allows the *)  (* option "DOUBLE WIDTH" to be turned off. This is why I *)  (* have included the funny business in this program. *)  (* *)  (* ---------------------------------------------------------------- *)  (* Programmed by Burton S. Chambers III March 1981 N^qqIL done; "setvalues; "CLOSE(pr);  END.  -----*)  BEGIN "doublewidth := FALSE; compressed := FALSE; "emphasized := FALSE; doublestrike := FALSE; "REWRITE(pr,'#6:'); "PAGE(OUTPUT); "WRITELN('>Pascal[1.1] set up mx-80 bsc[1.1]'); "WRITELN; "form; done := FALSE; "REPEAT $menu; "UNT ('1': doublewidth := NOT doublewidth; ('2': compressed := NOT compressed; ('3': emphasized := NOT emphasized; ('4': doublestrike := NOT doublestrike; &END; (* case *) "END; (* menu *)  (*-------------------------------------------------------------$GOTOXY(0,13); WRITELN('since double width must be set each line'); $GOTOXY(0,15); WRITE(' which one ? [ 0..4 ] '); $REPEAT &READ(KEYBOARD,ch); IF NOT (ch IN ['0'..'4']) THEN WRITE(CHR(7)) $UNTIL ch IN ['0'..'4']; $CASE ch OF ('0': done := TRUE; ELSE WRITE('off'); $GOTOXY(xcol,8); IF doublestrike THEN WRITE(' ON') ELSE WRITE('off'); $GOTOXY(0,10); WRITELN('double width above implies # chars = ',n:3); $GOTOXY(0,12); WRITELN('*NOTE: actual number per line will = ',m:3); the double width setting shown *) $GOTOXY(xcol,5); IF doublewidth THEN WRITE(' ON') ELSE WRITE('off'); $(* above is of course a lie *) $GOTOXY(xcol,6); IF compressed THEN WRITE(' ON') ELSE WRITE('off'); $GOTOXY(xcol,7); IF emphasized THEN WRITE(' ON');  (*------------------------------------------------------------------*) "PROCEDURE menu; "VAR n,m: INTEGER; " "BEGIN $IF compressed THEN n := 132 ELSE n := 80; $m := n; $IF doublewidth THEN n := n DIV 2; !(* n will be the number of columns using$(* the above write won't make any difference in the final setting *) $IF compressed THEN WRITE(pr,ccon) ELSE WRITE(pr,ccoff); $IF emphasized THEN WRITE(pr,emon) ELSE WRITE(pr,emoff); $IF doublestrike THEN WRITE(pr,dson) ELSE WRITE(pr,dsoff); "ENDon[1] := CHR(15); ccoff[1] := CHR(18); $emon[1] := esc; emoff[1] := esc; $dson[1] := esc; dsoff[1] := esc; $ $IF doublewidth THEN WRITE(pr,dwon) ELSE WRITE(pr,dwoff); RING[1]; &emon, emoff, dson, dsoff: STRING[2]; &esc: CHAR; " "BEGIN esc := CHR(27); $dwon := ' '; dwoff := ' '; ccon := ' '; ccoff := ' '; $emon := ' E'; emoff := ' F'; dson := ' G'; dsoff := ' H'; " $dwon[1] := CHR(14); dwoff[1] := CHR(20); $ccPRESSED CHAR mode '); $WRITELN(' 3 toggle EMPHASIZED mode '); $WRITELN(' 4 toggle DOUBLE STRIKE mode '); "END;  (*------------------------------------------------------------------*) "PROCEDURE setvalues; "VAR dwon, dwoff, ccon, ccoff: ST (*------------------------------------------------------------------*) "PROCEDURE form; " "BEGIN $GOTOXY(0,3); $WRITELN(' 0 quit value '); $WRITELN; $WRITELN(' 1"toggle"DOUBLE WIDTH mode (*) '); $WRITELN(' 2 toggle COM *)  (*------------------------------------------------------------------*)   CONST xcol = 35;   VAR doublewidth,compressed,emphasized,doublestrike,done: BOOLEAN; $ch: CHAR; $pr: TEXT; LDA TABLE,X STA MASK RTS ; ; TABLE OF MASK VALUES ; TBL .BYTE 081,082,084,088 .BYTE 090,0A0,0C0 TABLE .EQU TBL-0F9 ; CALCULATION FINDS (X-COORD MOD 7) -7 ; X MOD 7 = 0 --> -7 = F9 ; #0 ;IS TOP BYTE OF XCOORD=0? BEQ $01 ;YES LDY #023 ;NO, ADD 23 TO OFFSET ADC #04 ; AND ADD 4 TO XCOORD $02 INY $01 SBC #07 BCS $02 STY OFFSET TAX 2 84 ; 3 88 ; 4 90 ; 5 A0 ; 6 C0 ; TXA CPYCOORD<256 THEN ; OFFSET=XCOORD DIV 7 ; ELSE ; OFFSET=23 + (XCOORD+4) DIV 7 ; ; ALSO CALCULATE MASK ; XCOORD MOD 7 = 0 MASK=81 ; 1 82 ; ASL A ROL ADDR+1 ASL A ROR ADDR LDA ADDR+1 AND #01F ORA #020 NOP STA ADDR+1 ; ; CALCULATE OFFSET ; FORMULA IS ? ; IF XUB1 PHA AND #0C0 STA ADDR LSR A LSR A ORA ADDR STA ADDR PLA STA ADDR+1 ASL A ASL A ASL A ROL ADDR+1 PHA ;MSB OF RETURN VALUE=0 LDA VALUE LSR A PHA ;LSB OF RETURN LDA RETURN+1 ;RESTORE PASCAL RETURN ADDR PHA LDA RETURN PHA RTS S @ADDR,Y AND #7F CLC AND MASK BEQ ISZERO SEC ; SWITCH THE CLC AND SEC ABOVE FOR NEGATIVE ISZERO ROR VALUE INC YCOORD DEC COUNT BNE LOOP LDA #0 STA VALUE PLA STA XCOORD PLA STA XCOORD+1 LOOP LDX XCOORD ;LSB OF X COORD LDY XCOORD+1 ;MSB OF X COORD LDA YCOORD JSR SUB1 LDY OFFSET LDA ;STACK BIAS (FUNC) PLA PLA LDA #06 ;6 BIT SCAN STA COUNT PLA ;LSB OF Y COORD STA YCOORD PLA ;DISCARD MSB OF Y LDA #0 IT ;USES 6 & 7 ;CALCULATED BY SUB1 OFFSET .EQU 8 ;OFFSET PAST ADDR OF BIT MASK .EQU 9 ;MASK TO GET BIT POP RETURN PLA ;DISCARD 4 BYTE PLA CRNBYT(X,Y: INTEGER); ; ; RETURN .EQU 034 ;TEMP FOR RETURN ADDR COUNT .EQU 0 ;HOW MANY BITS TO SCAN YCOORD .EQU 1 XCOORD .EQU 2 ;BYTES 2 & 3 VALUE .EQU 4 ;RETURN VALUE ADDR .EQU 6 ;ADDRESS OF SCREEN B; ; ; MACRO POPS 16 BIT ARGUMENT ; .MACRO POP PLA STA %1 PLA STA %1+1 .ENDM .FUNC SCRNBYT,2 ; ; THIS FUNCTION SCANS 6 BITS FROM ; THE HIGH RESOLUTION SCREEN ; ; FUNCTION S X MOD 7 = 1 --> -6 = FA ; ... ; X MOD 7 = 6 --> -1 = FF ; ; THUS THE TABLE ENTRY CORRESPONDING ; TO 0 IS TABLE+0 ; = TBL-0F9+0F9 ; OR LDA TABLE,X ; .END "if v > h then $limit:= h "else $if v < l then &limit:= l $else &limit:= v; "end {limit};   procedure plot {x, y: integer; c: char}; ${positions the printer head to internal coordinates (x,y). $If 'c' collates >= ASCII space, as straight a liner to internal vertical coordinate values} "begin {yint} "yint:= round ((y+origin.y)*scale.y); "end {yint};   function limit (v, l, h: integer): integer; ${returns the value 'v', limited by the low value 'l' and $high value 'h'} "begin {limit} {current plotter position}   function xint (x: real): integer; ${converts from user to internal horizontal coordinate values} "begin {xint} "xint:= round ((x+origin.x)*scale.x); "end {xint};   function yint (y: real): integer; ${converts from us {user origin offset} "posmax : position; {max plotter position} "posmin : position; {min plotter position} "loc : coordinate; {current user coordinate} "pos : position; $y : real; $end {coordinate}; "position = record $x : integer; $y : integer; $end {coordinate};   var "scale : coordinate; {user units/internal unit} "origin : coordinate; r decimal equivalents} "bs = 8; "cr = 13; "esc = 27; "ht = 9; "lf = 10; "sp = ' '; "point = '.';   type "coordinate = record $x : real; = 48; {Diablo vertical resolution} "maxh = 792; {max horiz internal coordinate} "maxv = 32767; {max vert internal coordinate} " "bel = 7; {ASCII characteyu, xmin, ymin, xmax, ymax: real);  procedure initplot;  procedure endplot;  procedure move (x, y: real);  procedure draw (x, y: real);   implementation   const "hmires = 60; {Diablo horizontal resolution} "vmires {$S+}   unit diaplot; ${unit to drive the Diablo 1600-series printers as a digital plotter. $80/07/04 PHK Initial Version. $}  interface   var "printer : text;  procedure plot (x, y: integer; c: char);  procedure viewport (x0, y0, xu, N^Ge as possible $is drawn from the current position to (x,y) using 'c' as the $plotting mark. This routine is a modification of Breshenham's $algorithm [Algorithm for Computer Control of a Digital Plotter, $IBM Systems Journal, v.4, #1, 1965]} "var " da : integer; {units to move in major direction} $db : integer; {units to move in minor direction} $dx : integer; {horizontal units to move} $dy : integer; {vertica"write (printer, chr(esc), chr(ht), chr(1)); "close (printer, normal); "end {endplot};   procedure move {x, y: real}; ${moves the plot head to (x,y) without plotting} "begin {move} "loc.x:= x; "loc.y:= y; "end {move};   procedure draw {x, y: "pos.x:= 0; "pos.y:= 0; "viewport (0, 0, 1, 1, 0, 0, 8.5, 11); "end {initplot};   procedure endplot; ${terminates the plotting session; closes the printer file} "begin {endplot} "plot (xint (loc.x), yint (loc.y), sp); ers} "var $msg : packed array [0..3] of char; "begin {initplot} "writeln; "write ('Ready printer -- console when ready '); "readln; "rewrite (printer, 'PRINTER:'); "write (printer, chr(esc), chr(ht), chr(1), chr(bel)); {tab to 0} yint(ymin), -maxv, maxv); "posmin.x:= limit (xint(xmax), 0, maxh); "posmin.y:= limit (yint(ymax), -maxv, maxv); "end {viewport};   procedure initplot; ${initializes the plotting unit; positions the plot head to (0,0); $sets default viewport paramet"scale.x:= hmires/xu; "scale.y:= vmires/yu; "plot (round(x0*hmires), round(y0*vmires), sp); {move to origin} "origin.x:= pos.x/scale.x; "origin.y:= pos.y/scale.y; "loc.x:= 0; "loc.y:= 0; "posmax.x:= limit (xint(xmin), 0, maxh); "posmax.y:= limit (rs: $(x0,y0) is the offset in inches from the physical origin to the $user origin; (xu,yu) are the scalefactors [user units/inch]; $(xmin,ymin) and (xmax,ymax) are the plotting limits. $Moves to the user origin} "begin {viewport} " moves:= moves-1; $end; " "write (printer, chr(esc), '4'); {plot mode off} "pos.x:= x; "pos.y:= y; "end {plot};   procedure viewport {x0, y0, xu, yu, xmin, ymin, xmax, ymax: real};  {sets the plotting viewport, origin, and scale facto - da); "err:= erra - da; "moves:= da; " "while moves > 0 do $begin $if err > 0 then &begin {diagonal move} &increment (movex, movey, c); &err:= err + errb; &end $else &begin {'a' axis move} &increment (xa, ya, c); &err:= err + erra; &end; $begin $da:= dx; $db:= dy; $xa:= movex; $ya:= 0; $end "else $begin $da:= dy; $db:= dx; $xa:= 0; $ya:= movey; $end;  "write (printer, chr(esc), '3'); {plot mode on} "if c > sp then $write (printer, c); "erra:= 2*db; "errb:= 2*(db write (printer, c); $end {increment};  "begin {plot}; "dx:= x - pos.x; "if dx >= 0 then $movex:= 1 "else $movex:= -1; "dy:= y - pos.y; "if dy >= 0 then $movey:= 1 "else $movey:= -1; " "dx:= abs(dx); "dy:= abs(dy); "if dx >= dy then required.} $begin {increment} $if x > 0 then $ write (printer, sp) $else &if x < 0 then $ write (printer, chr(bs)); $if y > 0 then $ write (printer, chr(esc), chr(lf)) $else &if y < 0 then $ write (printer, chr(lf)); $if c > sp then $nits per horizontal move} $movey : integer; {units per vertical move} " "procedure increment (x, y: integer; c: char); &{moves one increment in the directions specified by the signs of 'x' &and 'y', then plots the character 'c', if$xa : integer; {horizontal units per major move} $ya : integer; {vertical units per major move} $moves : integer; {number of moves that must be made} $movex : integer; {ul units to move} $err : integer; {straight/diag delta} $erra : integer; {offset error caused by major move} $errb : integer; {offset error caused by minor move} real}; ${draws a straight line from current position to (x,y)} "var " plotloc : coordinate; {coord of plot head} $startpos : position; {line starting position} $endpos : position; {line ending position} " dold : real; {dist from plot head to loc} $dnew : real; {dist from plot head to (x,y)} "begin {draw} "endpos.x:= xint (x); "endpos.y:= yint (y); "startpos.x:= xint (loc.x); "startpos.y:= yint (loc.y); "sus = 3; {start underscore} "sbf = 4; {start boldface} "ssu = 5; {start superscript} "ssd = 6; {start subscript} "bel = 7; OLE:, write to PRINTER:, $R-. $}  Interface   Const "{In-line text control characters} "nul = 0; "efc = 1; {end format controls} "sac = 2; {start alternate color} and /abs tab codes to prevent auto linefeed after cr(13) on Apple. $ 80/03/23 $R+; delete diabloattn call on open; col parameter for /diabloattn. $ 80/06/07 Make Diablo an output-only device: inhibit etx/ack protocol, /accept all controls from CONSdiabloformat. &79/08/07 fixed bi-directional positioning problems; allow 'n' response /to diabloattn requests; fix bugs in diabloformat. &80/01/02 added REMIN: for Apple II file system. &80/01/05 added 1640 HMI reset; $R-; added paritybias to HMI, VMI, {$L printer:}  {$S+}  {$R-}   Unit Diablo; ${ A general interface for the Diablo 1620/1640 Hy-Term printer. @P H Kimpel May 1979 &79/07/21 added entry points to change cpi and lpi. &79/08/04 added shadow printing; fixed space counting bug in /N^!&begin &plot (endpos.x, endpos.y, sp); &endpos:= startpos; &end $else &plot (startpos.x, startpos.y, sp); $end; "plot (endpos.x, endpos.y, point); "loc.x:= x; "loc.y:= y; "end {draw};   end {Diablo plotter unit}.  "if startpos <> pos then $begin $plotloc.x:= pos.x/scale.x - origin.x; $plotloc.y:= pos.y/scale.y - origin.y; " dold:= sqr (plotloc.x - loc.x) + sqr (plotloc.y - loc.y); $dnew:= sqr (plotloc.x - x) + sqr (plotloc.y - y); $if dold > dnew then {sound alarm} "bs = 8; {backspace} "ssp = 9; {start shadow printing}   Type "diabloerr = (diaok, diatimeout, diaeof, diabreak); "diatext = string [255]; "  Var "dfile : interactive; "  Function Diabloopen (Cpi, Lpi: integer): diabloerr;  Function Diabloclose: diabloerr;  Function Diabloattn (Col: integer): diabloerr;  Function Diablopage: diabloerr;  Function Diablocpi (Cpi: integer): diabloerr;  &chr(esc), 'B'); {print black} "rslt:= diablotab (0, 1); "rslt:= diablocpi (cpi); "rslt:= diablolpi (lpi); "lastcol:= 0; "diabloopen:= diabloack; "End {Diabloopen};   Function Diabloclose; "Var $rslt : diabloerr; "Beany noise on the line} "rslt:= diabloack; "write (dfile, ' ', {make a little noise} &chr(esc), '4', {graphics off} &chr(esc), '5', {print forward} ritybias)); $end; "diablolpi:= diabloack; "End {Diablolpi}; "  Function Diabloopen {(Cpi, Lpi: integer): diabloerr}; "Var $rslt : diabloerr; "Begin {Diabloopen} "rewrite (dfile, 'PRINTER:'); "write (dfile, chr(0)); {flush ), chr(hmi+1+paritybias)); $end; "diablocpi:= diabloack; "End {Diablocpi}; "  Function Diablolpi {(Lpi: integer): diabloerr}; "Begin {Diablolpi} "if lpi > 0 then $begin $vmi:= (vmiinc+lpi-1) div lpi; $write (dfile, chr(esc), chr(rs), chr(vmi+1+pa"Begin {Diablopage} "write (dfile, chr(ff)); "diablopage:= diabloack; "End {Diablopage};   Function Diablocpi {(Cpi: integer): diabloerr}; "Begin {Diablocpi} "if cpi > 0 then $begin $hmi:= (hmiinc+cpi-1) div cpi; $write (dfile, chr(esc), chr(usttn:= diaeof *else ,if c = chr(cr) then .diabloattn:= diaok ,else .begin .write (dfile, chr(bel)); .done:= false; .end; $ end; $until done; $end "else $diabloattn:= rslt; "End {Diabloattn}; "  Function Diablopage; $repeat &done:= true; &read (c); &if eoln then (diabloattn:= diaok &else (if eof then *diabloattn:= diaeof (else & begin *if ord(c) >= paritybias then ,c:= chr(ord(c) - paritybias); *if (c = 'n') or (c = 'N') or (c = chr(etx)) then ,diabloa: integer): diabloerr}; "Var $c : char; $done : boolean; $rslt : diabloerr; "Begin {Diabloattn} "rslt:= diablotab (col, 1); "lastcol:= col; "write (dfile, chr(bel)); "rslt:= diabloack; "if rslt = diaok then $begin "write (dfile, chr(esc), chr(ht), chr(pos+1+paritybias)); "while pos < col do $begin $if inc > 0 then &write (dfile, chr(sp)) $else &write (dfile, chr(bs)); $pos:= pos-1; $end; "diablotab:= diaok; "End {Diablotab};   Function Diabloattn {(Colk} "diabloack:= diaok; "End {Diabloack}; " !Function Diablotab (Col, Inc: integer): diabloerr; "Var $pos : integer; "Begin {Diablotab} "if col >= 0 then $if col <= maxtab then &pos:= col $else &pos:= maxtab "else $pos:= 0; ; {horizontal motion index} "vmi : integer; {vertical motion index} "lastcol : integer; {last known print position} "  Function Diabloack: diabloerr; "Var $c : char; "Begin {Diabloacts} "etx = 3; "ht = 9; "lf = 10; "vt = 11; "ff = 12; "cr = 13; "esc = 27; "rs = 30; "us = 31; "sp = 32; "  Var "hmi : integer"tabsz = 3; "maxtab = 125; "hmiinc = 120; "vmiinc = 48; "defhmi = 10; {12 cpi} "defvmi = 8; {6 lpi} "paritybias = 128; " "{ASCII control character decimal equivalenFunction Diablolpi (Lpi: integer): diabloerr;  Function Diabloprint (var Text: diatext; Margin, Spacing: integer): diabloerr;  Function Diabloformat (var Text: diatext; Margin, Spacing: integer): diabloerr;   Implementation   Const gin {Diabloclose} "rslt:= diablotab (0, 1); "write (dfile, chr(esc), 'S'); {reset HMI by switch (1640 only)} "diabloclose:= diabloack; "close (dfile, normal); "End {Diabloclose}; "  Function Diabloprint {(var Text: diatext; Margin, Spacing: integer) (: diabloerr}; "Var $x : integer; $xstart : integer; $xend : integer; $inc : integer; $spcount : integer; $c : char; $rslt : diabloerr; "Begin {Diabloprint} "xend:= length0write (dfile, chr(esc), chr(us), chr(2), 4' ', c, chr(bs), chr(bs), {offset strike} 4chr(esc), chr(us), chr(hmi+1)); .if shadow in ctlmask then 0write (dfile, chr(esc), '3', {graphics mode} 4' ', c, chr(bs), chr(esc), '4'); .write (dfile, b (col, 1); {insure print position} *repeat ,c:= text[x]; ,if c > ' ' then .begin {normal character} .if underscore in ctlmask then 0write (dfile, '_', chr(bs)); .if boldface in ctlmask then = xend) and (c = ' ') then &xend:= 0 $else &begin &margin:= margin + xstart - 1; &col:= margin; &x:= xstart; & &rslt:= diabloack; {wait for printer} &if rslt = diaok then (if xend > 0 then *begin *ctlmask:= []; *rslt:= diablotadcontrols}; $ "Begin {Diabloformat} "xend:= length (text); "if xend > 0 then $begin $xstart:= 1; $while (xend > xstart) and (text[xend] = ' ') do &xend:= xend-1; $while (xstart < xend) and (text[xstart] = ' ') do &xstart:= xstart+1; $if (xstart &write (dfile, chr(esc), 'B'); {restore print color} $if subscript in ctlmask then &write (dfile, chr(esc), 'D') {half line down} $else &if superscript in ctlmask then (write (dfile, chr(esc), 'U'); {half line up} $ctlmask:= []; $End {Enchar; {current text char} $rslt : diabloerr; {diabloack result} $ctlmask : ctlset; {mask of 'on' format controls} " "Procedure Endcontrols; $Begin {Endcontrols} $if altcolor in ctlmask then $xstart : integer; {printable text start} $xend : integer; {text index limit} $spcount : integer; {nr contiguous spaces} $col : integer; {current column nr} $c : oformat {(var Text: diatext; Margin, Spacing: integer) (: diabloerr}; "Type $controls = (altcolor, underscore, boldface, subscript, 4superscript, shadow); $ctlset = set of controls; "Var $x : integer; {text index}&if inc < 0 then (write (dfile, chr(esc), '5') {print forward again} &end; " "if rslt = diaok then $while spacing > 0 do &begin &write (dfile, chr(lf)); &spacing:= spacing-1; &end; "diabloprint:= rslt; "End {Diabloprint}; &  Function Diabldo .begin .spcount:= spcount+1; .x:= x+inc; .end; ,if spcount > tabsz then .rslt:= diablotab (margin+x+inc-1, inc) ,else .repeat 0write (dfile, ' '); 0spcount:= spcount-1; .until 0spcount <= 0; ,end *else ,write (dfile, '?'); (end; lt:= diablotab (margin+x+inc-1, inc); {insure print position} &while (x <> xend) and (rslt = diaok) do (begin (x:= x+inc; (c:= text[x]; (if c > ' ' then *write (dfile, c) (else *if c = ' ' then ,begin ,spcount:= 1; ,while text[x+inc] = ' ' {print forward} (inc:= 1; (x:= xstart-1; (lastcol:= spcount; (end &else (begin {print backward} (write (dfile, chr(esc), '6'); (inc:= -1; (x:= xend+1; (xend:= xstart; (lastcol:= margin + xstart - 1; (end; & &rs$else &spcount:= margin + xend - 1; $end; " "rslt:= diabloack; {wait for printer} "if rslt = diaok then $if xend > 0 then &begin &if abs (lastcol - (margin+xstart-1)) <= abs (spcount - lastcol) then (begin (text); "if xend > 0 then $begin $xstart:= 1; $while (xend > xstart) and (text[xend] = ' ') do &xend:= xend-1; $while (xstart < xend) and (text[xstart] = ' ') do &xstart:= xstart+1; $if (xstart = xend) and (text[xstart] = ' ') then &xend:= 0 c); .col:= col + 1; .end {normal character} ,else .if c = ' ' then 0begin 0if underscore in ctlmask then 2begin 2write (dfile, '_'); 2col:= col + 1; 2end 0else 2begin 2spcount:= 1; 2while text[x+1] = ' ' do 4begin 4spcount:= spcount+1; 4x:= x+1; 4end; 2col:= col+spcount; 2if spcount > tabsz then 4rslt:= diablotab (col, 1) 2else 4repeat 6write (dfile, ' '); 6spcount:= spcount-1; 4until 6spcount <= 0; 2end; 0end .else 0case ord(c) of 0efc: 2endcontrols; 0sac: 2begin 2write if length (head) = 0 then head:= 'SYSTEM.WRK.TEXT'; reset (doc, head); write ('continuous forms (y/n)? '); read (c); writeln; forms:= (c = 'Y') or (c = 'y'); write ('margin: '); readln (margin); t:= pagesz-2; End {Heading}; Begin {Minipub} done:= false; if diabloopen (12, 6) = diaok then begin repeat write (chr (ff), 'file to publish: '); readln (head); if eof then done:= true else begin : integer; Begin {Heading} pagenr:= pagenr+1; p:= pagenr; x:= 90-margin; repeat c:= chr(p mod 10 + ord('0')); head[x]:= c; p:= p div 10; x:= x-1; until p <= 0; head[x]:= ' '; rslt:= diabloprint (head, margin, 2); lef : integer; head : string [90]; forms : boolean; c : char; pagenr : integer; done : boolean; Procedure Heading; Var x : integer; c : char; p {$S+} {$U SYSTEM2:DIABLO.CODE} Program Minipub (Input, Output); Uses Diablo; Const ff = 12; Var doc : text; line : diatext; rslt : diabloerr; pagesz : integer; left : integer; marginN^ǠǠ&write (dfile, chr(lf)); &spacing:= spacing-1; &end; "diabloformat:= rslt; "End {Diabloformat}; $  End {Diablo Unit}. le, chr(bs)); 2col:= col - 1; 2end {bs}; 0ssp: 2ctlmask:= ctlmask + [shadow]; 0end {case}; ,x:= x+1; *until ,(x > xend) or (rslt <> diaok); *endcontrols; *lastcol:= col; *end; &end; $end; "if rslt = diaok then $while spacing > 0 do &begin write (dfile, chr(esc), 'U'); {cancel superscript} 4ctlmask:= ctlmask - [superscript]; 4end; 2write (dfile, chr(esc), 'U'); {half line up} 2ctlmask:= ctlmask + [subscript]; 2end {ssd}; 0bel: 2write (dfile, chr(bel)); 0bs: 2begin 2write (dfi4write (dfile, chr(esc), 'D'); {cancel subscript} 4ctlmask:= ctlmask - [subscript]; 4end; 2write (dfile, chr(esc), 'D'); {half line down} 2ctlmask:= ctlmask + [superscript]; 2end {ssu}; 0ssd: 2begin 2if superscript in ctlmask then 4begin 4(dfile, chr(esc), 'A'); {set alt color} 2ctlmask:= ctlmask + [altcolor]; 2end {sac}; 0sus: 2ctlmask:= ctlmask + [underscore]; 0sbf: 2ctlmask:= ctlmask + [boldface]; 0ssu: 2begin 2if subscript in ctlmask then 4begin write ('lines/page: '); readln (pagesz); write ('heading: '); readln (head); while length (head) < 90-margin do head:= concat (head, ' '); if diabloattn (40) = diaok then begin left:= pagesz; pagenr:= 1; repeat if left <= 0 then begin {new page} rslt:= diablopage; if not forms then rslt:= diabloattn (40); heading; end; ȡݩ (0]0]ݩߥ0 ˍݥ0 ) 2/>DZ áצSYSTEM.WRK.TEXTZ0צcontinuous forms (y/n)? YéyÍmargin:  צ lines/page:   heading: ZZɡ#Zצ [Z(ágޫZ 0؛ٿ ȡ؛ ᩂݩ߭> Z0\/ á צfile to publish: Z áצSYSTEM.WRK.TEXTZ0 %  : |<2#ˍ ᫃Báš "$&(@BD`` $ "(rP 4 áY_ @  á   š    ȡ ꥀA   D D U U B6h AF3 4 áY_ @  á ̷cMa v B D U d š߾ Ä޾ Ä Äނ  áš  ݾ š_ȡ ᫃B(6 ނB݂ Äoݾ š R áC á  š݂   ȡ ?ɡ5áš "$45B B   S 4š>߾ Ä޾ Ä޾ Ä߂ áš쩃BނᩃBܡ m   š0xڂچAAǀ Dš00ڂچCCǀ DPRINTER:    ġ}ȡ} ǀɡ"š   r- p  ګB ág F 7ǀġǀnNÍÍ á "" MINIPUB DIABLO readln (doc, line); rslt:= diabloprint (line, margin, 1); left:= left-1; until eof (doc) or (rslt <> diaok); end; end; until done; end; rslt:= diabloclose; End {Minipub}. צcontinuous forms (y/n)? YéyÍmargin:  צ lines/page:   heading: ZZɡ#Zצ [Z(ágޫN^GB.TEXT   THIS SHOWS A SMALL PROGRAM WHICH USES THE DIABLO UNIT (DIABLO.TEXT) TO  PRINT A PASCAL TEXT FILE WITH HEADINGS AND PAGE NUMBERS. THIS IS INCLUDED  TO SHOW HOW THE DIABLO UNIT INTERFACES WITH A USER PROGRAM. THE CODE  FOR THIS PROGRAM IS ALTWARE MAY NOT  BE SOLD, OR INCORPORATED INTO ANY OTHER SOFTWARE WHICH IS SOLD, WITHOUT  THE PRIOR PERMISSION OF THE DONATER NAMED ABOVE. AND OBVIOUSLY, HE CAN  TAKE NO RESPONSIBILITY OR LIABILITY FOR THE USE OF ANY OF THE NAMED SOFTWARE.    MINIPUDOCUMENTATION FOR DIABLO PRINTER CONTROL PROGRAMS   THESE PROGRAMS WERE DONATED TO THE APPLESEED COMPUTER CLUB BY  MR. PAUL H. KIMPEL  2284-150 CAMINITO PAJARITO,  SAN DIEGO, CA 92107   THESE PROGRAMS MAY BE USED WITHIN COMPUTER CLUBS BUT THE SOFN^YY  endplot;  end.  wnto 0 do "begin "move (4-y, 4); "draw (x, y); "end;  y:= 0;  for x:= 3 downto 0 do "begin "move (4, x); "draw (x, y); "end;  x:= 0;  for y:= 1 to 4 do "begin "move (4-y, 0); "draw (x, y); "end;  move (2, 2);  draw (2, 2);  move (0, 0); {$U diaplot.code}   program plottest;   uses diaplot;   var "x : integer; "y : integer;   begin {plottest}  initplot;  y:= 4;  for x:= 1 to 4 do "begin "move (0, x); "draw (x, y); "end;  x:= 4;  for y:= 3 doSO INCLUDED ON THE DISK. IF YOU WISH TO RECOMPILE THE  PROGRAM, YOU MAY NEED TO CHANGE THE FILE NAME IN THE $U COMMAND ON THE SECOND  LINE OF THE LISTING. AFTER COMPILING, YOU WILL NEED TO RUN THE LINKER AS  DESCRIBED IN 1.8.2 IN THE APPLE PASCAL REFERENCE MANUAL (PAGE 94) TO LINK  THE CODE FOR THE DIABLO UNIT.    DIABLO.TEXT   THIS SHOWS THE DIABLO UNIT. THE DOCUMENTATION FOR THIS CONSISTS OF A FEW  NOTES IN APPENDIX A WHICH SHOULD BE USEFUL.  KES THE CARRIAGE AT HORIZONTAL POSITION ZERO.    FUNCTION DIABLOCLOSE: DIABLOERR;   THIS ROUTINE MAY BE CALLED AFTER THE USER PROGRAM IS FINISHED WITH THE DIABLO.  IT'S USE IS OPTIONAL, BUT MUST BE CALLED IF THE PROGRAM WILL CALL DIABLOOPEN  AGAINIT. IT OPENS  A FILE TO THE PRINTER: DEVICE, SETS THE HORIZONTAL AND VERTICAL MOTION INDEXES  TO THE VALUES OF "CPI" (CHARACTERS PER INCH) AND "LPI" (LINES PER INCH),  RESPECTIVELY, WIGGLES THE DIABLO CARRIAGE TO SIGNAL THE PRINTER IS READY, AND  LEAV BY THE DIABLO UNIT. THE INTERNAL ROUTINE DIABLOACK MAY BE MODIFIED TO SEND AN  ETX AND LOOK FOR THE DIABLO'S ACK RESPONSE.    FUNCTION DIABLOOPEN (CPI, LPI: INTEGER): DIABLOERR;   THIS ROUTINE SHOULD BE CALLED BEFORE ANY OTHER ROUTINE IN THE UNOR THE  DATA TERMINAL READY (PIN 20) LINE ON THE RS-232 CONNECTOR. IT MAY ALSO BE  POSSIBLE TO USE THE ETX/ACK PROTOCOL PROVIDED BY THE DIABLO, BUT IN ORDER FOR  THIS TO WORK, THE PRINTER MUST BE INTERFACED THROUGH A SLOT WHICH CAN BE READ APPROPRIATE ACTION.   IF IT IS DESIRED TO DRIVE THE DIABLO AT A SPEED HIGHER THAN 30 CHARACTERS PER  SECOND, SOME PROVISION MUST BE MADE TO PREVENT THE PRINTER'S BUFFER FROM BEING  OVERRUN. SOME SERIAL INTERFACE CARDS PROVIDE THE CAPABILITY TO MONITHE DIABLO. EACH OF THESE ROUTINES IS DESCRIBED BELOW. EACH ROUTINE  RETURNS A VALUE OF TYPE "DIABLOERR". IF THE VALUE RETURNED IS "DIAOK", THE  ROUTINE COMPLETED SUCCESSFULLY; OTHERWISE AN ERROR WAS ENCOUNTERED, AND THE  USER PROGRAM SHOULD TAKE SOME THIS UNIT CAN BE USED WITH THEM AS WELL. THE UNIT ASSUMES THE PRINTER IS  INTERFACED USING AN ASYNCHRONOUS INTERFACE CARD IN SLOT 1 OF THE APPLE  (PRINTER:).   THE UNIT CONSISTS OF EIGHT ROUTINES WHICH CAN BE CALLED BY A USER PROGRAM TO  CONTROL T PRINTERS BI-DIRECTIONALLY  FROM AN APPLE UCSD PASCAL PROGRAM. BESIDES DIABLO PRINTERS, MOST QUME  SPRINT/5 AND SOME MODELS OF THE NEC SPINWRITER USE THE DIABLO COMMAND SET, SO PHONE NUMBER IS 714-222-8434. HE IS INTERESTED IF BUGS  SHOW UP.   ******************************************************************************    APPENDIX A: DIABLO PRINTER UNIT NOTES    THE DIABLO UNIT IS USED TO DRIVE DIABLO 1600-SERIESD OTHER DOCUMENTS FROM TEXT FILES PREPARED WITH THE PASCAL SCREEN  EDITOR. IT IS FOR SALE ON DISKETTE AT $100.00, INCLUDING SOURCE AND  DOCUMENTATION.   HE WILL BE GLAD TO ANSWER QUESTIONS OR DISCUSS THE SOFTWARE WITH ANYONE WHO'S  INTERESTED. HIS  *****************************************************************************    MR. KIMPEL HAS ANOTHER PROGRAM, CALLED MINIPUB (NOT TO BE CONFUSED WITH THE  MINIPUB LISTED ABOVE AND ON THIS DISK), WHICH USES THE DIABLO UNIT TO FORMAT  LETTERS ANMPLETE PROGRAM BUT IT DOES DRAW  "STRAIGHT" LINES AND WILL SCALE TO THE USER'S COORDINATE SYSTEM.    PLOTTEST.TEXT   THIS IS A SAMPLE PROGRAM WHICH USES THE UNIT IN DIAPLOT TO DRAW A  SIMPLE PLOT.  E FILE, BUT IT COULD BE MERGED INTO THE SYSTEM.LIBRARY AS  DESCRIBED IN 4.2 IN THE APPLE PASCAL REFERENCE MANUAL (PAGE 235).    DIAPLOT.TEXT   THIS IS A PRELIMINARY VERSION OF A UNIT WHICH DRIVES THE DIABLO IN  THE PLOTTER MODE. THIS IS NOT A COEEPING THE CODE IN A UNIT TURNS OUT TO BE QUITE HANDY, AS IT REALLY CUTS DOWN  ON THE COMPILE TIME WHEN INTERFACING THE DIABLO TO A USER PROGRAM. THE BOTHER  OF RUNNING THE LINKER AFTER EACH COMPILE IS WELL WORTH THE TROUBLE. THE CODE  IS IN A SEPARAT DURING THE SAME RUN. THE ROUTINE RETURNS THE CARRIAGE TO POSITION ZERO,  SETS THE HORIZONTAL MOTION INDEX TO THE SWITCH SETTING (MODELS 1640/1650  ONLY), AND CLOSES THE PRINTER: FILE.    FUNCTION DIABLOATTN (COL: INTEGER): DIABLOERR;   THIS ROUTINE IS USED TO REQUEST A REPLY FROM THE USER. IT POSITIONS THE  CARRIAGE TO "COL" AND SOUNDS THE DIABLO'S BELL. IT THEN WAITS FOR A SINGLE  CHARACTER RESPONSE ON THE CONSOLE: KEYBOARD (THE DIABLO KEYBOARD, IF ANY, IS  IGNORED BY THE APPLE WNG OF BOLD FACE TEXT. EACH CHARACTER (IS PRINTED TWICE, WITH THE TWO IMPRESSIONS OFFSET BY 1/120 INCH. ( ( %CHR(SSU) (THIS CHARACTER STARTS A STRING OF SUPERSCRIPT TEXT. EACH CHARACTER (IS PRINTED ONE HALF-LINE ABOVE THE NORMAL LINE. ( ( %CHR(SS) ) %CHR(SAC) (THIS CHARACTER SHIFTS THE RIBBON TO THE ALTERNATE COLOR (NO RIBBON (FOR STANDARD RIBBONS, RED FOR TWO-COLOR RIBBONS). ( ( %CHR(SUS) (THIS CHARACTER STARTS A STRING OF UNDERSCORED TEXT. ( ( %CHR(SBF) (THIS CHARACTER STARTS A STRI SPECIAL FORMATTING OF PORTIONS OF THE TEXT. CONSTANTS DEFINING THE FORMATTING  COMMANDS ARE PROVIDED IN THE INTERFACE SECTION OF THE DIABLO UNIT. THEY ARE:  %CHR(EFC) )THIS CHARACTER ENDS ANY FORMATTING COMMANDS THAT MAY BE CURRENTLY IN )EFFECT. IATEXT; MARGIN, SPACING: INTEGER): DIABLOERR;   THIS ROUTINE IS SIMILAR TO DIABLOPRINT, BUT DOES NOT PRINT BI-DIRECTIONALLY.  IT EXAMINES THE STRING IN "TEXT" FOR SPECIAL CHARACTERS WHICH CAUSE IT TO DO DIABLO (ANY LEFT AND RIGHT MARGINS SET ON THE DIABLO ARE  IGNORED BY THIS ROUTINE). "SPACING" IS THE NUMBER OF LINES TO SPACE AFTER  PRINTING THE LINE OF TEXT. VALUES LESS THAN ZERO ARE CONSIDERED TO BE ZERO.    FUNCTION DIABLOFORMAT (VAR TEXT: D  "TEXT" IS A UCSD PASCAL STRING CONTAINING THE LINE TO BE PRINTED. ANY  CHARACTERS COLLATING LESS THAN AN ASCII SPACE ARE PRINTED AS A "?". "MARGIN"  IS THE NUMBER OF COLUMNS THE FIRST CHARACTER OF "TEXT" IS TO BE INDENTED FROM  POSITION ZERO ON THE THIS ROUTINE PRINTS LINES OF TEXT BI-DIRECTIONALLY ON THE DIABLO. THE ROUTINE  COMPRESSES ALL STRINGS OF MORE THAN THREE BLANKS, GENERATES ABSOLUTE TAB  COMMANDS, AND SENSES WHICH DIRECTION WILL PRODUCE THE SHORTEST CARRIAGE TRAVEL  FOR EACH LINE.  " CAN BE REPRESENTED  EXACTLY. FOR EXAMPLE, A "LPI" VALUE OF 7 WILL ACTUALLY PRINT AT ABOUT 6.86  LINES PER INCH.    FUNCTION DIABLOPRINT (VAR TEXT: DIATEXT; MARGIN, SPACING: INTEGER): DIABLOERR;   FUNCTION DIABLOLPI (LPI: INTEGER): DIABLOERR;   THIS ROUTINE CHANGES THE VERTICAL MOTION INDEX ACCORDING TO THE LINES  PER INCH VALUE IN "LPI". NOTE THAT SINCE THE VERTICAL RESOLUTION OF THE  DIABLO IS 48 INCREMENTS PER INCH, NOT ALL VALUES OF "LPIH VALUE IN "CPI". NOTE THAT SINCE THE HORIZONTAL RESOLUTION OF THE  DIABLO IS 120 INCREMENTS PER INCH, NOT ALL VALUES OF "CPI" CAN BE REPRESENTED  EXACTLY. FOR EXAMPLE, A "LPI" VALUE OF 11 WILL ACTUALLY PRINT AT ABOUT 10.9  CHARACTERS PER INCH.    THIS ROUTINE SENDS AN ASCII FF CHARACTER TO THE DIABLO, CAUSING IT TO ADVANCE  TO THE TOP-OF-FORM POSITION.    FUNCTION DIABLOCPI (CPI: INTEGER): DIABLOERR;   THIS ROUTINE CHANGES THE HORIZONTAL MOTION INDEX ACCORDING TO THE CHARACTERS  PER INCN", IT RETURNS A VALUE OF "DIAEOF". ANY OTHER RESPONSE CAUSES  THE ROUTINE TO SOUND THE DIABLO'S BELL AGAIN AND WAIT FOR ANOTHER RESPONSE.    FUNCTION DIABLOPAGE: DIABLOERR;  MN 40 IS A GOOD CHOICE FOR THE  INSERTION OF LETTER-SIZED SHEETS OF PAPER).    IF THE USER RESPONSE IS A CARRIAGE RETURN, DIABLOATTN RETURNS A VALUE OF  "DIAOK". IF THE RESPONSE IS THE CHARACTER (USUALLY CONTROL/C), AN UPPER  OR LOWER CASE "HEN INTERFACED THROUGH SLOT 1). THE ROUTINE IS USEFUL  FOR SIGNALLING THE USER THAT THE DIABLO MUST BE SERVICED (E.G., TO INSERT A  NEW PIECE OF PAPER). POSITIONING THE CARRIAGE MAY HELP IN ALIGNMENT OF FORMS,  CHANGING RIB