`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JN^E ƠLOCASE.ART.TEXTFILEPATCH.TEXTSPLTSCREEN.TEXTSPLTSCREEN.CODE SMARTERM.TEXT Ӥ SMARTERM.CODE Ӥ LCPAT1.1.TEXT ̡ MODEDEMO.TEXT ءhnvBILLBOARDS.TEXTxv| ERASERS1.TEXT |DRAFTSMAN.TEXT DOCUMENT.TEXT  FORMAT.TEXT  MONEY.TEXT  UNSTRING.TEXT FORMATUNIT.TEXT TABDEMO.TEXT Ơ TABDEMO.CODSYSCRN1  BIOSUNIT.TEXT   BIOSDEMO.TEXT  BIOSDOC.TEXT ˡ(BIOSSTUFF.TEXTˡ(6 INPUT.CODE 6Z INPUT.TEXT Z`MIRRORIMAG.TEXT`fSLOMESSAGE.TEXTfnPALINDROME.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`&(*S+*)  UNIT BIOSUNIT;   INTERFACE   CONST (AUTO = 1; (FLUSH = 64; (STOP = 128;   TYPE (SCRANGE = 0..23;   FUNCTION CURH:INTEGER;  FUNCTION CURV:INTEGER;  PROCEDURE HORZSHFT(H:INTEGER);  PROCEDURE INVERSE;  PROCEDURE NORMAL;  PROCEDUR I:=1 TO 30 DO "BEGIN $WRITE('THIS IS FULL WINDOW SCROLL'); $WRITELN(' ',I:2); $WAIT(500); "END;  WINDOW(0,9);  GOTOXY(0,0); (* GO INSIDE WINDOW *)  FOR I:=1 TO 30 DO "BEGIN $WRITE('THIS IS PART WINDOW SCROLL'); $WRITELN(' ',I:2); $WAIT(150)HORZSHFT(-8); $WAIT(500);  END;  ONFLG(AUTO);  WRITELN('TO ILLUSTRATE AUTO-FOLLOW');  WRITELN('THE CTRL-Z OPTION OF THE EDITOR');  WRITE('TYPE IN SOME CHARACTERS NOW ');  READLN(S);  OFFFLG(AUTO);  HORZSHFT(-CHLEFT);  WINDOW(0,23);  FOR FOR I:=1 TO 3 DO "BEGIN $INVERSE; $WRITE('INVERSE'); $NORMAL; $WRITE(' '); $FLASH; $WRITE('FLASH'); $NORMAL; $WRITE(' NORMAL');  END;  WRITELN;  FOR J:=1 TO 10 DO "BEGIN $HORZSHFT(8);  WAIT(500); "END;  FOR J:=1 TO 10 DO "BEGIN $XY(20,15);  FOR I:=1 TO 10 DO "BEGIN $GOTOXY(CURH,CURV-1);  WRITE('V'); $GOTOXY(CURH-1,CURV); "END;  J := CURH + 1;  FOR I:=1 TO 10 DO "BEGIN $GOTOXY(CURH-1,CURV);  WRITE('H'); $GOTOXY(CURH-1,CURV); "END;  GOTOXY(J,CURV); NCTION CHLEFT:INTEGER; EXTERNAL;  PROCEDURE STUFF(CH:CHAR); EXTERNAL;  PROCEDURE STUFFS(S:STRING); EXTERNAL;  PROCEDURE WINDOW(TOP,BOT:SCRANGE); EXTERNAL;  PROCEDURE WAIT(T:INTEGER);  VAR (I: INTEGER;  BEGIN  FOR I:=1 TO T DO;  END;  BEGIN  GOTO PROCEDURE HORZSHFT(H:INTEGER); EXTERNAL;  PROCEDURE INVERSE; EXTERNAL;  PROCEDURE NORMAL; EXTERNAL;  PROCEDURE FLASH; EXTERNAL;  FUNCTION GETFLGS:INTEGER; EXTERNAL;  PROCEDURE ONFLG(F:INTEGER); EXTERNAL;  PROCEDURE OFFFLG(F:INTEGER); EXTERNAL;  FUPROGRAM BIOSDEMO;  CONST (AUTO = 1; (FLUSH = 64; (STOP = 128;  RETURN = 13;  TYPE (SCRANGE = 0..23;  VAR (I,J: INTEGER;  S: STRING;  TOP,BOT: SCRANGE;  FUNCTION CURH:INTEGER; EXTERNAL;  FUNCTION CURV:INTEGER; EXTERNAL; B E N^:NCTION CHLEFT; EXTERNAL;  PROCEDURE STUFF; EXTERNAL;  PROCEDURE STUFFS; EXTERNAL;  PROCEDURE WINDOW; EXTERNAL;   BEGIN  END.  RH; EXTERNAL;  FUNCTION CURV; EXTERNAL;  PROCEDURE HORZSHFT; EXTERNAL;  PROCEDURE INVERSE; EXTERNAL;  PROCEDURE NORMAL; EXTERNAL;  PROCEDURE FLASH; EXTERNAL;  FUNCTION GETFLGS; EXTERNAL;  PROCEDURE ONFLG; EXTERNAL;  PROCEDURE OFFFLG; EXTERNAL;  FUE FLASH;  FUNCTION GETFLGS:INTEGER;  PROCEDURE ONFLG(F:INTEGER);  PROCEDURE OFFFLG(F:INTEGER);  FUNCTION CHLEFT:INTEGER;  PROCEDURE STUFF(CH:CHAR);  PROCEDURE STUFFS(S:STRING);  PROCEDURE WINDOW(TOP,BOT:SCRANGE);   IMPLEMENTATION   FUNCTION CU; "END;  WINDOW(8,17);  GOTOXY(0,8); (* GO INSIDE WINDOW *)  FOR I:=1 TO 30 DO "BEGIN $WRITE('THIS IS PART WINDOW SCROLL'); $WRITELN(' ',I:2); $WAIT(150); "END;  WINDOW(17,23);  GOTOXY(0,17); (* GO INSIDE WINDOW *)  FOR I:=1 TO 30 DO "BEGIN $WRITE('THIS IS PART WINDOW SCROLL'); $WRITELN(' ',I:2); $WAIT(500); "END;  WINDOW(0,23);  PAGE(OUTPUT);  WRITELN('CHARACTERS WILL NOW BE PUT IN');  WRITELN('THE TYPE-AHEAD BUFFER TO GET');  WRITELN('AN EXTENDED DIRECTORY LISTING');  WRIBIT (OFFFLG - TURNS OFF FLAG BIT (STUFF - PUTS A SINGLE CHARACTER IN THE TYPE-AHEAD BUFFER (STUFFS - PUTS A STRING IN THE TYPE-AHEAD BUFFER (WINDOW - SETS THE TOP AND BOTTOM OF THE SCROLL WINDOW % %THE BIOSDEMO PROGRNG CHARACTERS OUTPUT IN INVERSE MODE (FLASH - OUTPUT IN FLASH MODE (NORMAL - RESTORES OUTPUT TO NORMAL CHARACTERS (GETFLGS - RETURNS FLAG BYTE THAT CONTAINS BITS FOR 9FLUSH, STOP AND AUTO FOLLOW (ONFLG - TURNS ON FLAG ( SHIFTS BEYOND COLUMN 1 OR 80 CAUSE WRAP-AROUND 9SHIFT COUNTS GREATER THAN 40 SEEM TO CAUSE PROBLEMS (CHLEFT - RETURNS THE NUMBER OF CHARACTERS TO THE LEFT OF THE ; VISIBLE SCREEN 9USED WITH HORZSHFT (INVERSE - FOLLOWINS CURSOR VERTICAL POSITION (HORZSHFT - SHIFTS THE SCREEN HORIZONTALLY 9SHIFT COUNT IS POSITIVE FOR SHIFT RIGHT 9SHIFT COUNT IS NEGATIVE FOR SHIFT LEFT 9HORZSHFT(40) DISPLAYS COLUMNS 41-80 9HORZSHFT(-40) WOULD RESTORE COLUMNS 1-40 EXTERNAL;  PROCEDURE STUFF(CH:CHAR); EXTERNAL;  PROCEDURE STUFFS(S:STRING); EXTERNAL;  PROCEDURE WINDOW(TOP,BOT:SCRANGE); EXTERNAL;  %THEY DO THE FOLLOWING THINGS:  CURH - RETURNS CURSOR HORIZONTAL POSITION (CURV - RETURINTEGER); EXTERNAL;  PROCEDURE INVERSE; EXTERNAL;  PROCEDURE NORMAL; EXTERNAL;  PROCEDURE FLASH; EXTERNAL;  FUNCTION GETFLGS:INTEGER; EXTERNAL;  PROCEDURE ONFLG(F:INTEGER); EXTERNAL;  PROCEDURE OFFFLG(F:INTEGER); EXTERNAL;  FUNCTION CHLEFT:INTEGER; 9PROGRAM AUTHOR: DAVID NEUMANN   %THE BIOSSTUFF FILE CONTAINS ASSEMBLY LANGUAGE CODE THAT CORRESPONDS TO  THE FOLLOWING PASCAL PROCEDURES AND FUNCTIONS:   FUNCTION CURH:INTEGER; EXTERNAL;  FUNCTION CURV:INTEGER; EXTERNAL;  PROCEDURE HORZSHFT(H:N^ˡTELN('OF THE BOOT VOLUME.');  STUFFS('FE#4');  STUFF(CHR(RETURN));  WRITELN('THIS WILL LEAVE YOU IN THE FILER.');  WAIT(5000);  END.  AM WILL ILLUSTRATE ALL OF THESE FUNCTIONS.  %THE CODE FILES FOR BIOSUNIT AND BIOSSTUFF MAY BE INSTALLED IN  SYSTEM.LIBRARY. THIS ALLOWS SUBSEQUENT PROGRAMS TO "USES BIOSUNIT". B E N^ˡ ;RETURN  ;*************************************** (.PROC FLASH (BANK2WRITE (LDA #40 ;SET BIT 6 FOR FLASH MODE (STA MODE (BANK1PROTECT (RTS ;RETURN  ;*************************************** (.FUNC GETFLGS (BANK2WRITE (LDA #00 ;CLEAR BITS 6 & 7 (STA MODE (BANK1PROTECT (RTS ;RETURN  ;*************************************** (.PROC NORMAL (BANK2WRITE (LDA #80 ;SET BIT 7 FOR NORMAL MODE (STA MODE (BANK1PROTECT (RTS ;*************************************** (.PROC HORZSHFT,1 (JSR SAVERET (PLA ; GET SHIFT AMOUNT (JSR HSHIFT (PLA ; DISCARD MSB OF PARM (JMP GOBACK  ;*************************************** (.PROC INVERSE ( 0 (PHA (LDA CH (PHA (PUSH RETURN (RTS  ;*************************************** (.FUNC CURV (POP RETURN (DISCARDBIAS (LDA #0 ; MSB = 0 (PHA (LDA CV (PHA (PUSH RETURN (RTS ;BIOS HORIZONTAL SHIFT  SAVERET .EQU 0FF24 ;SAVE PASCAL RETURN AND FOLD IN BIOS  GOBACK .EQU 0FF40 ;FOLD IN INTERP AND RETURN  ;*************************************** (.FUNC CURH (POP RETURN (DISCARDBIAS (LDA #0 ; MSB =HE WRITE POINTER  MODE .EQU 0D8ED ;BIOS LOCATION FOR CHARACTER MODE  LFBOT .EQU 0D920 ;BIOS LOCATION FOR LINE FEED BOTTOM LINE  SCRTOP .EQU 0D92C ;BIOS SCROLL TOP  SCRBOT .EQU 0D949 ;BIOS SCROLL BOTTOM  HSHIFT .EQU 0DA23 CONBUF .EQU 03B1 ;ADDRESS OF THE TYPE AHEAD BUFFER  NLEFT .EQU 0BF11 ;NUMBER OF CHARS TO LEFT OF SCREEN  CONFLGS .EQU 0BF15 ;CONSOLE FLAGS  RPTR .EQU 0BF18 ;ADDRESS OF THE READ POINTER  WPTR .EQU 0BF19 ;ADDRESS OF T 0 ;TEMP TO SAVE RETURN  SADR .EQU 2 ;TEMP TO SAVE STRING ADDRESS  COUNT .EQU 4 ;TEMP TO SAVE NUMBER OF CHARACTERS IN STRING  CH .EQU 0F4 ;CURSOR HORIZONTAL  CV .EQU 0F5 ;CURSOR VERTICAL C083 ;SELECT 2ND 4K BANK (LDA 0C083 ;AND WRITE-ENABLE (.ENDM  ;*************************************** (.MACRO BANK1PROTECT (LDA 0C088 ;SELECT 1ST BANK AND WRITE-PROTECT (.ENDM  ;***************************************  RETURN .EQU ******************** (.MACRO PUSH (LDA %1+1 (PHA (LDA %1 (PHA (.ENDM  ;*************************************** (.MACRO DISCARDBIAS (PLA (PLA (PLA (PLA (.ENDM  ;*************************************** (.MACRO BANK2WRITE (LDA 0 ;***************************************  ;* BIOS-STUFF *  ;* PROGRAM AUTHOR: DAVID NEUMANN *  ;*************************************** (.MACRO POP (PLA (STA %1 (PLA (STA %1+1 (.ENDM  ;*******************POP RETURN (DISCARDBIAS (LDA #0 ; MSB = 0 (PHA (LDA CONFLGS (PHA (PUSH RETURN (RTS  ;***************************************  ; POSSIBLE VALUES ARE:  ; AUTO FOLLOW = 01  ; FLUSH = 40  ; STOP = 80 (.PROC ONFLG,1 (POP RETURN (PLA ;LSB OF PARM (ORA CONFLGS (STA CONFLGS (PLA ;DISCARD MSB OF PARM (PUSH RETURN (RTS  ;***************************************  ; POSSIBLE VAL ;DISCARD MSB (PLA ;LSB OF TOP LINE (STA SCRTOP ;SET BIOS LOCATION (PLA ;DISCARD MSB (PUSH RETURN ;RESTORE PASCAL RETURN (BANK1PROTECT (RTS ;RETURN TO PASCAL (.END  (RTS ; RETURN TO PASCAL  ;*************************************** (.PROC WINDOW,2 (BANK2WRITE (POP RETURN (PLA ;LSB OF BOTTOM LINE (STA LFBOT ;SET BIOS LOCATION (STA SCRBOT ;SET BIOS LOCATION (PLA INTO STRING (LDA @SADR,Y ; GET CHARACTER FROM STRING (STA CONBUF,X ; PUT INTO BUFFER CPY COUNT ; ALL CHARACTERS STORED? (BCC LOOP ; BRANCH IF NO  SEXIT PUSH RETURN ; RESTORE PASCAL RETURN ADDRESS NCH IF NO (LDX #0 ; WRAP AROUND TO BEGINNING OF BUFFER  $1 CPX RPTR ; COMPARE TO READ POINTER (BEQ SEXIT ; IF POINTERS =, BUFFER IS FULL (STX WPTR ; ROOM FOR CHARCTER, SAVE POINTER (INY ; INCREMENT POINTERG LENGTH  BEQ SEXIT ; DONE IF ZERO LENGTH (STA COUNT ; SAVE STRING LENGTH  LOOP LDX WPTR ; GET WRITE POINTER (INX ; INCREMENT TO NEXT AVAILABLE SPOT (CPX #78. ; AT END OF BUFFER? (BCC $1 ; BRA ; STUFF A STRING INTO THE TYPE AHEAD BUFFER (.PROC STUFFS,1 (POP RETURN ; SAVE PASCAL RETURN ADDRESS (POP SADR ; SAVE STRING ADDRESS (LDY #0 ; INITIALIZE POINTER INTO STRING (LDA @SADR,Y ; 1ST BYTE OF STRING IS STRINL DONE  IGNORE PLA ; DISCARD LSB OF PARM (PLA ; DISCARD MSB OF PARM EXIT PUSH RETURN ; RESTORE PASCAL RETURN ADDRESS (RTS ; RETURN TO PASCAL  ;*************************************** POINTERS =, BUFFER IS FULL (STX WPTR ; ROOM FOR CHARCTER, SAVE POINTER (PLA ; GET LSB OF PARM, WHICH IS CHARACTER TO STORE (STA CONBUF,X ; STORE IN BUFFER (PLA ; DISCARD MSB OF PARM  JMP EXIT ; ALR (INX ; INCREMENT TO NEXT AVAILABLE SPOT (CPX #78. ; AT END OF BUFFER? (BCC $1 ; BRANCH IF NO (LDX #0 ; WRAP AROUND TO BEGINNING OF BUFFER  $1 CPX RPTR ; COMPARE TO READ POINTER (BEQ IGNORE ; IF  ; CHARACTERS BEYOND THE LIMIT ARE IGNORED  ;***************************************  ; STUFF A SINGLE CHARACTER INTO THE TYPE AHEAD BUFFER (.PROC STUFF,1 (POP RETURN ; SAVE PASCAL RETURN ADDRESS (LDX WPTR ; GET WRITE POINTE*  ; TWO ROUTINES TO PUT CHARACTERS INTO THE TYPE AHEAD BUFFER  ; STUFF - TO PUT A SINGLE CHARACTER IN THE BUFFER  ; STUFFS - TO PUT A STRING IN THE BUFFER  ; THERE IS A LIMIT OF 78 CHARACTERS ;DISCARD MSB OF PARM (PUSH RETURN (RTS  ;*************************************** (.FUNC CHLEFT (POP RETURN (DISCARDBIAS (LDA #0 ; MSB = 0 (PHA (LDA NLEFT (PHA (PUSH RETURN (RTS  ;**************************************UES ARE:  ; AUTO FOLLOW = 01  ; FLUSH = 40  ; STOP = 80 (.PROC OFFFLG,1 (POP RETURN (PLA ;LSB OF PARM (EOR #0FF ;REVERSE BITS (AND CONFLGS ;TURN OFF BIT (STA CONFLGS (PLA f INPUT / "   t| ++  +T\++  + T+0á , + ,"RZ+0á ,,",++ö  / "  x++  4+QP (( R^+.+..(++(++á +-/..9+-á +-/..-/..~"++  ,&   *$$  r ٪P T ... ....P-!*צ-+Pצ<$š0*+*+ȡ **** >,P3-,P+-F+,R`    ȡ. ⛾0 RACTER MUST BE [0..9,'+','-']4צMUST CONTAIN NEUMERIC"צ$CHECK LENGTH! LENGTH IS MORE THAN 362צINVALID CHARACTER IN STRING(Pׯ>I(%(+0.á...š 0/ 00/š11 //-11 : C` تPצ'VALLONG' ERRORRHצNULL STRING IS ASSIGNED$צ&FIRST CHAVALR' ERRORSTRING MUST 0..9, '.', '+', '-'h ڪPׯ G-áצ -%+áצ --1./0303ȡ\01 100'/ Uv\ 'VALR' ERRORAT LEAST ONE NUMBER NEED`  'VALR' ERRORTHERE ARE TWO DECIMAL POINTSd  'E MUST WITHIN '-32767..32767'p ڪPׯG-áצ-%+áצ--/.1.1ȡ7.R/ /.0 ../ -/ƶ 'VALI' ERRORINCOMPLETE STRING FORMAT` 'VALI' ERRORSTRING MUST 0..9,'+','-'`  'VALI' ERROR(RETURN VALUG(VAR X:LONGINT);      IMPLEMENTATION L E  .צE&Save as :. ? 瓡צSave asצ[š C?/צTEXT#CODE#饀!   TYPE "LONGINT=INTEGER[36];     FUNCTION VALI(STR:STRING):INTEGER;  FUNCTION VALR(STR:STRING):REAL;  PROCEDURE VALLONG(STR:STRING; VAR X:LONGINT);  PROCEDURE INPUTINT(VAR X:INTEGER);  PROCEDURE INPUTREAL(VAR X:REAL);  PROCEDURE INPUTLON""\32770װ/++ö  32760װU++  +!R++  + !V ++ö   0 8!צ00000P."\ /N--E-.á/---- UC$  VALLONGSVALLONGEINPUTINTINPUTREACRTEND M VALIS VALIE VALRS VALRE #4B#N^頃+2/PX8++ö  1/. 69á4*á5 á6á7 &á98خ.@.צ$000000000000000000000000000000000000P.//.^>.L(`$f @znB. 6  " bzR|\r <r9+  1+.20 X^ 7++  1+2/PX8++ö  1/. 69á4*á5 á6á7 &á98خ.@.צ$000000000000000000000000000000000000P.//.^>.LT5+0á2,2,6,}++ö  10\++  1+.20 X^ 7++  123++(++á(+-0..I+-á(+-0..-0..4+++0á3,+3,/L0(.... 1^0.P-!*צ-QP ((RZ1+.+..22+.+..á) á*á+ á,-خ#6#-./0צK000000000000000000000000000000000000000000000000000000000000000000000000000P.#bj ..8/ +.á0  1+0 & +.á '/0 +á%' ,++@ /á +.á0  0 & +.á '/0 +á$'~ -,2--,2--)+++á$+0á(1(1B J*+.á'/01+0á'1'14+++@ /á -QP ((R^&+-+--2'+-+--2(++h++á(+,2--I+-á(+/2(-- -- 2~2`-.á/----1-.á/-- -i |%-P,!*צ(* BY SHINICHIROU SUGOU *)   (*$S+*)  UNIT INPUT; INTRINSIC CODE 26;    INTERFACE   TYPE "LONGINT=INTEGER[36];     FUNCTION VALI(STR:STRING):INTEGER;  FUNCTION VALR(STR:STRING):REAL;  PROCEDURE VALLONG(STR:STRING; VAR X:LONGINT); EUMERIC')  END;   PROCEDURE ERROR4;  BEGIN "ERROR('CHECK LENGTH! LENGTH IS MORE THAN 36')  END;   PROCEDURE ERROR5;  BEGIN "ERROR('INVALID CHARACTER IN STRING')  END;    BEGIN(* CHECKVALID *) "BUFFER:=STR; "IF BUFFER='' THEN ERROR1 "EL); "EXIT(PROGRAM)  END(* ERROR *);   PROCEDURE ERROR1;  BEGIN "ERROR('NULL STRING IS ASSIGNED')  END;   PROCEDURE ERROR2;  BEGIN "ERROR('FIRST CHARACTER MUST BE [0..9,''+'',''-'']')  END;   PROCEDURE ERROR3;  BEGIN "ERROR('MUST CONTAIN N (*------------------------------------------------------------------------ "'ERROR', 'ERROR1'--'ERROR5' *)  VAR "BUFFER:STRING; "I :INTEGER; $  PROCEDURE ERROR(MESSAGE:STRING);  BEGIN "WRITELN; "WRITELN('''VALLONG'' ERROR'); "WRITE(MESSAGEND(* VALR *);     PROCEDURE VALLONG;  (*---------------------------------------------------------------------- "'CHECKVALID', 'CHECKSIGN', 'CALCULATE'. *)  VAR "SIGN:(PLUS,MINUS);   PROCEDURE CHECKVALID; 1; >IF DCOUNT>1 THEN ERR2 >ELSE POWER:=LENGTH(STR)-I 0 DO "BEGIN $DIGIT:=DIGIT/10; $POWER:=POWER-1 "END; " "(* SIGN *) "CASE SIGN OF PLUS:VALR:=DIGIT; /MINUS:VALR:=DIGIT*(-1) END  ETHEN ERR1 DCOUNT:=DCOUNT+$EXIT(PROGRAM) "END; " $  BEGIN(* VALR *) "IF STR='' THEN ERR1 "ELSE IF STR[1]='-' THEN BEGIN 32767 THEN ERR3; " "(* SIGN *) "CASE SIGN OF PLUS:VALI:=TRUNC(DIGIT); .MINUS:VALI:=TRUNC(DIGIT)*(-1) END  END(* VALI *); "    FUNCT36) THEN ERROR4 "ELSE FOR I:=1 TO LENGTH(BUFFER) DO $IF NOT (BUFFER[I] IN ['0'..'9']) THEN ERROR5  END(* CHECKVALID *);   PROCEDURE CHECKSIGN;  (*$G+*)  LABEL 1;  BEGIN "CASE STR[1] OF '+':BEGIN 7SIGN:=PLUS; 7STR:=COPY(STR,2,LENGTH(STR)-1); 7GOTO 1 5END; 1 1'-':BEGIN 7SIGN:=MINUS; 7STR:=COPOARD); " "IF EOLN(KEYBOARD) THEN CR " "ELSE IF (CH IN ['0'..'9']) THEN BEGIN CASSIGN; CS4 AEND "ELSE (* BS *) BEGIN 2BACKSP1; 2S2 0END  END(* S3 *);   PROCEDURE S4; (* 0..9, BS, CR *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL (CH IN ['0OF M MTRUE:BEGIN TBACKSP1; TS1A REND; M LFALSE:BEGIN TBACKSP2; TS0 REND EEND R 5END E "END(* CASE *)  END(* S2 *); 4  PROCEDURE S3; (* 0..9, BS, CR *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL (CH IN ['0'..'9', CHR(BS)]) OR EOLN(KEYB4END; 4 /FALSE:BEGIN (* 0..9, BS, CR *) 7REPEAT 9READ(KEYBOARD,CH) 7UNTIL (CH IN ['0'..'9', CHR(BS)]) OR EOLN(KEYBOARD); 7 7IF EOLN(KEYBOARD) THEN CR 7 7ELSE IF (CH IN ['0'..'9']) THEN BEGIN WASSIGN; WS3 UEND 7ELSE (* BS *) CASE SETSIGN O OF TRUE:BEGIN 6REPEAT (* BS,CR *) 8READ(KEYBOARD,CH) 6UNTIL (CH=CHR(BS)) OR EOLN(KEYBOARD); 6 6IF EOLN(KEYBOARD) THEN CR 6 6ELSE (* BS *) CASE SETSIGN OF J JTRUE:BEGIN QBACKSP1; QS1A OEND; I IFALSE:BEGIN QBACKSP2; QS0 OEND DEND S *) BEGIN 2BACKSP1; 2S0 0END  END(* S1A *);   PROCEDURE S1B;  BEGIN "IF CH='0' THEN BEGIN 3ASSIGN; 3ZERO:=TRUE; 3S2 1END 1 "ELSE (* 1..9 *) BEGIN 4ASSIGN; 4ZERO:=FALSE; 4S2 2END "  END(* S1B *);   PROCEDURE S2;  BEGIN "CASE ZERPROCEDURE S1A; (* 0..9, BS *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL CH IN ['0'..'9', CHR(BS)]; " "IF CH='0' THEN BEGIN 3ASSIGN; 3ZERO:=TRUE; 3S2 1END 1 "ELSE IF CH IN ['1'..'9'] THEN BEGIN BASSIGN; BZERO:=FALSE; BS2 @END " "ELSE (* B3SETSIGN:=TRUE; 3KETA:=KETA+1; 3S1A 1END 1 "ELSE IF CH='-' THEN BEGIN 8WRITE(CH); 8SIGN:=MINUS; 8SETSIGN:=TRUE; 8KETA:=KETA+1; 8S1A 6END 6 "ELSE (* 0..9 *) BEGIN 4SIGN:=PLUS; 4SETSIGN:=FALSE; 4KETA:=KETA+1; 4S1B 2END  END(* S0 *);   EDURE S4; FORWARD;  PROCEDURE S5; FORWARD;  PROCEDURE S6; FORWARD;   PROCEDURE S0; (* 0..9, '+', '-' *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL CH IN ['0'..'9', '+', '-']; " "IF CH='+' THEN BEGIN 3WRITE(CH); 3SIGN:=PLUS; =VALI(BUFFER); "EXIT(INPUTINT) END(* CR *);   PROCEDURE ASSIGN;  BEGIN "WRITE(CH); "BUFFER[KETA]:=CH; "KETA:=KETA+1  END(* ASSIGN *);   PROCEDURE S1A; FORWARD;  PROCEDURE S1B; FORWARD;  PROCEDURE S2; FORWARD;  PROCEDURE S3; FORWARD;  PROC"(* CRT *) "WRITE(CHR(BS)); WRITE(' '); WRITE(CHR(BS)); " "(* NUMBER *) "KETA:=KETA-2  END(* BACKSP2 *);   PROCEDURE CR;  BEGIN "BUFFER:=COPY(BUFFER,1,KETA-1); " "CASE SIGN OF PLUS:; / /MINUS:BUFFER:=CONCAT('-',BUFFER) "END(* CASE *); "X:"ZERO :BOOLEAN; "SIGN :(PLUS,MINUS); "KETA :INTEGER; "SETSIGN:BOOLEAN; "  PROCEDURE BACKSP1;  BEGIN "(* CRT *) "WRITE(CHR(BS)); WRITE(' '); WRITE(CHR(BS)); " "(* NUMBER *) "KETA:=KETA-1  END(* BACKSP1 *);   PROCEDURE BACKSP2;  BEGIN G *);     PROCEDURE INPUTINT;  (*--------------------------------------------------------------------- "'BACKSP1', 'BACKSP2', 'CR','ASSIGN', 'S0','S1A', 'S1B', 'S2'..'S6'. *) "  CONST "BS=8;  VAR "BUFFER :STRING; "CH :CHAR; "CASE SIGN OF PLUS:; . .MINUS:SUM:=SUM*(-1) "END(* CASE *); "X:=SUM  END(* CALCULATE *);     (*---------------------------------------------------------------------*)   BEGIN(* VALLONG *) "CHECKVALID; "CHECKSIGN; "CALCULATE  END(* VALLONY(STR,2,LENGTH(STR)-1); 7GOTO 1 5END "END(* CASE *); "SIGN:=PLUS; "1:;  (*$G-*)  END(* CHECKSIGN *);   PROCEDURE CALCULATE;  VAR "SUM:LONGINT; "I :INTEGER;  BEGIN "SUM:=0; "FOR I:=1 TO LENGTH(STR) DO $SUM:=SUM*10+(ORD(STR[I])-48); " '..'9', CHR(BS)]) OR EOLN(KEYBOARD); " "IF EOLN(KEYBOARD) THEN CR " "ELSE IF (CH IN ['0'..'9']) THEN BEGIN CASSIGN; CS5 AEND "ELSE (* BS *) BEGIN 2BACKSP1; 2S3 0END  END(* S4 *);   PROCEDURE S5;  BEGIN "IF BUFFER>='32770' THEN (* BS, CR *) 5BEGIN 7REPEAT 9READ(KEYBOARD,CH) 7UNTIL (CH=CHR(BS)) OR EOLN(KEYBOARD); 7 7IF EOLN(KEYBOARD) THEN CR 7 7ELSE (* BS *) BEGIN HBACKSP1; HS4 FEND 5END 5 "ELSE IF BUFFER>='32760' THEN (* 0..7, BREAD(KEYBOARD,CH) "UNTIL (CH IN ['0'..'9',CHR(BS)]); " "IF CH=CHR(BS) THEN BACKSP1 "ELSE IF CH='0' THEN BEGIN 8ASSIGN2; 8ZERO:=TRUE 6END "ELSE BEGIN )ASSIGN2; )ZERO:=FALSE 'END  END(* S1 *);   PROCEDURE S2;  BEGIN "IF CH='.' THEN BEGIN 3AGIN :WRITE(CH); :SIGN:=MINUS; :SETSIGN:=TRUE; :KETA:=KETA+1; :NEST:=NEST+1 7END # #ELSE (* 0..9,'.' *) BEGIN 6SIGN:=PLUS; 6SETSIGN:=FALSE; 6KETA:=KETA+1; 6NEST:=NEST+2 3END  END(* S0 *);   PROCEDURE S1; (* 0..9, BS *)  BEGIN "REPEAT $ PROCEDURE S0; (* 0..9,'+','-','.' *)  BEGIN " REPEAT &READ(KEYBOARD,CH) #UNTIL (CH IN ['0'..'9', '+', '-', '.']); # #IF CH='+' THEN BEGIN 5WRITE(CH); 5SIGN:=PLUS; 5SETSIGN:=TRUE; 5KETA:=KETA+1; 5NEST:=NEST+1 2END # #ELSE IF CH='-' THEN BED(* CR *);   PROCEDURE ASSIGN1;  BEGIN #WRITE(CH); #BUFFER[KETA]:=CH; #KETA:=KETA+1; #NEST:=NEST+1  END;   PROCEDURE ASSIGN2;  BEGIN #WRITE(CH); #BUFFER[KETA]:=CH; #KETA:=KETA+1; #NEST:=NEST+2  END;   (*$G+*) :=KETA-2; UNEST:=NEST-3 REND 5END ; -END #END(* CASE *)  END(* BACKSP2 *);   PROCEDURE CR;  BEGIN #BUFFER:=COPY(BUFFER,1,KETA-1); #CASE SIGN OF & %PLUS :; %MINUS:BUFFER:=CONCAT('-',BUFFER) #END; # #X:=VALR(BUFFER); #EXIT(INPUTREAL)  ENASE SETSIGN OF 0 0TRUE:BEGIN 6IF BUFFER[KETA-1]='.' THEN BEGIN TDECP:=NOTYET; TKETA:=KETA-1; TNEST:=NEST-2 QEND 6ELSE BEGIN >KETA:=KETA-1; >NEST:=NEST-2 ;END / END; / /FALSE:BEGIN 7IF BUFFER[KETA-1]='.' THEN BEGIN UDECP:=NOTYET; UKETA BEGIN " (* CRT *) #WRITE(CHR(BS)); WRITE(' '); WRITE(CHR(BS)); # #(* NUMBER *) #CASE DECP OF & &NOTYET:CASE SETSIGN OF 0 0TRUE:BEGIN 7KETA:=KETA-1; 7NEST:=NEST-2 5END; / /FALSE:BEGIN 7KETA:=KETA-2; 7NEST:=NEST-3 5END -END; & &PUT :CKETA-1; 0NEST:=NEST-1 -END; & &PUT :BEGIN 0IF BUFFER[KETA-1]='.' THEN BEGIN NDECP:=NOTYET; NKETA:=KETA-1; NNEST:=NEST-1 KEND 0ELSE BEGIN 8KETA:=KETA-1; 8NEST:=NEST-1 5END -END #END(* CASE *)  END(* BACKSP1 *);   PROCEDURE BACKSP2; --------------------- "'BACKSP1', 'BACKSP2', 'CR', 'ASSIGN1', 'ASSIGN2', "'S0'--'S4' *)  CONST #BS=8;   PROCEDURE BACKSP1;  BEGIN " (* CRT *) #WRITE(CHR(BS)); WRITE(' '); WRITE(CHR(BS)); # #(* NUMBER *) #CASE DECP OF & &NOTYET:BEGIN 0KETA:= :(NOTYET,PUT); (* DECIMAL POINT *) #NOWSET :BOOLEAN; (* SHOW WHETHER DECIMAL POINT IS PUT NOW OR NOT *) #ZERO :BOOLEAN;  SETSIGN:BOOLEAN;  PROCEDURE SUBMAIN(VAR NEST:INTEGER);  (*------------------------------------------------------ (*-------------------------*)   BEGIN(* INPUTINT *) "BUFFER:='00000'; "KETA:=0; "S0  END(* INPUTINT *);      PROCEDURE INPUTREAL;  VAR #BUFFER :STRING; #CH :CHAR; #SIGN :(PLUS,MINUS); #KETA :INTEGER; #NEST :INTEGER; #DECPP1; NS4 LEND   PROCEDURE S6; (* CR, BS *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL (CH=CHR(BS)) OR EOLN(KEYBOARD); " "IF EOLN(KEYBOARD) THEN CR " "ELSE(* BS *) BEGIN 2BACKSP1; 2S5 0END  END(* S6 *);   (* BUFFER<32760 *) (* 0..9, BS, CR *) REPEAT @READ(KEYBOARD,CH) >UNTIL (CH IN ['0'..'9', CHR(BS)]) OR EOLN(KEYBOARD); > >IF EOLN(KEYBOARD) THEN CR > >ELSE IF (CH IN ['0'..'9']) THEN BEGIN ^ASSIGN; ^S6 \END >ELSE (* BS *) BEGIN NBACKSS, CR *) :BEGIN READ(KEYBOARD,CH) '.',BS,CR *) 0(* DECP=PUT-->NO '.' *) 0(* NOWSET-->NO 'CR'*) 0(* NOT ZERO-->0..9, '.',BS,CR *)  LABEL 1;  BEGIN  1:REPEAT $READ(KEYBOARD,CH) "UNTIL (CH IN ['0'..'9','.',CHR(BS)]) OR EOLN(KEYBOARD); " "IF DECP=PUT THEN IF CH='.' THEN GOTO 1; "IF NOWSET THENRUE 1END 1 "ELSE (* 1..9 *) BEGIN 4ASSIGN1; 4ZERO:=FALSE 2END "  END(* S2 *);   PROCEDURE S3;  BEGIN "CASE ZERO OF TRUE:BEGIN 6REPEAT (* BS,CR *) 8READ(KEYBOARD,CH) 6UNTIL (CH=CHR(BS)) OR EOLN(KEYBOARD); 6 6IF EOLN(KEYBOARD) THEN CR " "IF CH='0' THEN BEGIN 3ASSIGN2; 3ZERO:=TRUE 1END 1 "ELSE IF CH IN ['1'..'9'] THEN BEGIN BASSIGN2; BZERO:=FALSE @END " "ELSE (* BS *) BEGIN 2BACKSP1 0END  END(* S1 *);   PROCEDURE S2;  BEGIN "IF CH='0' THEN BEGIN 3ASSIGN1; 3ZERO:=T8KETA:=KETA+1; 8NEST:=NEST+1 6END 6 "ELSE (* 0..9 *) BEGIN 4SIGN:=PLUS; 4SETSIGN:=FALSE; 4KETA:=KETA+1; 4NEST:=NEST+2 2END  END(* S0 *);   PROCEDURE S1; (* 0..9, BS *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL CH IN ['0'..'9', CHR(BS)]; BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL CH IN ['0'..'9', '+', '-']; " "IF CH='+' THEN BEGIN 3WRITE(CH); 3SIGN:=PLUS; 3SETSIGN:=TRUE; 3KETA:=KETA+1; 3NEST:=NEST+1 1END 1 "ELSE IF CH='-' THEN BEGIN 8WRITE(CH); 8SIGN:=MINUS; 8SETSIGN:=TRUE; BEGIN "WRITE(CH); "BUFFER[KETA]:=CH; "KETA:=KETA+1; "NEST:=NEST+1  END(* ASSIGN1 *);   PROCEDURE ASSIGN2;  BEGIN "WRITE(CH); "BUFFER[KETA]:=CH; "KETA:=KETA+1; "NEST:=NEST+2  END(* ASSIGN1 *);     PROCEDURE S0; (* 0..9, '+', '-' *)  EST-3 )END "END  END(* BACKSP *);   PROCEDURE CR;  BEGIN "BUFFER:=COPY(BUFFER,1,KETA-1); " "CASE SIGN OF PLUS:; / /MINUS:BUFFER:=CONCAT('-',BUFFER) "END(* CASE *); "VALLONG(BUFFER,X); "EXIT(INPUTLONG) END(* CR *);   PROCEDURE ASSIGN1;  "NEST:=NEST-1  END(* BACKSP *);   PROCEDURE BACKSP2;  BEGIN "(* CRT *) "WRITE(CHR(BS)); WRITE(' '); WRITE(CHR(BS)); " "(* NUMBER *) "CASE SETSIGN OF $ $TRUE:BEGIN +KETA:=KETA-1; +NEST:=NEST-2 )END; ) #FALSE:BEGIN +KETA:=KETA-2; +NEST:=N------------------------------------------------------------ "'BACKSP1', 'BACKSP2', 'CR','ASSIGN1', 'ASSIGN2','S0'---'S5' *)  PROCEDURE BACKSP1;  BEGIN "(* CRT *) "WRITE(CHR(BS)); WRITE(' '); WRITE(CHR(BS)); " "(* NUMBER *) "KETA:=KETA-1; ---------------------- " 'SUBMAIN' *) "  CONST "BS=8;  VAR "BUFFER :STRING; "CH :CHAR; "ZERO :BOOLEAN; "SIGN :(PLUS,MINUS); "KETA :INTEGER; "NEST :INTEGER; "SETSIGN:BOOLEAN; "  PROCEDURE SUBMAIN(VAR NEST:INTEGER);  (*-----------:=NOTYET; "NOWSET:=FALSE; "BUFFER:=  '000000000000000000000000000000000000000000000000000000000000000000000000000'; "SUBMAIN(NEST)  END(* INPUTREAL *);  (*$G-*)      PROCEDURE INPUTLONG;   (*----------------------------------------------- (*--------- SUBMAIN ------------*)  BEGIN "IF NEST=0 THEN S0 "ELSE IF NEST=1 THEN S1 "ELSE IF NEST=2 THEN S2 "ELSE IF NEST=3 THEN S3 "ELSE S4; " "SUBMAIN(NEST)  END;    (*--------- INPUTREAL ----------*)  BEGIN "KETA:=0; "NEST:=0; "DECPWSET THEN IF EOLN(KEYBOARD) THEN GOTO 1; $ $NOWSET:=FALSE; $ $IF EOLN(KEYBOARD) THEN CR $ELSE IF CH='.' THEN BEGIN :ASSIGN1; :DECP:=PUT; :NOWSET:=TRUE 8END $ELSE IF CH=CHR(BS) THEN BACKSP1 $ELSE (* 0..9 *) ASSIGN1  END(* S4 *);   ASSIGN1  END(* S3 *);   PROCEDURE S4; (* DECP=PUT--> NO '.' *) 0(* NOWSET--> NO 'CR' *)  LABEL 1;  BEGIN "1:REPEAT &READ(KEYBOARD,CH) $UNTIL (CH IN ['0'..'9','.',CHR(BS)]) OR EOLN(KEYBOARD); $ $IF DECP=PUT THEN IF CH='.' THEN GOTO 1; $IF NO IF EOLN(KEYBOARD) THEN GOTO 1; "IF ZERO THEN IF (CH IN ['0'..'9']) THEN GOTO 1; " "NOWSET:=FALSE; " "IF EOLN(KEYBOARD) THEN CR "ELSE IF CH='.' THEN BEGIN 8ASSIGN1; 8DECP:=PUT; 8NOWSET:=TRUE 6END "ELSE IF CH=CHR(BS) THEN BACKSP2 "ELSE (* 0.9 *)6 6ELSE (* BS *) BEGIN FBACKSP2 DEND 4END; 4 /FALSE:BEGIN (* 0..9, BS, CR *) 7REPEAT 9READ(KEYBOARD,CH) 7UNTIL (CH IN ['0'..'9', CHR(BS)]) OR EOLN(KEYBOARD); 7 7IF EOLN(KEYBOARD) THEN CR 7 7ELSE IF (CH IN ['0'..'9']) THEN BEGIN WASSIGN1 UEND 7ELSE (* BS *) BEGIN GBACKSP2 EEND 5END E "END(* CASE *)  END(* S3 *); 4  PROCEDURE S4; (* 0..9, BS, CR *)  BEGIN "REPEAT $READ(KEYBOARD,CH) "UNTIL (CH IN ['0'..'9', CHR(BS)]) OR EOLN(KEYBOARD); " "IF EOLN(KEYBOARD) THEN CR ('ENTER SHORT MESSAGE:ANY KEY TO STOP':37); #READLN(S); #SNAIL(39,12);  END. (*PROGRAM*) /X:= 39; (*RESTART LINE AT RT*) ,END; (*IF*) 'END; (*LOOP*) $UNTIL KEYPRESS; $READ(KEYBOARD,ANYCHAR); #END; (*SNAIL*) #  BEGIN (*MAIN*) #WRITELN(CHR(12)); (*CLEARSCREEN*) #WRITELN  ('WRITES A MIRROR IMAGE MESSAGE':34); #WRITELN HAR COUNTER*) 'L:= LENGTH(S); 'FOR I:= 1 TO L DO (BEGIN *GOTOXY(X,Y); *WRITE(S[N]); *DELAY(300); *N:= N+1; *IF (LZ) THEN (*EMULATE PEEK(36) IN BASIC*) 9(*FOR RT.MALAY(X:INTEGER); &VAR I:INTEGER; (*LOOP INDEX VAR*) #BEGIN &FOR I:= 1 TO X DO #END; (*DELAY*) # #PROCEDURE SNAIL(X,Y,Z:INTEGER);(*Z=RT.MARGIN PARAMETER*) &VAR I:INTEGER; (*LOOP INDEX VAR*) &L,N:INTEGER; #BEGIN &REPEAT (N:= 1; (*INITIALIZE TO STAPROGRAM SLOMESSAGE;  (*REPEATS SHORT STRING AT SLOW SPEED,LINE  AFTER LINE.ABORT BY KEYPRESS.BY MAX J.NAREFF  SAN FRANCISCO,CA.8/80*)  #USES APPLESTUFF; (*FOR KEYPRESS FUNCTION*) #VAR &S:STRING; &ANYCHAR:CHAR; (*REPEAT CONTROL*) & #PROCEDURE DEPROGRAM PALINDROME;  (*USES A PALINDROME IN TABBING EXERCISES.  BY MAX J.NAREFF,SAN FRANCISCO,CA.8/80*) VAR &S:STRING; &ANYCHAR:CHAR; (*PROGRAM CONTROL*) &N:INTEGER; (*COUNTER*)  #PROCEDURE INTRODUCTION; #BEGIN )GOTOXY(0,5); )WRITELN  ('A PAN^x '  BEGIN (*MAIN*) #PAGE (OUTPUT); #INTRODUCTION; #SELECT;  END. (('SELECT TABDEMO BY LETTER':32); &WRITELN; &WRITELN &('[A] COLON AS TABBER':29); &WRITE &('[B] GOTOXY AS TABBER':30); &READ (KEYBOARD,ANYCHAR); 'CASE ANYCHAR OF ('A': COLONTABBER(10,17); ('B': GOTXYTABBER(10,1); 'END; (*CASE*) #END; (*SELECT*)N>L); &N:= 1; &X:= 28; (*REPOSITION WORD*) &Y:= 1; &REPEAT (GOTOXY(X,Y); (WRITELN(S[N]); (DELAY(500); (X:= X-1; (*MOVE CHAR <-*) (Y:= Y+1; (N:= N+1; &UNTIL (N>L); &ANOTHER; #END; (*GOTXYTABBER*) & #PROCEDURE SELECT; #BEGIN &WRITELN ABBER(X,Y:INTEGER); &VAR L:INTEGER; (*COUNTERS*) #BEGIN &PAGE (OUTPUT); &L:= LENGTH(S); &N:= 1; (*INIT STRING CHAR COUNT*) &REPEAT (GOTOXY(X,Y); (WRITELN(S[N]); (DELAY(500); (X:= X+1;(*MOVE CHAR ->*) (Y:= Y+1; (N:= N+1; (*NEXT CHAR*) &UNTIL (; (*INCREMENT COUNTER*) &UNTIL (X>18); &WRITELN(S[N]:X); &N:= N+1; &P:= 18; &X:= 1; &REPEAT (WRITE(S[N]:P); (DELAY(1000); (WRITELN('':X,S[N]); (N:= N+1; (X:= X+2; (P:= P-1; &UNTIL (X>18); &ANOTHER; #END; (*COLONTABBER*) 1 #PROCEDURE GOTXYT(SELECT; #END; (*ANOTHER*) # #PROCEDURE COLONTABBER(X,P:INTEGER); #BEGIN &PAGE (OUTPUT); &N:= 1; (*INIT STRING CHAR COUNT*) &REPEAT (WRITE(S[N]:X); (*LEFT*) (DELAY(1000); (WRITELN('':P,S[N]); (*RIGHT*) (X:= X+1;P:= P-2; (*MOVE CHARS*) (N:= N+1I:= 1 TO X DO; #END; (*DELAY*) ( #PROCEDURE SELECT; FORWARD; ( #PROCEDURE ANOTHER; #BEGIN &GOTOXY(0,23); &WRITE  (' TO LEAVE: TO RETURN TO MENU':39); &READ(KEYBOARD,ANYCHAR); &IF (ANYCHAR= CHR(27)) THEN (EXIT (PROGRAM) &ELSE EREISAWELBA'; )WRITE #(' TO CONTINUE: TO LEAVE':36); )READ(KEYBOARD,ANYCHAR); )IF (ANYCHAR=CHR(27)) THEN +EXIT (PROGRAM) )ELSE +PAGE (OUTPUT); #END; (*INTRO*) + #PROCEDURE DELAY(X:INTEGER); &VAR I:INTEGER; (*LOOP INDEX*) #BEGIN &FOR LINDROME IS USED TO DEMO METHODS OF'); )WRITELN ,('TABBING OUTPUT.':27); )WRITELN; )WRITELN  ('THE RESULTING OUTPUT IS THE SAME THOUGH'); )WRITELN('THE TABS DIFFER.':27); )WRITELN; )WRITELN &('"ABLEWASIEREISAWELBA"':28); )WRITELN; )S:= 'ABLEWASIPROGRAM BILLBOARDS;  (*EXERCISES IN TABBING OUTPUT TO SIMULATE  BILLBOARD DISPLAYS.BY M.NAREFF;S.F.8/80*)  #USES APPLESTUFF; (*FOR KEYPRESS FUNCTION*) #VAR &S:STRING; &ANYCHAR:CHAR; (*REPEAT CONTROL*) &L:INTEGER; (*LENGTH INDEX*) & #PROCEDURE INN^#WRITELN(CHR(12)); (*CLEARSCREEN*) #INTRODUCTION; #HOPPER(30,12); #CRAWLER(39,12); #GOTOXY(17,20); #WRITELN('THE END.');  END. (*PROGRAM*) LEFT 2 SPACES*) *ELSE ,X:= X-1; (*CREEP 1 SPACE TO LEFT*) *IF (X<1) THEN ,BEGIN /WRITE(CHR(12)); /X:= 39; (*RESTART LINE AT RT*) ,END; (*IF*) 'END; (*LOOP*) $UNTIL KEYPRESS; $READ(KEYBOARD,ANYCHAR); #END; (*CRAWLER*) #  BEGIN (*MAIN*) 'L:= LENGTH(S); 'P:= L; (*PEELS CHARS FROM S*) 'FOR I:= 1 TO L DO (BEGIN *GOTOXY(X,Y); (*INITIAL POSITION**) *WRITE(S[P]); *DELAY(750); *N:= N+1; *P:= P-1; (*PEELS CHARS R->L*) *IF (L*) #FOR I := 1 TO X DO &WRITE (CHR(Y)); #WRITELN  END; (*DRAWLINE*)   PROCEDURE LINESPACE (XPROGRAM DRAFTSMAN;  (*DRAWS LINES OF DIFFERENT TYPES. 2BY MAX J.NAREFF,3/81*)   VAR I : INTEGER; (*LOOP INDEX*) $A, B, C, D, E, F, G : INTEGER; (*ASCII VALUES*) $  PROCEDURE DRAWLINE (X:INTEGER;VAR Y:INTEGER);  BEGIN 'A := 94; (*ASCII FOR ^*) 'N^ END. #2-CLEAR SCREEN TOP TO LINE 10'); &READLN; &CLEARTO(10); &GOTOXY(0,18); &WRITELN('NOW ERASE THE BOARD.':30); &READLN; &WRITE(CHR(12)); #END; (*DEMO2*) &  BEGIN (*MAIN*) #INTRODUCTION; #DEMO1; #DEMO2; #GOTOXY(0,12); #WRITELN('THE END.':23); 'END; &WRITELN; &WRITELN $('DEMO #1-CLEAR SCREEN FROM LINE 10 DOWN'); &WRITELN('PRESS RETURN':26); &READLN; &CLEARFROM(10); &WRITELN('IT WORKS!':23); &WRITELN('PRESS RETURN TO':27); #END; (*DEMO1*) # #PROCEDURE DEMO2; #BEGIN &WRITELN  ('DEMO (' [3] CHR(29)-CLEARS TO END OF LINE'); &WRITELN; &WRITELN  ('PRESS RETURN TO CLEAR SCREEN & START':38); &READLN; &WRITE(CHR(12)); #END; (*INTRODUCTION*) & #PROCEDURE DEMO1; #BEGIN &FOR I:= 0 TO 18 DO 'BEGIN )WRITELN('LINE # ->':22,I:2); OF THREE'); &WRITELN  ('ASCII CHARACTERS ON SCREEN APPEARANCE.':39); &WRITELN  (' [1] CHR(12)-CLEARS ENTIRE SCREEN'); &WRITELN  (' [2] CHR(11)-CLEARS FROM CURSOR TO'); &WRITELN('END OF SCREEN':30); &WRITELN (GOTOXY(0,I); (CLEAREOL(I); 'END; (*DO*) #END; (*CLEARTO*) # #PROCEDURE INTRODUCTION; #BEGIN &WRITE(CHR(12)); (*CLEARSCREEN*) &GOTOXY(5,5); &WRITELN  ('A SCREEN CONTROL DEMONSTRATION');  WRITELN; &WRITELN  (' ILLUSTRATING THE EFFECTS %GOTOXY(0,LINE); %WRITE(CHR(11)); #END; (*CLEARFROM*) $ #PROCEDURE CLEAREOL(LINE:INTEGER); #BEGIN %GOTOXY(0,LINE); %WRITE(CHR(29)); #END; (*CLEAREOL*) $ #PROCEDURE CLEARTO(LINE:INTEGER); &VAR I:INTEGER; #BEGIN &FOR I:= 0 TO LINE DO 'BEGIN (2); #DRAWLINE (35,C); #LINESPACE (2); #DRAWLINE (40,D); #DRAWLINE (30,E); #LINESPACE (4); #DRAWLINE (20,F); #LINESPACE (2); #DRAWLINE (39,G)  END.  O^;VTAB(7); IS THE SAME # AS GOTOXY (5,7); #EX., VTAB(16);WRITE(' HELLO'); (VTAB(18);WRITE('TO YOU'); (TABUP(4);HTAB(2);WRITE('A'); $OUTPUT LOOKS LIKE: "A  HELLO % % TO YOU % !NOTE THAT A WRITELN IS EFFECTIVELY )TABDOWN(1); HT COMMANDS "  PROCEDURE VTAB (Y:INTEGER);  PLACES THE CURSOR AT THE ABSOLUTE "POSITION INDICATED BY THE VALUE Y "WHICH CAN RANGE FROM 0-23. THE "CURRENT HORIZONTAL POSITION IS "UNCHANGED (UNLIKE THE APPLESOFT VTAB "COMMAND). " EX., HTAB(5)"POSITION. IF ANYONE KNOWS HOW TO "MAKE THE CURSOR INVISIBLE DURING "SCREEN OUTPUT PLEASE TELL ME. #EX., HTAB(10);WRITE('CONTROL'); (HTAB(5);WRITE('CURSOR'); # #OUTPUT WOULD LOOK LIKE: %CURSORONTROL ( (CURSOR CONTROL BECAUSE "TO USE THE GOTOXY COMMAND BOTH EXACT "X AND Y COORDINATES MUST BE KNOWN. "THE RANGE OF X MUST BE 0-79. THIS "ROUTINE DOES NOT USE A POKE COMMAND. "THIS IS BECAUSE A WHITE SQUARE "WILL REMAIN AT THE PRIOR CURSOR ATIVE TO CURRENT POSITION. #EX., TABLEFT(10); # # # (CURSOR CONTROL COMMANDS %  PROCEDURE HTAB (X:INTEGER); "PLACES CURSOR AT THE ABSOLUTE "POSITION INDICATED BY THE VALUE X. "THE CURRENT VERTICAL POSITION REMAINS "UNCHANGED. THIS IS USEFULERTICAL CURSOR "POSITION (0-23). "  PROCEDURE TABUP(X:INTEGER);  PROCEDURE TABDOWN(X:INTEGER);  PROCEDURE TABRIGHT(X:INTEGER);  PROCEDURE TABLEFT (X:INTEGER); "SELF-EXPLANATORY. THERE IS NO RANGE "CHECKING BUILT-IN. TABS X NUMBER OF "SPACES REL&CLEAREOS; &WRITE (NAME);    (CURSOR CONTROL COMMANDS  FUNCTION HPOS: INTEGER; ! RETURNS THE CURRENT HORIZONTAL "CURSOR POSITION (0-79). #EX., CH := HPOS; GOTOXY ((HPOS+5),0); )  FUNCTION VPOS: INTEGER; "RETURNS THE CURRENT VIER TO TYPE.  HOMES CURSOR, AND CLEARS SCREEN.   PROCEDURE CLEAREOS; "CLEARS FROM CURRENT CURSOR POSITION  TO END OF SCREEN.   PROCEDURE CLEAREOL; "CLEARS FROM CURRENT CURSOR POSITION  TO END OF LINE.   !EX., GOTOXY (10,10); ELN'S.  %THE UNIT IS FOR USE WITH THE 40  COLUMN VIDEO SCREEN ONLY. IT CAN BE  CHANGED FOR USE WITH 80 COLUMN BOARDS  WITHOUT MUCH DIFFICULTY.  % (SCREEN CONTROL COMMANDS   PROCEDURE HOME; "EXACTLY LIKE A PAGE (OUTPUT) "COMMAND, JUST EAS  DESIRE TO MODIFY THEM.  %THE PROCEDURES INCLUDED ALLOW FOR  CURSOR CONTROL, FORMATTING OF STRING  VARIABLES OR CONSTANTS, FORMATTING OF  LONG INTEGERS, AND EASY USE OF LONG  SECTIONS OF PROSE WITHIN A PROGRAM  WITHOUT USING INNUMERABLE WRIT.FORMATSTUFF  %THIS SYSTEM.LIBRARY UNIT CAN BE  INVOKED WITH THE 'USES FORMATSTUFF;'  STATEMENT IN THE DECLARATION PORTION  OF YOUR PROGRAMS. THE ROUTINES ARE IN  P-CODE AND THE SOURCE CODE IS INCLUDED  ON THIS DISK AS 'FORMAT.UNIT', IF YOU AB(0); ' 'STRING FORMATTING COMMANDS %  PROCEDURE FORMAT (CODE:STRING; LM,RM #:INTEGER; S:STRING); # "THE PROCEDURE TAKES A STRING "VARIABLE OR CONSTANT AND FORMATS IT "BETWEEN THE GIVEN LEFT AND RIGHT "MARGINS ACCORDING TO THE CODE AS "FOLLOWS : "  'LJ' LEFT JUSTIFIED. LIKE A WRITELN %ONLY THE LINE WILL BE PLACED %WITHIN THE MARGINS BROKEN AT %NATURAL SPACES (FILLING).  'RJ' AS ABOVE ONLY RIGHT JUSTIFIED %WITHIN THE MARGINS.  'CN' AS ABOVE ONLY EACH SEGMENT OF %THE BROKEN UPHAS CERTAIN  ADVANTAGES IN THAT YOUR TEXT IS EASY  TO EDIT IN FUTURE REVISIONS OF YOUR  PROGRAM. 'PROSE FORMATTING COMMANDS %  IF YOU ARE CONFUSED, THEN LOOK AT THE "FILE 'DOCUMENT.TEXT' ON THIS DISK. "IT IS THAT FILE WHICH IS CURRENTLY "BEING D EDITOR IS  USED FOR THE >EDIT: PROMPT, ONLY 23  LINES OF TEXT ARE SEEN AT ONE TIME.  THIS MAKES IT EASY TO USE THE

KEY  TO FLIP THROUGH THE TEXT AND SEE  EXACTLY WHAT WILL BE PRINTED OUT BY  FORMPROSE (INSTRUCT.TEXT);   USING THE EDITOR  A SET OF INSTRUCTIONS FOR A PROGRAM  THEN CREATE A FILE CALLED &INSTRUCT.TEXT (OR WHATEVER)  USING THE PASCAL EDITOR. I SUGGEST  SETTING THE ENVIRONMENT TO FORMAT THE  TEXT (FILLING=TRUE, LEFT=0, RIGHT=39,  ETC.).   SINCE THE TOP LINE IN THEES "AT A TIME. THE 24TH LINE IS USED TO "ASK TO CONTINUE OR ABORT. "THE TEXT IS DISPLAYED TO THE SCREEN "JUST AS YOU TYPED IT IN USING THE "EDITOR. %PROSE FORMATTING COMMANDS %  FOR INSTANCE, IF YOU WANT TO CREATE (FILENAME); " "THIS PROCEDURE OPENS A TEXTFILE ON "THE DISK CALLED 'FILENAME', WHERE "FILENAME IS OF THE FORM : )#4:EXAMPLE.TEXT %MYDISK:INSTRUCTIONS +*PAGEONE.TEXT ETC. "THE TEXT WITHIN THIS FILE IS READ "AND PRINTED TO THE SCREEN 23 LIN4,567- % % % %PROSE FORMATTING COMMANDS %  SINCE STRING VARIABLES ARE LIMITED TO  80 CHARACTERS WHEN TYPING FROM THE  KEYBOARD, THE DEVELOPMENT OF  PARAGRAPHS SUCH AS THESE ARE TEDIOUS  AND INVOLVE NUMEROUS WRITELN'S.   PROCEDURE FORMPROSE&USES FORMATSTUFF; &VAR D : INTEGER[20]; +M : STRING; &BEGIN 'D := -123456789; 'STR (D,M); 'FORMAT('$.',10,25,M); 'FORMAT('$',10,25,M); 'FORMAT('#',10,25,M); &END. ' !OUTPUT LOOKS LIKE: ! % $ 1,234,567.89- % $ 1,234,567- 01,23Y THE DECIMAL 'POINT AND TWO LAST DIGITS ARE 'PRINTED. "'#' AS ABOVE, ONLY NO DOLLAR SIGN. "'#.' AS ABOVE, ONLY NO DOLLAR SIGN, 'DECIMAL POINT AND LAST 2 DIGITS 'ARE DISPLAYED. " %LONG INTEGER FORMATTING COMMANDS % !EX., &PROGRAM MONEY; S COMMAS AT EVERY THIRD 'NUMERIC POSITION. PLACES A 'DOLLAR SIGN AT THE GIVEN LEFT 'MARGIN AND RIGHT JUSTIFIES THE 'NUMBER. THE LAST TWO DIGITS, 'PRESUMABLY CENTS, ARE NOT 'PRINTED. NEGATIVE SIGNS ARE 'PLACED AT THE END. "'$.' AS ABOVE, ONL * %******************************    #LONG INTEGER FORMATTING COMMANDS  "FIRST, THE LONG INTEGER SHOULD BE "CONVERTED TO A STRING VARIABLE USING "THE BUILT-IN STR PROCEDURE. THE "FOLLOWING 'FORMAT' CODES ARE USED: " "'$' INSERT EX., TITLE := '@CHECKBOOK@MAIN MENU@'; %FORMAT ('EN',5,34,TITLE); % !OUTPUT LOOKS AS FOLLOWS: ! %****************************** %* * %* CHECKBOOK * %* MAIN MENU * %* FORMATTING COMMANDS $  IF THE STRING VARIABLE OR CONSTANT  PASSED TO THE PROCEDURE CONTAINS THE  CHARACTER '@', THEN A FORCED END OF  LINE OCCURS, THE STRING FOLLOWING THE  @ CHARACTER IS THEN FORMATTED AS PER  THE PASSED PARAMETERS.  PLE GROUPIES';  FORMAT('LJ',5,20,NAME);  %SUNCOAST TAMPA %APPLE GROUPIES % %  FORMAT('EN',0,39,NAME);   ****************************************  * SUNCOAST TAMPA APPLE GROUPIES *  ****************************************   &STRING STRING WILL BE %CENTERED. USEFUL FOR TITLE %PAGES, PAGE NUMBERS, ETC. ( ( (STRING FORMATTING COMMANDS (  'EN' JUST LIKE 'CN' COMMAND EXCEPT THE %ENTIRE STRING IS ENCLOSED IN A %BORDER OF ASTERISKS. ( # #EXAMPLES: #  NAME:='SUNCOAST TAMPA APISPLAYED. !  OTHER ADVANTAGES INCLUDE NOT HAVING TO "COMPILE LENGTHY INSTRUCTIONS ALONG "WITH YOUR NON-TEXT CODE. OBJECT "CODE COULD BE DISTRIBUTED WITH THE "INSTRUCTIONS REMAINING IN TEXTFILES. "  FORMPROSE INCLUDES AN IO ERROR TRAP "AND DISPLAYS APPROPRIATE MESSAGES "ACCORDING TO IORESULT. ! ! ! ! ! ! ! (SUGGESTED MODIFICATIONS (  I OFFER THIS PROGRAM IN ITS ROUGH STATE  TO ENCOURAGE OTHERS TO EXAMINE THE CODE  AND TO LEARN FROM IT OR TO MODIFY IT.   I WOULD LIKE TER AND ENCLOSE WITHIN A BORDER OF ASTERISKS'; $WRITE (' 4.''EN'' = '); $FORMAT ('CN',10,39,S1); $WRITELN(' 5.''$ '' = $ 1,234'); $WRITELN(' 6.''$.'' = $ 1,234.56'); $WRITELN(' 7.''# '' = 1,234'); $WRITELN(' 8.''#.'' = 1,234.56'); $CASE@'' TO FORCE LINE BREAKS IN OUTPUT'); $WRITELN; $READLN(SAMPLE); $WRITELN; $WRITELN('WHICH FORMAT CODE ?'); $WRITELN(' 1.''LJ'' = LEFT JUSTIFY'); $WRITELN(' 2.''RJ'' = RIGHT JUSTIFY'); $WRITELN(' 3.''CN'' = CENTER BETWEEN GIVEN MARGINS'); $S1:='CEN#FORMPROSE ('#4:DOCUMENT.TEXT'); "END; "  PROCEDURE TRYITOUT; "VAR SAMPLE, S1 :STRING; (LEFT,RIGHT :INTEGER; (CODE :STRING; !PROCEDURE PAGEONE; "BEGIN $HOME; $FORMAT ('CN',0,39,' - TYPE IN A STRING VARIABLE - '); $WRITELN('USE ''R OF CHOICE (',LOW,'-',HIGH,') '); #UNITCLEAR(1); #CLEAREOS; #READLN (NUMBER) ; "UNTIL (NUMCHECK(NUMBER,LOW,HIGH)); "NUMCHOICE := NUMBER; !END (* NUMCHOICE *); !(*$I+*) ! !PROCEDURE DOCUMENTATION; "BEGIN #HOME; HR(7)); )NUMCHECK := FALSE (END !END (* NUMCHECK *); ! !(*$I-*)  FUNCTION NUMCHOICE (LOW,HIGH:INTEGER):INTEGER; !VAR NUMBER :INTEGER; (CH,CV :INTEGER; !BEGIN "CH := HPOS ; "CV := VPOS ; "REPEAT #GOTOXY(CH,CV); #WRITE('TYPE NUMBEACE BAR> TO CONTINUE ':34); "UNITCLEAR(1); "READ(CH); "UNITCLEAR(1); "WRITELN !END (* WAIT *); !  FUNCTION NUMCHECK (NUMBER,LOW,HIGH:INTEGER):BOOLEAN; !BEGIN "IF ((NUMBER >= LOW) AND (NUMBER <= HIGH)) #THEN NUMCHECK := TRUE #ELSE BEGIN )WRITE(C PROGRAM FORMATDEMO ;   USES FORMATSTUFF;   VAR SAMPLE :STRING; (CODE :STRING; (LEFT,RIGHT :INTEGER; (S1 :STRING; (QUIT :BOOLEAN;   PROCEDURE WAIT; !VAR CH :CHAR; !BEGIN "GOTOXY(0,23); "WRITE('PRESS WIDTH) ,THEN IF (WIDTH > 4) 2THEN BEGIN 8INSERT('-',T,(LENGTH(T)-1)); 8DELETE(T,(LENGTH(T)-1),2); 8J := LENGTH(T) - 1 7END 2ELSE BEGIN 8T := COPY(T,1,WHEN BEGIN )BORDER := '*'; )FOR I := 2 TO WIDTH DO *BORDER := CONCAT(BORDER,'*'); )HTAB(LM); )WRITELN(BORDER); )WIDTH := WIDTH - 4; )IF WIDTH <1 THEN EXIT (FORMAT); (END; "S := CONCAT (S,'@'); "WHILE (LENGTH(S) > 0) DO #BEGIN $IF (LENGTH(S) > WI$THEN DELETE (T,POS('.',T),3); #WRITELN (T:RM+1) "END; " !BEGIN (* FORMAT *) "WIDTH := RM - LM +1; "IF WIDTH < 1 THEN EXIT(FORMAT); "IF (CODE[1] = '$') OR (CODE[1] = '#') #THEN BEGIN )FORMATNUMBER(S); )EXIT (FORMAT) (END; "IF CODE[1] = 'E' #T',T); +2 : T := CONCAT ('.',T); *END(*CASE*); #IF NEGATE $THEN T := CONCAT (T,'-') $ELSE T := CONCAT (T,' '); #IF CODE[1] = '$' $THEN BEGIN *HTAB(LM); *WRITE ('$'); *RM := RM - LM - 1 )END; #IF CODE[LENGTH(CODE)] <> '.' $ELSE NEGATE := FALSE; #TLEN := LENGTH(T); #IF TLEN > 2 $THEN BEGIN *INSERT ('.',T,TLEN-1); *I := 4; *WHILE ((TLEN-I)>1) DO +BEGIN ,INSERT (',',T,TLEN-I); ,I := I + 3 +END; )END $ELSE CASE TLEN OF +0 : T := '.00'; +1 : T := CONCAT ('.0WHILE (T[LENGTH(T)] <> ' ') DO ,DELETE (T,LENGTH(T),1); *T[LENGTH(T)] := '@'; )END; "END; !PROCEDURE FORMATNUMBER (T:STRING); "VAR TLEN,I :INTEGER; )NEGATE :BOOLEAN; "BEGIN #IF T[1] = '-' $THEN BEGIN *NEGATE := TRUE; *DELETE (T,1,1) )END(BORDER :STRING; !PROCEDURE CHECKFORBREAK; "BEGIN #I := POS('@',T); #IF I <> 0 $THEN BEGIN *DELETE(T,I,LENGTH(T)-I+1); *J := LENGTH(T) + 1; )END $ELSE J := LENGTH(T); "END; !PROCEDURE FINDLASTSPACE; "BEGIN #IF POS(' ',T) <> 0 $THEN BEGIN *; !  PROCEDURE VTAB ; !BEGIN "GOTOXY (HPOS,Y) !END; !  PROCEDURE SKIP ; !VAR M:INTEGER; !BEGIN FOR M := 1 TO N DO WRITELN END; ! (*$R-*)  PROCEDURE FORMAT ;  VAR T :STRING; (WIDTH :INTEGER; (I,J :INTEGER; "CH := CHR(08); "FOR I := 1 TO X DO UNITWRITE(1,CH,1,0,12) !END; !  PROCEDURE TABRIGHT ; !VAR I :INTEGER; %CH :CHAR; !BEGIN "CH := CHR(28); "FOR I := 1 TO X DO UNITWRITE(1,CH,1,0,12) !END;   PROCEDURE HTAB ; !BEGIN "GOTOXY (X,VPOS) !ENDHR(31); "FOR I := 1 TO X DO UNITWRITE(1,CH,1,0,12) !END; !  PROCEDURE TABDOWN ; !VAR I :INTEGER; %CH :CHAR; !BEGIN "CH := CHR(10); "FOR I := 1 TO X DO UNITWRITE(1,CH,1,0,12) !END; !  PROCEDURE TABLEFT ; !VAR I :INTEGER; %CH :CHAR; !BEGIN !BEGIN VPOS := PEEK(245) END; !  PROCEDURE HOME; !BEGIN PAGE(OUTPUT) END; !  PROCEDURE CLEAREOS; !BEGIN WRITE(CHR(11)) END; !  PROCEDURE CLEAREOL; !BEGIN WRITE(CHR(29)) END; !  PROCEDURE TABUP ; !VAR I :INTEGER; %CH :CHAR; !BEGIN "CH := CRD CASE BOOLEAN OF /TRUE: (INT: INTEGER); /FALSE: (PTR:^PA); .END;  VAR CHEAT : MAGIC; !BEGIN "CHEAT.INT := ADDR; "PEEK := CHEAT.PTR^[0]; !END; !  FUNCTION HPOS; !BEGIN HPOS := PEEK(244) END; !  FUNCTION VPOS; S:STRING); "PROCEDURE FORMPROSE (FILENAME:STRING); "  IMPLEMENTATION "  (* PEEK FUNCTION WRITTEN BY DAN SOKOL *)  (* SEE I.A.C. APNOTES FOR POKE PROC. *)  FUNCTION PEEK(ADDR:INTEGER):INTEGER; !TYPE PA = PACKED ARRAY[0..1] OF 0..255; &MAGIC = RECO TABUP (X:INTEGER); "PROCEDURE TABDOWN (X:INTEGER); "PROCEDURE TABLEFT (X:INTEGER); "PROCEDURE TABRIGHT (X:INTEGER); "PROCEDURE HTAB (X:INTEGER); "PROCEDURE VTAB (Y:INTEGER); "PROCEDURE SKIP (N:INTEGER); "PROCEDURE FORMAT (CODE:STRING;LM,RM:INTEGER;IDTH); 8J := LENGTH(T) 7END; *END %ELSE BEGIN +T := S; +CHECKFORBREAK; *END; $DELETE (S,1,J); $CASE CODE[1] OF % 'L' : BEGIN 3HTAB(LM); 3WRITELN(T) 2END; ('R' : WRITELN(T:(1+RM)); ('C' : BEGIN 3HTAB ((WIDTH-LENGTH(T)) DIV 2 + LM); 3WRITELN(T) 2END; ('E' : BEGIN 3HTAB(LM); 3WRITE('*'); 3HTAB ((WIDTH-LENGTH(T)) DIV 2 + LM +2); 3WRITE(T); 3HTAB(RM); 3WRITELN('*') 2END; $END(*CASE*); #END; "IF CODE[1] = 'E' #THEN BEGIN )HTAB(LM)le *)   GOTOXY(9,18);  WRITE ('APPLE');  WRITELN ('(TABS 9 THEN PRINTS)':24);  WRITE ('APPLE':9);  WRITELN ('(ENDS PRINT AT COL. 9)':29);   END. (* program *) ELN ('WRITELN:':9,'GOTOXY':30);  FOR N:= 0 TO 10 DO $BEGIN &GOTOXY(35,N+4); &WRITELN(N); (* 1st char. at 35 *) $END;   GOTOXY(0,4); (* move cursor up/left *)  FOR N:= 0 TO 10 DO $BEGIN &WRITELN(N:5); (* max. field=5 *) $END;   (* string sampPROGRAM TABDEMO;   (* by A. Tyro *)  (* modified by G.W. *)   (*Demonstrates the difference between "the field tab of GOTOXY(X,Y) and the "WRITELN('':) *) " #VAR N : INTEGER; (* loop index *) #  BEGIN (* examples *)   WRITELN;  WRITN^ƠƠRMPROSE *); "(*$R+*)   BEGIN  END. )WRITELN('DESIGNATED FILE IS ''',FILENAME,''''); )WRITELN; )PAUSE; )EXIT(FORMPROSE) (END; "(*$I+*) "PAGE(OUTPUT); "REPEAT #READLN(PROSEID,S); #WRITELN(S); #IF PEEK(245) = 23 THEN PAUSE "UNTIL EOF(PROSEID); "CLOSE (PROSEID); "PAUSE !END (* FO DRIVE.'; )CASE I OF *10 : S:='SPECIFIED PROSE NOT ON DISK'; *7 : S:='ILLEGAL FILE NAME'; *5,9,2 : S:='SPECIFIED DISK DRIVE NOT ON-LINE'; )END (*CASE*); )WRITELN(CHR(7)); )WRITELN('I/O ERROR CODE #',(I)); )WRITELN(S); ); #IF CH = CHR(27) %THEN BEGIN +CLOSE(PROSEID); +EXIT(FORMPROSE) *END %ELSE PAGE(OUTPUT); "END; % !BEGIN (* FORMPROSE *) "(*$I-*) "RESET(PROSEID,FILENAME); "I := IORESULT; "IF I <> 0 #THEN BEGIN # S:= 'ERROR IN PROSE FILENAME OR DISK; )WRITELN(BORDER) (END;  END (* FORMAT *);   PROCEDURE FORMPROSE ; !VAR S :STRING; )CH :CHAR; )I :INTEGER; !PROCEDURE PAUSE; "BEGIN #GOTOXY (0,23); #WRITE(' TO CONTINUE, TO ABORT '); #READ(KEYBOARD,CH TABDEMO tore & go -AA TAX  A9 20 LDA #$20 -2C 15 BF BIT conflg -D0 0C BNE up -8A TXA -C9 41 CMP "A" -90 07 BCC up -C9 5B CMP "[" -B0 03 BCS up -69 20 ADC #$20 shift t7 no CMP ctrl-W -D0 16 BNE lc -A9 20 LDA #$20 -2C 15 BF BIT conflg -F0 09 BEQ sh -A9 10 LDA #$10 -2C 15 BF BIT conflg -F0 02 BEQ sh -A9 39 LDA #$30 -4D 15 BF sh EOR conflg -4C C5 D6 JMP s"3 A6 4C BE DA JMP freespace " "4 EB EA NOP (defeat -EA NOP lowercase -29 7F AND #$7F shift E Gon output)  5 BE D0 02 BNE no  A9 5B LDA "[" -C9 1e. Control-W is  required to escape from shift lock  mode.   Any other control key (of any key for  that matter) can be used for shift  control. Just change the constant to  whatever your heart desires.   Block Byte Change Comments  ER and  lower case characters.   Typing is notquite like a typewriter,  since thecontrol-W key is used as a  shift key. A single control-W causes  a single character upper case shift.  Two control-W's in a row will lock the  case into upper case, you can  now do so.   Use the Filepatch program listed below  and make the following changes to  System.Apple. Once you have booted  your Pascal system with this version  of the system, Pascal will display all  its messages in a mixture of UPP LOWER CASE FOR APPLE PASCAL  'by Stephen L. Billard '    Have you always wanted to be able to  use upper and lower case letters with  apple Pascal? With the help of the  Dan Paymar Lower Case Adapter and the  following patch to System.ApplN^J GC .צE&Save as :. ? 瓡צSave asצ[š C?/צTEXT#CODE#饀!׶WRITELN: GOTOXY ȡ #  ȡ  צAPPLE(TABS 9 THEN PRINTS)APPLE צ(ENDS PRINT AT COL. 9)"o lower case -AA TAX -AD 15 BF up LDA conflg -0A ASL -09 DF ORA #$DF -2D 15 BF AND conflg -8D 15 BF STA conflg -8A TXA -4C AA D6 JMP notk  X 8N^& 2DISP:= DISP+1; 2END; ,END; *IF DISP>I THEN ,HEXOUT(I,DISP); & END (ELSE *DISP:= DISP+8 &UNTIL STP; &I:= BLOCKWRITE(FIL,BUF,1,BLOCK); $UNTIL NOT YORN('ANOTHER BLOCK'); $CLOSE(FIL); "UNTIL NOT YORN('ANOTHER FILE');  END. " (HEXOUT(DISP,DISP+8); (NOTE(50,10); (IF GETLINE THEN *BEGIN *I:= DISP; *WHILE GET(CH,J,FN) DO ,BEGIN ,IF CH=':' THEN .BEGIN .DISP:= J; .I:= DISP; .END ,ELSE .IF CH='/' THEN 0STP:= TRUE .ELSE 0IF LENGTH(STR)<>0 THEN 2BEGIN 2BUF[DISP]:= J;NOTE(50,10); $READLN(FN); $RESET(FIL,FN); $REPEAT (* MODIFY A BLOCK *) &DISP:=0;  WRITE('BLOCK (DECIMAL): '); &NOTE(50,10); &READLN(BLOCK); &I:= BLOCKREAD(FIL,BUF,1,BLOCK); &STP:= FALSE; &REPEAT (* GET MODIFICATIONS *) := I; $IF DONE THEN &BEGIN &J:= J-1; &CH:= ST[I]; &END; $IF J>0 THEN &BEGIN &STR:= COPY(ST,1,J); &OPT:= HEXV(STR); $ END; $DELETE(ST,1,I); $END; "END; "BEGIN "HEXD:='0123456789ABCDEF'; "REPEAT (* PER FILE NAME *) $WRITE('FILE NAME: '); $LEAN; " STR:STRING; "BEGIN "CH:=' '; "IF LENGTH(ST)=0 THEN $GET:= FALSE "ELSE $BEGIN $GET:= TRUE; $I:= 1; $DONE:= FALSE; $OPT:= 0; $REPEAT &DONE:= NOT (ST[I] IN .['0'..'9','A'..'F']); &I:= I+1 $UNTIL DONE OR (I>LENGTH(ST)); $I:= I-1; $J$IF I MOD 8=0 THEN &BEGIN &IF I>0 THEN (WRITELN; &PRX(I); &WRITE(': '); &END; $PRX(BUF[I]); $WRITE(' '); $I:= I+1; $END; "WRITELN; "END;  FUNCTION GET(VAR CH:CHAR; -VAR OPT:INTEGER; -VAR ST:STRING):BOOLEAN;  VAR I,J:INTEGER;  DONE:BOO IF I>255 THEN $BEGIN $PRX(I DIV 256); $I:= I MOD 256; $END; "WRITE(HEXD[I DIV 16]); "WRITE(HEXD[I MOD 16]); "END;  PROCEDURE HEXOUT(I,J:INTEGER); "BEGIN "IF I MOD 8<>0 THEN $BEGIN $PRX(I); $WRITE(': '); $END; "WHILE I0; "END;  FUNCTION YORN(M:STRING):BOOLEAN;  VAR CH:CHAR; "BEGIN "REPEAT $NOTE(50,10); $WRITE(M,' (Y/N)? '); $READ(CH); $WRITELN; $UNITCLEAR(1) "UNTIL CH IN PROGRAM FILEPATCH;  (* BY STEPHEN L. BILLARD *)  (* FOR LOWER CASE CHANGES*)   USES APPLESTUFF;   VAR "BUF:PACKED ARRAY[0..511] OF 0..255; "TMP,FN,STR:STRING; "FIL:FILE; "BLOCK,DISP,VAL,I,J:INTEGER; "HEXD:PACKED ARRAY[0..15] OF CHAR; "STP:BOOO^[O^1ӤNYKEY TO SHIFT TO LEFTG&LEFTFINIRIGHT8.4ƂƂƂȍƂƂ.˄%Ƃ̂.Ƃ.ƂPƂ..TEXTUƂ.PƂƂ.á ƂƂƂצ*SYSTEM.WRK.TEXTPȡ-# 4B׶ A SPLIT SCREEN DEMOצLEFTצRIGHTKצ(TO SHIFT OUTPUT TO RIGHT, CNTRL/A+ANYKEY<A"~ SPLITSCR # #CHALKMARK (20); #WRITELN &('ANYKEY TO SHIFT TO LEFT':71); #READ (KEYBOARD,ANYCHAR); #UNITCLEAR (1); (*RETURN TO LEFT SCREEN*) #WRITELN &('LEFT','FINI':19,'RIGHT':56);  END.  WRITELN '('LEFT','RIGHT':75); ' #X := 20; (*INITIAL TABS*) #Y := 2; # #CHALKMARK (20); (*OUTPUTS 20 LINES*) #WRITELN !('TO SHIFT OUTPUT TO RIGHT, CNTRL/A+ANYKEY'); #READ (KEYBOARD,ANYCHAR); # #X := 60; (*READJUST TABS FOR RT SCREEN*) #Y := 2; PROCEDURE CHALKMARK (LINES:INTEGER); #VAR I :INTEGER;  BEGIN #FOR I := 1 TO LINES DO &BEGIN )GOTOXY(X,Y); )WRITELN ('#',I); )Y := Y+1; &END; (*LOOP*)  END; (*CHALK*)   BEGIN (*MAIN*) #PAGE (OUTPUT); #WRITELN '('A SPLIT SCREEN DEMO':29); #PROGRAM SPLITSCREEN;   (*DEMONSTRATES ONE METHOD OF WRITING,  SUCCESSIVELY, TO EACH OF THE TWO FORTY  COLUMN SCREENS. BY MAX J. NAREFF, 11/80*)   VAR #ANYCHAR :CHAR; #X,Y :INTEGER; (*FOR TABBING*) # !(*FORMATS & OUTPUTS DEMO LINES*) {$s+}  {SMARTERM routines to switch to see Apple's hi-res screen and}  {switch back. Also allows the cursor to be switched off or on}   UNIT SMARTERM; INTRINSIC CODE 16;   INTERFACE %PROCEDURE SEEHIRES; %PROCEDURE SEETEXT; %PROCEDURE CURSORO(**************************************)  (* *)  (* Program to modify the BIOS modules *) (* to work with Dan Paymar's lower *) (* case adapter for both input and *)  (* output. *)  (*N^a̡PASCAL1SYSTEM.WRK.CODE6 z|z6 b6 *,,PASCAL2:SYSTEM.SWAPDISKPASCAL1:SYSTEM.WRK.TEXT*SYSTEM.WRK.CODE[*]PASCAL2:SYSTEM.SWAPDISKa1 b1 c2 c7 4Z b^br PAS`b6 6 ^``Pb6 r  PASCAL1SYSTEM.WRK.CODE6 z|z6 b6 *,,PASCAL2:SYSTEM.SWAPDISKPASCAL1:SYSTEM.WRK.TEXT*SYSTEM.WRK.CODE[*]PASCAL2:SYSTEM.SWAPDISK %PROCEDURE SEEHIRES; %PROCEDURE SEETEXT; %PROCEDURE CURSORON; %PROCEDURE CURSOROFF; %  IMPLEMENTATION E ԍ֍br r b^br PAS`b6 6 ^``Pb6 r  BB SMARTERM  Procedure Cursoroff; %begin %write (chr(20),'c7')  end;   begin {dummy}  end. N; %PROCEDURE CURSOROFF; %  IMPLEMENTATION %  Procedure Seehires; %begin %write (chr(20),'a1')  end; %  Procedure Seetext; %begin %write (chr(20),'b1')  end;   Procedure Cursoron; %begin %write (chr(20),'c2') {underline cursor}  end;  *)  (* Author :Craig W. Vaughan *)  (* Date :April 5, 1980 *)  (* Revision :1.0 *)  (* *)  (* REVISED :LEE MEADOR *)  (* DATE :DECEMBER 28, 1980 *)  (* REVISION :1.1 (FOR PASCAL 1.1) *)  (* (NOTE: INPUT IS NOT SUPPORTED HERE *)  (* *)  (*$Copyright 1980 by Craig W. Vaughan *)  (* Permission is hereby granted for *)  PAGE(OUTPUT);(*BLANKS SCREEN*) "GOTOXY(12,12);(*SETS SHORT LINE IN CENTER OF SCREEN*) "WRITELN('MODE USE IN PASCAL'); "WAIT(05000); "WRITELN(HOME,ERASEOS); "WRITELN;WRITELN;WRITELN; "WRITELN('THE VIEWPORT IS ''50,200,30,160'''); "WRITELN;WRITELN$3: PENMODE:=VIOLET; $4: PENMODE:=BLUE; $5: PENMODE:=WHITE1; $6: PENMODE:=WHITE2 "END(*CASE*); "WRITELN;WRITELN('YOU SELECTED PENMODE ',SELECTED); "WAIT(3000); "WRITELN(HOME,ERASEOS);  END(*MODESELECT*); "  PROCEDURE HEADER;  BEGIN ('1) ORANGE'); "WRITELN('2) GREEN '); "WRITELN('3) VIOLET'); "WRITELN('4) BLUE '); "WRITELN('5) WHITE1'); "WRITELN('6) WHITE2'); "WRITELN;WRITE('ENTER YOUR CHOICE '); "READLN(SELECTED); "CASE SELECTED OF $1: PENMODE:=ORANGE; $2: PENMODE:=GREEN; PROCEDURE WAIT(TIME:INTEGER);  VAR DELAY:INTEGER;  BEGIN "FOR DELAY:=1 TO TIME DO;  END; "  PROCEDURE MODESELECT;  VAR SELECTED:INTEGER;  BEGIN "WRITELN(HOME,ERASEOS); "WRITELN('ENTER THE MENU NUMBER SHOWN FOR DESIRED MODE'); "WRITELN; "WRITELNPROGRAM GRAFTEST;   USES APPLESTUFF,TURTLEGRAPHICS;   TYPE INT=INTEGER;   VAR CH:CHAR; "MODE,DELAY:INT; "S:STRING[20]; "A:ARRAY[0..15] OF STRING[2]; "HOME,ERASEOS:CHAR; "PENMODE:SCREENCOLOR;(*TYPE SCREENCOLOR DEFINED IN TURTLEGRAPHICS*) "  N^סء(ptch,S); #block5; #CLOSE (ptch,LOCK);  END. % % ln); END; # %  BEGIN #PAGE(OUTPUT); #GOTOXY(0,10); #WRITE('Name of disk? >> '); #READLN (S); #IF POS (':',S) > 0 THEN %S := CONCAT (S,'SYSTEM.APPLE') #ELSE %S := CONCAT (S,':SYSTEM.APPLE'); #WRITELN; #WRITELN ('Updating ',S,'...'); #RESET #blk: PACKED ARRAY[0..511] OF 0..255; #blt,bln: INTEGER; #ptch : FILE; #S:STRING;  PROCEDURE block5;  #BEGIN %bln := 5; %blt := BLOCKREAD(ptch,blk,1,bln); %blk[171] := 176; %blk[172] := 002; %blk[410] := 000; %blt := BLOCKWRITE(ptch,blk,1,b (* duplication for non-commercial *)  (* purposes. *)  (* All other rights reserved. *)  (* *)  (**************************************)  PROGRAM lcpatch; VAR ('THE DISPLAY IS IN THE SELECTED COLOR '); "WRITELN (' THEN THE INVERSE OF THAT COLOR'); "WRITELN;WRITELN('MODES SHOWN ARE 2,5,10, AND 14'); "WRITELN (' ENTER OTHER DESIRED MODES WHEN ASKED'); "WRITELN;WRITELN('MODES ARE AS DESCRIBED'); "WRITELN(' ON PAGE 180A OF THE MANUAL'); "WAIT(30000); "WRITELN(HOME,ERASEOS);  END;   PROCEDURE MODESHOW(COUNT:INTEGER);  BEGIN 'S:='THIS IS MODE '; &TEXTMODE; &GOTOXY(5,2); &WRITELN(S,COUNT,CHR(16)); &WAIT(2000); &INITTURTLE; &MOVEASEOS); 'MODESELECT; 'MODESHOW(MODE); %END; %WRITELN(HOME,ERASEOS); #UNTIL MODE = 0;  END(*MAIN PROGRAM*). THER MODE'); %WRITELN;WRITELN(' ENTER THE MODE NUMBER WHEN PROMPTED'); %WRITELN;WRITELN('IF DONE ENTER 0...'); %GOTOXY(0,15); %WRITE('ENTER MODE NUMBER OR 0, THEN RETURN '); %READLN(MODE); %IF (MODE>0) AND (MODE<16) THEN %BEGIN 'WRITELN(HOME,ER*MOVES CURSOR TO HOME POSITION*) #HEADER; #MODESELECT; #MODE:=2; #MODESHOW(MODE); #MODE:=5; #MODESHOW(MODE); #MODE:=10; #MODESHOW(MODE); #MODE:=14; #MODESHOW(MODE); #REPEAT %WRITELN(HOME,ERASEOS); %WRITELN;WRITELN('IF YOU DESIRE TO ENTER ANY O#A[0]:=' 0';A[1]:=' 1';A[2]:=' 2'; #A[3]:=' 3';A[4]:=' 4';A[5]:=' 5'; #A[6]:=' 6';A[7]:=' 7';A[8]:=' 8'; #A[9]:=' 9';A[10]:='10';A[11]:='11'; #A[12]:='12';A[13]:='13';A[14]:='14'; #A[15]:='15'; #ERASEOS:=(CHR(12));(*ERASES SCREEN*) #HOME:=CHR(25);(TO(72,90); &VIEWPORT(50,200,30,160); &FILLSCREEN(PENMODE); &CHARTYPE(COUNT); &S:=CONCAT(S,A[COUNT]); &WSTRING(S); &WAIT(2700);; &FILLSCREEN(REVERSE); &WAIT(2200); $TEXTMODE; "END(*MODESHOW*);    BEGIN(*MAIN PROGRAM*)