`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$J1 &N^ALU.TEXTuAMTOFDEPRE.TEXTuADDFRACTNS.TEXT֠ PRINT.TEXTE^oPRINT.HOWTO.USE DEMOPIC.TEXT^o DISKDISP.CODE^oY PRINT.CODEE^oEXToHrzINTERVALS.TEXTofzSHOPNSAVE.TEXToءCREDITOPTN.TEXTYTRIANGLES.TEXToETANGTABLE.TEXToETRIGCHART.TEXTo LOANTERM.TEXT^oeREGPAYMENT.TEXTeREMBALANCE.TEXTuFUTUREV48 STARS.TEXTE^o8>MIRRORIMAG.TEXT>DSLOMESSAGE.TEXTDLPALINDROME.TEXThLTBILLBOARDS.TEXTxTX ERASERS.TEXT^oX^ ERASERS1.TEXT^o^fWINDCHILL.TEXToflWINDTEMPS.TEXTolrOTHERWIND.TPSCAL23$ DISKDISP.TEXT^oFIXCOMPARE.TEXT8 LINEFEED.TEXT^ox  GRAPH1.TEXT^o $ GRAPH2.TEXT^o$( SQUARES.TEXT^o(, HEXAGONS.TEXT^o,0 GRAFPROC.TEXT^o04 HEXAGON2.TEXT^o&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`&PROGRAM DISC;  "(* STEVE LLOYD *) "(* CONTRIBUTED TO THE S.F. APPLE CORE *) "   VAR BUFFER : PACKED ARRAY[0..4095] OF CHAR; $UNIT0,DRIVE,BLOCK0,BLOCK1 : INTEGER; $USRBLK,DSKBLK,BUFBLK : INTEGER; $I,J,K,L,M,N : INTEGER; $QUIT,FIRST,FLAG : BO 0; $ USRBLK := 0; &END; $UNITREAD(UNIT0,BUFFER,4096,DSKBLK); $WHILE IORESULT<>0 DO &BEGIN &PAGE(OUTPUT); &WRITELN('PLEASE CHECK DISK. ERROR IN READING DISK.'); &UNITREAD(UNIT0,BUFFER,4096,DSKBLK); " END; $END; "END;  END; (* SHOW *) "  ; &WRITELN('PRESS: SPACE BAR to continue ESC to terminate'); &READ(INPCH); &END; $END;  "USRBLK := USRBLK + 1; "BUFBLK := BUFBLK + 1; "IF BUFBLK=8 THEN $BEGIN $BUFBLK := 0; $DSKBLK := DSKBLK + 8; $IF DSKBLK=280 THEN &BEGIN $ DSKBLK := VAR ESCAPE : CHAR;   BEGIN  ESCAPE := CHR(27);  INPCH := ' ';  BUFBLK := (USRBLK - DSKBLK);  WHILE INPCH<>ESCAPE DO "BEGIN $(* 2 SCREENS 256 BYTES PER SCREEN *) $FOR K := 0 TO 1 DO $BEGIN $IF INPCH<>ESCAPE THEN &BEGIN &SHOWBUF; &WRITELN); " "(* ASCII DUMP *) "FOR J := 0 TO 15 DO $BEGIN $N := OFFSET + J; $M := ORD(BUFFER[N]); $IF M>127 THEN M := M - 128; $IF (M>31) AND (M<127) THEN &WRITE(CHR(M)) ELSE (WRITE('!'); $END; "WRITELN; "END;  END;    PROCEDURE SHOW;  60,3); WRITELN('==========');   FOR I := 0 TO 15 DO "BEGIN "INDEX := K*256 + I*16; "WRITE(INDEX:4,' : '); "OFFSET := BUFBLK*512 + INDEX; " "(* HEX DUMP *) "FOR J := 0 TO 15 DO $BEGIN $N := OFFSET + J; $HEX(ORD(BUFFER[N])); $END; "WRITE(' 'HEADER *)  WRITELN('UNIT = ',UNIT0,' BLOCK = ',USRBLK);  WRITELN;  GOTOXY(0,2); WRITE('INDEX');  GOTOXY(23,2); WRITE('HEX DUMP');  GOTOXY(60,2); WRITE('ASCII DUMP');  GOTOXY(0,3); WRITE('====');  GOTOXY(23,3); WRITE('========');  GOTOXY( B := N-A*16;  IF (A>=0) AND (A<=15) THEN "WRITE(CHS[A+1]) ELSE $WRITE('?');  IF (B>=0) AND (B<=15) THEN "WRITE(CHS[B+1]) ELSE $WRITE('?');  WRITE(' ');  END; (* HEX *)    PROCEDURE SHOWBUF;   BEGIN  PAGE(OUTPUT);   (* DISPLAY SCREEN LK); "IF IORESULT<>0 THEN QUIT := TRUE; "END;   END; (* GETBUF *)    PROCEDURE HEX(N : INTEGER);  (* DISPLAY N AS A HEX STRING *)   VAR A,B : INTEGER; $CHS : STRING[16]; $  BEGIN  CHS := '0123456789ABCDEF';  A := TRUNC(N/16); END; "DSKBLK := 8 * TRUNC(USRBLK/8); " "UNIT0 := 0; "WHILE (UNIT0<>4) AND (UNIT0<>5) DO $BEGIN $WRITE('WHICH DRIVE <1..2> '); $READLN(UNIT0); $IF UNIT0=1 THEN UNIT0 := 4; $IF UNIT0=2 THEN UNIT0 := 5; " END; " "UNITREAD(UNIT0,BUFFER,4096,DSKBH); $IF (INPCH='Y') OR (INPCH='y') THEN &FLAG := TRUE ELSE (FLAG := FALSE; $WRITELN; $END;  END;   IF FLAG THEN "BEGIN "USRBLK := -1; "WHILE (USRBLK<0) OR (USRBLK>279) DO $BEGIN $WRITE('ENTER BEGINING BLOCK <0..279> '); $READLN(USRBLK); " WRITELN;  END;    PROCEDURE GETBUF;   BEGIN   IF NOT(FIRST) THEN "BEGIN "INPCH := ' '; "WHILE (INPCH<>'Y') AND (INPCH<>'y') AND (INPCH<>'N') AND (INPCH<>'n') DO $BEGIN $WRITE('DO YOU WISH TO LOOK AT ANOTHER BLOCK ? '); $READ(INPCN('The output will begin with the specified block and continue');  WRITELN('to the end of the disk. You may terminate the listing at the ');  WRITELN('end of a screen simply by pressing ESC. To continue listing ');  WRITELN('press the SPACE BAR.'); both ASCII and HEX format.');  WRITELN('The ASCII format displays only the printable chaRacters, con-');  WRITELN('verting all others to a "!". The HEX format converts every ');  WRITELN('byte to its equivalent hexidecimal form.');  WRITELN;  WRITELOLEAN; $OFFSET,INDEX : INTEGER; $INPCH,CH : CHAR; $  PROCEDURE PROMPT;   VAR INPCH : CHAR;   BEGIN  PAGE(OUTPUT);  WRITELN('This program allows access to any block on either of the disks.');  WRITELN;  WRITELN('It displays the information in BEGIN  FIRST := TRUE;  FLAG := TRUE;  QUIT := FALSE;  PROMPT;  GETBUF;  FIRST := FALSE;  WHILE FLAG AND NOT(QUIT) DO "BEGIN "SHOW; "PROMPT; "GETBUF; "END;  IF QUIT THEN "BEGIN "PAGE(OUTPUT); "WRITELN('PLEASE CHECK DISK. ERROR IN READING DISK.'); "WRITELN; "WRITELN('Press RETURN to return to system.'); "READLN; "END;  END. (* DISC *)  " ITELN('CAN''T RECOGNIZE LONG INTEGER UNIT IN SEGMENT ',I) *ELSE *WRITELN('CAN''T RECOGNIZE LONG INTEGER UNIT IN SEGMENT ',I) (END &END; $IF NOTFOUND THEN WRITELN('NO LONG INTEGER UNIT FOUND') &ELSE WRITELN('PROGRAM COMPLETE'); "END. " " (DATA[494] := 240; (IF BLOCKWRITE(F,DATA,1,J)=1 THEN *WRITELN('PATCH COMPLETE') ELSE ,WRITELN('ERROR WHILE WRITING PATCHM SEGMENT ',I); (END ( ELSE *IF DATA[4494]=240 THEN ,WRITELN('SEGMENT ',I,' - LONG INTEGER HAS ALREADY BEEN FIXED') ,ELSE ,WR[I]='LONGINTI' THEN $BEGIN $NOTFOUND := FALSE; $J := BLOCKZERO.DINFO[I].DADDR +1; $IF BLOCKREAD(F,DATA,1,J)<>1 THEN READERROR; $IF DATA[495]=244 THEN &IF DATA[494]=208 THEN (BEGIN " WRITELN('LONG INTEGER PATCH BEING MADE'); ROGRAM);  END;    BEGIN  NOTFOUND := TRUE;  REPEAT "WRITE('NAME OF LIBRARY FILE : '); "READLN(S); "RESET(F,S); "UNTIL EOF OR (IORESULT=0);  IF BLOCKREAD(F,BLOCKZERO,1,0)<>1 THEN READERROR;  FOR I := 0 TO 15 DO "BEGIN "IF BLOCKZERO.SEGNAME..416] OF INTEGER; .END; %BLOCK = PACKED ARRAY[0..511] OF 0..255; %  VAR I,J : INTEGER; $NOTFOUND : BOOLEAN; $F : FILE; $S : STRING; $BLOCKZERO : SEGDIC; $DATA : BLOCK; $  PROCEDURE READERROR;   BEGIN  WRITE('BAD BLOCK IN LIBRARY');  EXIT(P(*I-*)  PROGRAM FIXCOMPARE;   TYPE DISKINFO = RECORD # DADDR : INTEGER; 0LENG : INTEGER; 0END; %NAME = PACKED ARRAY[1..8] OF CHAR; %SEGDIC = RECORD .DINFO : ARRAY[0..15] OF DISKINFO; .SEGNAME : ARRAY[0..15] OF NAME; .FILER : ARRAY[1N^88N^x(* PSUP-BOWLES PAGE 25/26 *)   PROGRAM GRAPH1;  USES TURTLEGRAPHICS;  BEGIN "INITTURTLE; "PENCOLOR (WHITE); "MOVE(100); "TURN(120); "MOVE(100); "TURN(120); "MOVE(100); "READLN; "TEXTMODE; "  END. N^SOFACE;   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^SD; $ !BEGIN #INITTURTLE; #MOVETO(200,95); #ONESQUARE; #MOVETO(95,110); #TURN(45); #ONESQUARE; #MOVETO(50,35); #TURN(20); #ONESQUARE; #MOVETO(175,10); #TURN(-45); #ONESQUARE; #READLN; #TEXTMODE;   END. (* PSUP-BOWLES CHAPTER 2, PAGE 51. *)   PROGRAM SQUARES;  USES TURTLEGRAPHICS; "  PROCEDURE ONESQUARE; "BEGIN $PENCOLOR(WHITE); $MOVE(50); $TURN(90); $MOVE(50); $TURN(90); $MOVE(50); $TURN(90); $MOVE(50); $TURN(90); $PENCOLOR(NONE); "ENN^50); "TURN(144); "MOVE(150); "TURN(144); "MOVE(150); "TURN(144); "MOVE(150); "TURN(144); "MOVE(75); "READLN; "TEXTMODE; "  END. URN(90); "MOVE(50); "READLN; "INITTURTLE; "PENCOLOR(WHITE); "MOVE(100); "TURN(180); "MOVE(200); "TURN(180); "MOVE(100); "TURN(90); "MOVE(100); "TURN(180); "MOVE(200); "READLN; "INITTURTLE; "PENCOLOR(WHITE); "MOVE(75); "TURN(144); "MOVE(1(* PSUP-BOWLES EXERCISE 1.2 PAGE 29 *)   PROGRAM GRAPH2;  USES TURTLEGRAPHICS;  BEGIN "INITTURTLE; "PENCOLOR(NONE); "MOVE(50); "TURN(90); "PENCOLOR(WHITE); "MOVE(50); "TURN(90); "MOVE(100); "TURN(90); "MOVE(100); "TURN(90); "MOVE(100); "TN^S; "TRIANGLE(75); "TURN(120); "TRIANGLE(25); "MOVETO(0,0); "TURNTO(0); "SQUARE(100); "MOVETO(190,20); "TURN(30); "SQUARE(50); "READLN; "TEXTMODE; "  END. CEDURE SQUARE(SIZE:INTEGER); "BEGIN $PENCOLOR(WHITE); $MOVE(SIZE); $TURN(90); $MOVE(SIZE); $TURN(90); $MOVE(SIZE); $TURN(90); $MOVE(SIZE); $TURN(90); $PENCOLOR(NONE); "END; "  BEGIN "INITTURTLE; "MOVETO(225,125); "TRIANGLE(50); "TURN(120)(* PSUP-BOWLES PAGE 59 *)   PROGRAM GRAFPROCS; "USES TURTLEGRAPHICS;   PROCEDURE TRIANGLE(SIZE:INTEGER);  BEGIN $PENCOLOR (WHITE); $MOVE(SIZE); $TURN(120); $MOVE(SIZE); $TURN(120); $MOVE(SIZE); $TURN(120); $PENCOLOR(NONE); "END;   PRON^"TEXTMODE;  END. IANGLE; $TURN(60); $TRIANGLE; $TURN(60); $TRIANGLE; $TURN(60); $TRIANGLE; $TURN(60); $TRIANGLE; $TURN(60); $TRIANGLE; "END;  BEGIN "INITTURTTLE; "MOVETO(160,40); "HEXAGON; "MOVETO(230,130); "HEXAGON; "MOVETO(50,95); "HEXAGON; "READLN; (* PSUP-BOWLES EXERCISE 2.1 PAGE 57 *)   PROGRAM HEXAGONS; "USES TURTLEGRAPHICS;  PROCEDURE TRIANGLE; "BEGIN $PENCOLOR (WHITE); $MOVE(30); $TURN(120); $MOVE(30); $TURN(120); $MOVE(30); $PENCOLOR (NONE); "END;  PROCEDURE HEXAGON; "BEGIN $TRN^STAR(SCALE*8); "MOVETO(139,95); "TURN(150); "PENCOLOR(WHITE); "MOVE(SCALE*6); "STAR(SCALE*6); "READLN; "TEXTMODE; "  END. E); $TURN(144); $MOVE(SIZE); $TURN(144); $PENCOLOR(NONE); $TURN(18); "END; "  BEGIN "SCALE:=10; "INITTURTLE; "PENCOLOR(WHITE); "TURN(45); "MOVE(SCALE*8); "STAR(SCALE*4); "MOVETO(139,95); "TURNTO(165); "PENCOLOR(WHITE); "MOVE(SCALE*4); "S(* PSUP-BOWLES PAGE 65 *)   PROGRAM STARS; "USES TURTLEGRAPHICS; "VAR SCALE:INTEGER; "  PROCEDURE STAR(SIZE:INTEGER); "BEGIN $TURN(-18); $PENCOLOR(WHITE); $MOVE(SIZE); $TURN(144); $MOVE(SIZE); $TURN(144); $MOVE(SIZE); $TURN(144); $MOVE(SIZN^(230,130); "HEXAGON(50,95); "READLN; "TEXTMODE;  END. AGON(X,Y:INTEGER); "BEGIN $MOVETO(X,Y); $TRIANGLE(20); $TURN(60); $TRIANGLE(25); $TURN(60); $TRIANGLE(30); $TURN(60); $TRIANGLE(35); $TURN(60); $TRIANGLE(40); $TURN(60); $TRIANGLE(45); "END;  BEGIN "INITTURTTLE; "HEXAGON(160,40); "HEXAGON(* PSUP-BOWLES EXERCISE 2.2 PAGE 63 *)   PROGRAM GRAPH5; "USES TURTLEGRAPHICS;  PROCEDURE TRIANGLE(SIZE:INTEGER); "BEGIN $PENCOLOR (WHITE); $MOVE(SIZE); $TURN(120); $MOVE(SIZE); $TURN(120); $MOVE(SIZE); $PENCOLOR (NONE); "END;  PROCEDURE HEXN^N^ ('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 (L 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 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^h END. (*PROGRAM*) RGIN*) -BEGIN 0X:= 0; 0Y:= Y+1; -END; (*IF*) &UNTIL KEYPRESS; &READ(KEYBOARD,ANYCHAR); #END; (*SNAIL*) #  BEGIN (*MAIN*) #WRITELN(CHR(12)); (*CLEARSCREEN*) #WRITELN  ('ENTER SHORT MESSAGE:ANY KEY TO STOP':37); #READLN(S); #SNAIL(0,4,37); RT OF S*) (L:= LENGTH(S); (GOTOXY(X,Y); (FOR I:= 1 TO L DO -BEGIN 0WRITE(S[N]); 0DELAY(250); 0N:= N+1; (*NEXT LETTER*) 0X:= X+1; (*COUNTS HTABS*) -END; (*LOOP*) (X:= X+2; (*FOR SPACING*) (IF (X>Z) 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 STAI:= 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 (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+1 &WRITELN  ('A 40 COL SCREEN IS USED IN THIS DISPLAY.'); &WRITELN; &WRITELN  ('ENTER SHORT MESSAGE:ANY KEY TO STOP':36); &READLN(S); #END; (*INTRODUCTION*)  #PROCEDURE DELAY(X:INTEGER); &VAR I:INTEGER; (*LOOP INDEX VAR*) #BEGIN &FOR I:= 1 TO XTRODUCTION; #BEGIN &GOTOXY(4,5); &WRITELN  ('TWO TYPES OF BILLBOARD DISPLAY ARE'); &WRITELN  ('ILLUSTRATED IN THIS TABBING EXERCISE.IN'); &WRITELN  ('ONE,THE ENTERED STRING HOPS ACROSS THE'); &WRITELN  ('SCREEN.IN THE 2ND,THE CHARS JUST CRAWL.');PROGRAM 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^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 DO #END; (*DELAY*) # #PROCEDURE HOPPER(X,Y:INTEGER); &VAR I:INTEGER; (*LOOP INDEX VAR*) #BEGIN &WRITELN(CHR(12)); (*CLEARSCREEN*) &REPEAT (L:= LENGTH(S); (FOR I:= 1 TO L DO *BEGIN ,GOTOXY(X,Y); (*INITIAL POSITION*) ,WRITE(S); ,WRITE(CHR(29)); (*CLEAR TO END OF LINE*) ,DELAY(750); ,X:= X-(L+1);(*HOP TO LEFT*) 8(*STRING LENGTH+SPACE*) ,IF (X<1) THEN .BEGIN 0WRITE(CHR(12)); 0X:= 39-L;(*RESTART LINE*) 8(*AT RT.MARGIN*) .END; (*IF*) *END; (*LOOP*) &UNTIL KEYPRESS; &READRITELN $('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 #2-CLEAR SCREEN TOP CLEARTO(LINE:INTEGER); &VAR I:INTEGER; #BEGIN &FOR I:= 0 TO LINE DO 'BEGIN (GOTOXY(0,I); (CLEAREOL(I); 'END; (*DO*) #END; (*CLEARTO*) # #PROCEDURE DEMO1; #BEGIN &FOR I:= 0 TO 18 DO 'BEGIN )WRITELN('LINE # ->':22,I:2); 'END; &WRITELN; &WPROGRAM ERASERS; #VAR I:INTEGER; $ #PROCEDURE CLEARFROM(LINE:INTEGER); #BEGIN %GOTOXY(0,LINE); %WRITE(CHR(11)); #END; (*CLEARFROM*) $ #PROCEDURE CLEAREOL(LINE:INTEGER); #BEGIN %GOTOXY(0,LINE); %WRITE(CHR(29)); #END; (*CLEAREOL*) $ #PROCEDUREN^#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':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 PROGRAM ERASERS1;  (*DEMONSTRATES SEVERAL ASCII CHARACTERS  WHICH AFFECT SCREEN BEHAVIOR,MIMICING  SUCH 'BASIC' FEATURES AS 'HOME',ESCAPE(E),  AND ESCAPE(F).BY MAX J.NAREFF;S.F.,CA.8/80*) #VAR I:INTEGER; $ #PROCEDURE CLEARFROM(LINE:INTEGER); #BEGINPROGRAM WINDCHILL;  (*CALCULATES DEGREE OF PERCIEVED COLDNESS  FROM THE AMBIENT TEMP.AND WIND VELOCITY.  BY MAX J.NAREFF,SAN FRANCISCO,CA.6/80*) $USES TRANSCEND; $VAR 'LOWT,HIT,STEPT,(*TEMP.RANGES*) 'LOWV,HIV,STEPV(*VELOCITY RANGES*) 6:INTEGER; 'N^栗$WRITELN ('THE END':23)  END. ; .WRITE ((CHILLTEMP:2:1,'[',V,'] '); .LOWV:= LOWV+STEPV;(*STEPS-UP V*) +UNTIL (LOWV > HIV); +WRITELN; +LOWT:= LOWT+STEPT;(*STEPS-UP T*) (UNTIL (LOWT > HIT); $END; (*COMPUTCHILL*) $  BEGIN (*MAIN*) $HEADING; $VALUES; $COMPUTCHILL; PROCEDURE COMPUTCHILL; (VAR +T, (*TEMP*) +V (*VELOCITY*) :INTEGER; +CHILLTEMP :REAL; $BEGIN (REPEAT +LOWV:=10;(*REINITIALIZE*) +T:= LOWT; +WRITE (T,':->'); +REPEAT .V:= LOWV; .CHILLTEMP:= 91.4-(0.288* #SQRTVEL(V)+0.45-0.019*V)*(91.4-T)*******':25); (WRITE('TEMP.'); (WRITELN ('::TEMP.[VEL]':20); (WRITELN  ('........................................'); $END; (*VALUES*) $ $FUNCTION SQRTVEL(V:INTEGER):REAL; (VAR S:REAL; $BEGIN (S:= SQRT(V); (SQRTVEL:= S; $END; (*SQRTVEL*) $ $(READLN (HIT); (WRITE ( ('STEP RISE:(5,10,ETC):':36); (READLN (STEPT); (WRITE  ('WIND VELOCITY:LOWER VALUE:':36); (READLN (LOWV); (WRITE ('UPPER VALUE:':36); (READLN (HIV); (WRITE (('STEP RISE:(1,5,10,ETC):':36); (READLN (STEPV); (WRITELN('***'READ (KEYBOARD,CH); $END; (*HEADING*) $ $PROCEDURE VALUES; $BEGIN (PAGE (OUTPUT); (WRITELN  ('CHART ENTRIES-LOW-HIGH-STEP RISE':38); (WRITELN; (WRITE  ('TEMPERATURE(F):LOWER VALUE(EX-30):':36); (READLN (LOWT); (WRITE('UPPER VALUE:':36); NT TEMPERATURE'); 'WRITELN; 'WRITELN  ('(F) AND THE WIND VELOCITY (M/HR).A CHART'); 'WRITELN; 'WRITELN  ('OF VALUES IS PRESENTED OVER THE RANGE OF'); 'WRITELN; 'WRITELN .('REQUESTED DATA.'); 'WRITELN; 'WRITELN (('PRESS TO CONTINUE':32); CH (*EXIT CONTROL*) :CHAR; ' $PROCEDURE HEADING; $BEGIN 'PAGE (OUTPUT); 'GOTOXY (8,5); 'WRITELN ('WINDCHILL TEMPERATURES'); 'WRITELN; 'WRITELN  (' THIS PROGRAM COMPUTES THE','''DEGREE OF'); 'WRITELN; 'WRITELN  ('COLDNESS''',' FROM THE AMBIEPROGRAM WINDTEMPS;  (*CALCULATES DEGREE OF PERCIEVED COLDNESS  FROM THE AMBIENT TEMP.AND WIND VELOCITY.  BY MAX J.NAREFF,SAN FRANCISCO,CA.6/80*) $USES TRANSCEND; $VAR (LOWT,HIT,STEPT,(*TEMP.RANGES*) (ORIGLOWV,LOWV,HIV,STEPV(*VELOCITY RANGES*) 6:INISE:(5,10,ETC):':36); (READLN (STEPT); (WRITE  ('WIND VELOCITY:LOWER VALUE:':36); (READLN (LOWV); (WRITE ('UPPER VALUE:':36); (READLN (HIV); (WRITE (('STEP RISE:(1,5,10,ETC):':36); (READLN (STEPV); $END; (*VALUES*) $ $PROCEDURE CHARTHEADERS; $TEGER; $ $PROCEDURE VALUES; $BEGIN (PAGE (OUTPUT); (WRITELN  ('CHART ENTRIES-LOW-HIGH-STEP RISE':38); (WRITELN; (WRITE  ('TEMPERATURE(F):LOWER VALUE(EX:30):':36); (READLN (ORIGLOWT); (WRITE('UPPER VALUE:':36); (READLN (HIT); (WRITE ( ('STEP RPROGRAM WINDTEMPS;  (*CALCULATES DEGREE OF PERCIEVED COLDNESS  FROM THE AMBIENT TEMP.AND WIND VELOCITY.  BY MAX J.NAREFF,SAN FRANCISCO,CA.6/80*) $USES TRANSCEND; $VAR (ORIGLOWT,LOWT,HIT,STEPT,(*TEMP.RANGES*) (LOWV,HIV,STEPV(*VELOCITY RANGES*) 6:INN^HND':23)  END. E ((TRUNC(CHILLTEMP):6,':'); .LOWV:= LOWV+STEPV;(*STEPS-UP V*) +UNTIL (LOWV > HIV); +WRITELN; +LOWT:= LOWT+STEPT;(*STEPS-UP T*) (UNTIL (LOWT > HIT); $END; (*COMPUTCHILL*) $  BEGIN (*MAIN*) $VALUES; $CHARTHEADERS; $COMPUTCHILL; $WRITELN ('THE EROCEDURE COMPUTCHILL; (VAR +CHILLTEMP :REAL; $BEGIN (REPEAT (*OUTER LOOP*) +LOWV:= ORIGLOWV; (*INITIALIZE*) +CHILLTEMP:= 0; (*INITIALIZE*) +WRITE (LOWT,':->'); +REPEAT .CHILLTEMP:= 91.4-(0.288*SQRT(LOWV)+0.45-0.019*LOWV)*(91.4-LOWT); .WRIT ('.............................................................................'); (WRITELN $('EQUIVALENT TEMPERATURE(F)':32); (WRITELN  ('.............................................................................'); $END; (*CHARTHEADERS*) $ $PBEGIN (WRITELN('******-******':26); (WRITE('TEMP:'); (WRITELN ('WIND VELOCITY':21); (LOWV:= ORIGLOWV; (WRITE (' '); (REPEAT +WRITE (LOWV:7); +LOWV:= LOWV+STEPV; (UNTIL (LOWV>HIV); (WRITELN; (WRITELN (5,10,ETC):':36); (READLN (STEPT); (WRITE  ('WIND VELOCITY:LOWER VALUE:':36); (READLN (ORIGLOWV); (WRITE ('UPPER VALUE:':36); (READLN (HIV); (WRITE (('STEP RISE:(1,5,10,ETC):':36); (READLN (STEPV); $END; (*VALUES*) $ $PROCEDURE CHARTHEADERS; $TEGER; $ $PROCEDURE VALUES; $BEGIN (PAGE (OUTPUT); (WRITELN  ('CHART ENTRIES-LOW-HIGH-STEP RISE':38); (WRITELN; (WRITE  ('TEMPERATURE(F):LOWER VALUE(EX-30):':36); (READLN (LOWT); (WRITE('UPPER VALUE:':36); (READLN (HIT); (WRITE ( ('STEP RISE:BEGIN (WRITELN  ('*************************************************************************'); (WRITE('V-MPH:'); (WRITELN %('ACTUAL THERMOMETER READING (F)':35); (LOWT:= ORIGLOWT; (WRITE (' '); (REPEAT +WRITE (LOWT:7); +LOWT:= LOWT+STEPT; (UNTIL (LOWT>HIT); (WRITELN; (WRITELN  ('.........................................................................'); (WRITELN $('EQUIVALENT CHILL TEMPERATURE(F)':40); (WRITELN  ('....................................................................L*) (Y:= EYR-BYR; (*YR INTERVAL*) (IF M<0 THEN +BEGIN .M:= 12+M; .Y:= Y-1; +END; (IF D<0 THEN +BEGIN .D:= 30+D; .M:= M-1; .IF M<0 THEN 1BEGIN 4Y:= Y-1; 4M:= M+12; 1END; +END; (DAYS:= D+(Y*360)+(M*30); (WRITELN; (WRITELN  ('INTERVAL BETDING DATE--MMDDYY'); (WRITE('':16); (READLN(EMON,EDAY,EYR); %END; (*ENTERDATES*) % %PROCEDURE CALCULATION; (VAR M,D,Y,DAYS :INTEGER; %BEGIN (M:= 0;D:= 0;Y:= 0;DAYS:= 0; (M:= EMON-BMON;(*MON INTERVAL*) (D:= EDAY-BDAY;(*DAY INTERVA%END; (*EXPLANATION*) ( %PROCEDURE ENTERDATES; %BEGIN (PAGE (OUTPUT); (WRITELN('MM DD YY':24); (WRITELN (('EXAMPLE ENTRY---11 03 79'); (WRITELN  ('ENTER FIRST DATE-MMDDYY'); (WRITE('':16); (READLN(BMON,BDAY,BYR); (WRITELN  ('EN (' CALCULATIONS IN THIS PROGRAM ARE'); (WRITELN; (WRITELN  ('BASED ON A 360 DAY YEAR AND 30 DAY MONTH.'); (WRITELN; (WRITELN  ('PRESS TO CONTINUE: TO LEAVE'); (READ (ANYCHAR); (IF (ANYCHAR=CHR(27)) THEN *EXIT (PROGRAM); (WRITELN  ('THE DATES ARE ENTERED,AS INTEGERS,IN THE'); (WRITELN; (WRITELN  ('USUAL MM DD YY FORMAT.THE ELAPSED TIME'); (WRITELN; (WRITELN  ('IS USEFUL IN BUSINESS TRANSACTIONS,SUCH'); (WRITELN; (WRITELN /('AS INTEREST.'); (WRITELN; (WRITELN ):INTEGER; ( %PROCEDURE EXPLANATION; (BEGIN (PAGE (OUTPUT); (WRITELN %('INTERVAL BETWEEN TWO DATES':33); (WRITELN; (WRITELN  (' THIS PROGRAM COMPUTES THE INTERVAL'); (WRITELN; (WRITELN  ('BETWEEN A BEGINNING AND AN ENDING DATE.'); (WRITELN;  PROGRAM DATEINTERVL;  (*COMPUTES INTERVAL BETWEEN TWO DATES FOR USE IN COMMERCIAL  TRANSACTIONS.BY MAX J.NAREFF,SAN FRANCISCO,CA.6/80*)  VAR (ANYCHAR (*PROGRAM CONTROL*):CHAR; (BMON,BDAY,BYR,(*BEGINNING DATES*) (EMON,EDAY,EYR (*ENDING DATES*N^ffTHEADERS; $COMPUTCHILL; $WRITELN ('THE END':23)  END. OWV)+0.45-0.019*LOWV)*(91.4-LOWT); .WRITE ((ROUND(CHILLTEMP):6,':'); .LOWT:= LOWT+STEPT;(*STEPS-UP T*) +UNTIL (LOWT > HIT); +WRITELN; +LOWV:= LOWV+STEPV; (*STEPS-UP V*) (UNTIL (LOWV > HIV); $END; (*COMPUTCHILL*) $  BEGIN (*MAIN*) $VALUES; $CHAR.....'); $END; (*CHARTHEADERS*) $ $PROCEDURE COMPUTCHILL; (VAR +CHILLTEMP :REAL; $BEGIN (REPEAT (*OUTER LOOP*) +LOWT:= ORIGLOWT; (*INITIALIZE*) +CHILLTEMP:= 0; (*INITIALIZE*) +WRITE (LOWV:2,':->'); +REPEAT .CHILLTEMP:= 91.4-(0.288*SQRT(LWEEN---->',BMON,'/',BDAY,'/',BYR,' & ',EMON,'/',EDAY,'/',EYR); (WRITELN  (M:8,' MONTHS:',D,' DAYS:',Y,' YEARS OR'); (WRITELN(DAYS:20,' DAYS'); %END; (*CALCULATION*) $  BEGIN (*MAIN*) $EXPLANATION; $REPEAT &ENTERDATES; &CALCULATION; &WRITELN; &WRITELN('ANOTHER CALCULATION?-->Y/N':32); &READ (KEYBOARD,ANYCHAR); $UNTIL (ANYCHAR='N'); $WRITELN ('THE END':23);  END.  VE+TOTALDSCNT; &DISPLAY; #END; (*CALCULATION*) # #PROCEDURE INFORMATION; #BEGIN &WRITELN (CHR(12)); (*CLEARS SCREEN*) &GOTOXY(12,7); &WRITELN('SHOP AND SAVE'); &WRITELN  ('ON A SUNDAY MORNING,NEWSPAPER ADS ANN-':40); &WRITELN  ('OUNCE A SERIES TDSCNT:= 0;SALEPRICE:= 0; &TOTALDSCNT:= 0; &PCNTOFF:= PCNTOFF/100; (*% AS DECIMAL**) &UNITDSCNT:= REGPRICE*PCNTOFF; &TOTALDSCNT:= UNITDSCNT*QUANTITY; &SALEPRICE:= REGPRICE-UNITDSCNT; & &TOTALCOST:= TOTALCOST+SALEPRICE*QUANTITY; &TOTALSAVE:= TOTALSA&CLEARFROM; #END; (*ONCEMORE*) # #PROCEDURE DISPLAY; (*RESULTS*) #BEGIN &GOTOXY(X,Y); &WRITE  (REGPRICE:7:2,SALEPRICE:14:2,QUANTITY:7); &WRITELN (TOTALDSCNT:11:2); &Y:= Y+1; &ONCEMORE; #END; (*DISPLAY*) # #PROCEDURE CALCULATION; #BEGIN &UNI); &READLN(REGPRICE); &WRITE ('# ITEMS PURCHASED:':30); &READLN(QUANTITY); &WRITE ('PERCENT OFF:':30); &READLN(PCNTOFF); #END; (*DATAENTRY*) # #PROCEDURE ONCEMORE; #BEGIN &WRITELN('ANOTHER ENTRY:(Y/N)?':30); &READ(KEYBOARD,ANYCHAR); ND; (*CLEARFROM*)  #PROCEDURE HEADINGS(X,Y:INTEGER); #BEGIN &GOTOXY(X,Y); &WRITELN  ('REG.PRICE':9,'SALE PRICE':14,'QTY':6,'DISCOUNT':11);  END; (*HEADINGS*)   PROCEDURE DATAENTRY; #BEGIN &GOTOXY(0,16); &WRITE ('ENTER REGULAR PRICE:':30ALEPRICE, &UNITDSCNT, (*DISCOUNT*) &TOTALDSCNT, &TOTALCOST, &TOTALSAVE :REAL; &QUANTITY:INTEGER;  #PROCEDURE CLEARFROM; (*CLEARS SCREEN*) #BEGIN &GOTOXY(0,LINE); &WRITELN(CHR(11)); (*FROM CURSOR TO*) &LINE:= LINE+1; (*TO END OF SCREEN*) #EPROGRAM SHOPNSAVE;  (*A SHOPPING AID,CALCULATING SAVINGS ON  DISCOUNTED ITEMS.BY MAX J.NAREFF,S.F.8/80*) # #VAR &X,Y:INTEGER; (*DISPLAY TABS*) &ANYCHAR:CHAR; (*REPEAT SIGNAL*) &LINE:INTEGER; (*FOR SCREEN CONTROL*) ®PRICE, &PCNTOFF, (* % *) &SN^ȡءOF SALES WITH THE RUBRIC'); &WRITELN ('"-% OFF".'); &WRITELN  (' HERES A SIMPLE PROGRAM TO COMPUTE'); &WRITELN  ('TOTAL COST AND SAVINGS.'); &GOTOXY(0,16); &WRITELN  ('PRESS TO CONTINUE: TO LEAVE'); &READ(KEYBOARD,ANYCHAR); &IF (ANYCHAR=CHR(27)) THEN (EXIT (PROGRAM) &ELSE (WRITELN (CHR(12)); (HEADINGS(0,1); #END; (*INFORMATION*) # #PROCEDURE INITIALIZE; (*VARS & TABS*) #BEGIN &TOTALCOST:= 0; &TOTALSAVE:= 0; &X:= 0; &Y:= 3; &LINE:= 4; #END; (*INITIALIZE*) #  B' TO COMPUTE THE PAYMENTS AND COST OF'); %WRITELN  ('SEQUENTIAL PURCHASES,THE PROGRAM WILL RE-'); %WRITELN ('QUIRE ADJUSTMENTS.'); %WRITELN;WRITELN  ('PRESS TO CONTINUE: TO LEAVE'); %READ (CH); %IF (CH=CHR(27)) THEN 'EXIT (PROGRAM) %EOGRAM COMPUTES INTEREST AND'); %WRITELN  ('EITHER MINIMUM OR FIXED MONTHLY PAYMENTS'); %WRITELN  ('ON A SINGLE CREDIT CARD PURCHASE,BASED'); %WRITELN  ('ON VISA RATES.INTEREST COMPARISONS CAN'); %WRITELN  ('READILY BE MADE.'); %WRITELN;WRITELN  (%GOTOXY (6,12); %WRITE %('ENTER PURCHASE AMT(BALANCE):'); %READLN(BALANCE); %INITIALIZE; #END; (*STARTER*) " #PROCEDURE PROLOGUE; %VAR CH:CHAR; #BEGIN %PAGE (OUTPUT); %GOTOXY(0,4); %WRITELN('CREDIT CARD':25); %WRITELN;WRITELN  (' THIS PRPAYMENT':9, ,'BALANCE':8); #END; (*HEADING*)  #PROCEDURE STATEMENT; #BEGIN %WRITE(MONTH:2,INTEREST:6:2,TOTINTEREST:7:2,UNPDBALANCE:8:2); %WRITELN(MINPAYMENT:8:2,BALANCE:9:2); #END; (*STATEMENT*) # #PROCEDURE STARTER; #BEGIN %PAGE (OUTPUT); ST:= 0;TOTINTEREST:= 0; %UNPDBALANCE:= 0;MINPAYMENT:= 0;FIXEDPAYMENT:= 0; %MONTH:= 0;COUNT:= 0; #END; (*INIT*) # #PROCEDURE HEADING; #BEGIN %PAGE (OUTPUT); %WRITELN %('TOTAL':14,'UNPD':8,'MIN':8); %WRITELN  ('MO':2,'INT':5,'INT':6,'BALANCE':10,'ATED INT.*) %BALANCE, (*ORIG.PURCHASE-NEW BALANCE AFTER /MIN.MONTHLY PAYMENTS*) %UNPDBALANCE, (*BALANCE+FINANCE CHARGE*) %FIXEDPAYMENT, (*FIXED SUM PAYMENT OPTION*) %MINPAYMENT:REAL; (*MIN.MONTHLY PAYMENTS*)  #PROCEDURE INITIALIZE; #BEGIN %INTEREPROGRAM CREDITOPTN; !(*COMPUTES FINANCE CHARGES & MONTHLY PAYMENTS !ON A CREDIT CARD PURCHASE-VISA RATES !BY MAX J.NAREFF,SAN FRANCISCO,CA.9/80*) ! #VAR %MONTH,COUNT:INTEGER;(*COUNTERS*) %INTEREST, (*MONTHLY FINANCE CHARGE*) %TOTINTEREST, (*ACCUMULN^Y& EGIN (*MAIN*) #INFORMATION; #INITIALIZE; #REPEAT &DATAENTRY; &CALCULATION; #UNTIL (ANYCHAR<>'Y'); #WRITELN  ('----------------------------------------'); #WRITELN  ('TOTAL COST=':14,TOTALCOST:6:2,' SAVINGS=',TOTALSAVE:6:2);  END. (*PROGRAM*) LSE 'WRITELN; 'STARTER; #END; (*PROLOGUE*) % #PROCEDURE CLEARFROM(LINE:INTEGER); #BEGIN %GOTOXY(0,LINE); %WRITELN (CHR(11)); #END; (*CLEARFROM*) # #PROCEDURE LINELIMIT(X:INTEGER); %VAR CH:CHAR; #BEGIN %COUNT:= COUNT+1; (*FOR PAGE LENGTH*) %IF (COUNT=X) THEN 'BEGIN )WRITELN ('PRESS TO CONTINUE':31); )READ (CH); )CLEARFROM(2); 'END; %IF (COUNT>X) THEN 'COUNT:= 1; "END; (*LINELIMIT*) ' "PROCEDURE BANKER; "BEGIN $HEADING; $REPEAT %MONTH:= MONTH+1; % &(*COMPUTES INTEREST FRMINATE]':31); +READLN(A,B,C); +WRITE('SIDE A= ':12,A); +WRITE(',SIDE B= ',B); +WRITELN(',SIDE C= ',C); &END;(*ENTERDATA*) & -(*CALCULATES AREA*) , $FUNCTION AREA(A,B,C:INTEGER):REAL; &VAR S :REAL; & &BEGIN (S := 0.5*(A+B+C); (AREA := SQRT(SGRAM TRIANGLES; #USES TRANSCEND;(*CALLS UP LIBRARY 8FUNCTION*) #VAR &A,B,C :INTEGER;  #PROCEDURE ENTERDATA;  &BEGIN +(*INITIALIZE VARIABLES*) +A:=0;B:=0;C:=0; +WRITELN  ('[ENTER THE SIDES OF THE TRIANGLE]':37); +WRITELN &('[0,0,0 WILL TE  (*THIS PROGRAM DEMONSTRATES THE 'IF-THEN  -ELSE'CONSTRUCT,BY MEANS OF WHICH THE  TYPE OF A TRIANGLE IS DETERMINED AND ITS  AREA CALCULATED. ADAPTED AND MODIFIED  FROM"INTRO.TO PASCAL",BY WELSH & ELDER,  1979,BY MAX J.NAREFF,SF.,CA.5/80*)   PRON^E (KEYBOARD,CH);  IF (CH= 'A') THEN (BANKER %ELSE (REGPAYMENTS; #END; (*PAYOPTIONS*) #  BEGIN (*MAIN*) "PROLOGUE; "PAYOPTIONS; "WRITELN ('THE END':23);  END. SA)':37); %WRITELN  ('1.WHEN UNPD BALANCE IS >$250,PAY 4% OF AMT./MO'); %WRITELN  ('2.WHEN UNPD BALANCE (= OR >$10),PAY $10/MO'); %WRITELN;WRITELN  (' [B] SELECT OWN FIXED MONTHLY PAYMENT.'); %WRITELN;WRITELN %('WHICH OPTION-A? OR B?:':31); %READYMENT:'); %READLN (FIXEDPAYMENT); %BANKER; #END; (*REGPAYMENTS*) ' #PROCEDURE PAYOPTIONS; %VAR CH:CHAR; #BEGIN %PAGE (OUTPUT); %GOTOXY (3,8); %WRITELN  ('TWO PAYMENT OPTIONS ARE AVAILABLE'); %WRITELN;WRITELN  ('[A] MINIMUM MONTHLY PAYMENTS (VI%LINELIMIT(18); (*FOR NEW PAGE*) % $UNTIL (MINPAYMENT= UNPDBALANCE); $WRITELN  ('TOTAL INTEREST PAID=':26,TOTINTEREST:6:2); "END; (*(BANKER*) " #PROCEDURE REGPAYMENTS; #BEGIN %PAGE (OUTPUT); %GOTOXY (3,12); %WRITE "('ENTER AMOUNT OF MONTHLY PALSE +IF (FIXEDPAYMENT >= MINPAYMENT) THEN -MINPAYMENT:= FIXEDPAYMENT; ) ,(*UPDATED BALANCE*) %BALANCE:= UNPDBALANCE-MINPAYMENT; ) %TOTINTEREST:= TOTINTEREST+INTEREST; (*ACCUM.INT.*) % %STATEMENT; (*WRITES OUTPUT*) AYMENT:= UNPDBALANCE*0.04 (*REQUIRED MIN.PAYMENT*) %ELSE 'BEGIN )IF(UNPDBALANCE >=10) THEN +MINPAYMENT:= 10 )ELSE +MINPAYMENT:= UNPDBALANCE; 'END; (*ELSE*) *(*TEST FOR OVERPAYMENT*) 'IF(FIXEDPAYMENT>UNPDBALANCE) THEN +MINPAYMENT:= UNPDBALANCE 'EROM FINANCE CHARGE*) %INTEREST:= BALANCE*0.015; (*VISA ANN.RATE=18% *)  (*MONTHLY RATE=1.5%*) * /(*NEW BALANCE*) %UNPDBALANCE:= INTEREST+BALANCE; % &(*COMPUTES EITHER MIN- OR FIXED PAYMENTS*) %IF (UNPDBALANCE>250) THEN 'MINP*(S-A)*(S-B)*(S-C)); &END;(*AREA*) $ &(*DETERMINES TYPE OF TRIANGLE*) & $PROCEDURE DETERMINETYPE; $ &BEGIN (IF A+B>C THEN *BEGIN (*TRIANGLE SELECTION*) -IF A=C THEN /WRITE &('AN EQUILATERAL TRIANGLE') -ELSE .IF (A=B) OR (B=C)THEN 0WRITE /('AN ISOCELES TRIANGLE') -ELSE 0WRITE .('A SCALENE TRIANGLE':23); 0WRITELN +(' OF AREA',AREA(A,B,C):8:2); 0WRITELN &('--------------------------':33); *END (*OF TRIANGLE SELECTION*) * (ELSE *WRITELN *('THIS IS NOT A TRIANGLE':31); *WRITELN  'BEGIN )WRITE(DEGREES:15); *IF(DEGREES MOD 180)=90 THEN ,WRITELN('INFINITY':16) *ELSE ,WRITELN(TAN(DEGREES*(PI/180)):15:5); ,LINELIMIT(20); ,DEGREES := DEGREES+10;(*STEPWISE INCREMENT*) 'END;(*WHILE LOOP*) %WRITELN; %WRITELN('THE END':23)  END. %PAGE(OUTPUT); %WRITELN  ('THIS PROGRAM CREATES A TABLE OF TANG-':40); %WRITELN  ('ENT VALUES EXPRESSED AS RADIANS.'); %WRITELN  ('PRESS ANY KEY TO START':31); %READ(CH); %WRITELN; %WRITELN('DEGREES':18,'TANGENT':12); %WHILE DEGREES<=360 DO TO LEAVE':38); /READ(KEYBOARD,CH); /WRITELN(CH); /IF(CH=CHR(27))THEN 1EXIT(PROGRAM) /ELSE 1PAGE(OUTPUT); 1WRITELN +('DEGREES':18,'TANGENT':12); /COUNT := 0; (*REINITIALIZE*) ,END;(*COUNT*) %END;(*PAGESIZE*) /  BEGIN %DEGREES := 0;COUNT := 0;CHAR;(*FOR SCREEN CONTROL*) % *(*CALCULATION*) %FUNCTION TAN(X:REAL):REAL; %BEGIN *TAN := SIN(X)/COS(X); %END;(*TAN*) % %PROCEDURE LINELIMIT(X:INTEGER); %BEGIN *COUNT := COUNT+1; *IF (COUNT=X) THEN ,BEGIN /WRITE  ('PRESSTO CONTINUE.(*PROGRAM CREATES A TABLE OF TANGENT VAL  UES.CHANGE STEPWISE PROGRESSION AS REQ-  UIRED.SUBMITTED BY M.NAREFF,S.F.,CA.5/80  *)  PROGRAM TANGTABLE; %USES TRANSCEND; %CONST PI =3.1416; %VAR DEGREES, ,COUNT :INTEGER;(*FOR LINE CONTROL*) ,CH :N^E END':23)  END. &('--------------------------':33); &END;(*DETERMINETYPE*) *  BEGIN (*MAIN*) #PAGE(OUTPUT); #WRITE &('DETERMINATION OF THE AREA OF '); #WRITELN('A TRIANGLE'); #WRITELN; #REPEAT &ENTERDATA; &DETERMINETYPE; #UNTIL (A=0); #WRITELN; #WRITELN('THEN^%UNTIL (S>L); %WRITELN('THE END':23)  END. ! T := 0 %END;(*LINELLIMIT*) %  BEGIN (*MAIN PROGRAM BLOCK*) %PAGE(OUTPUT); %WRITELN  ('PREPARATION OF A TRIGONOMETRY CHART':37); %WRITELN; %COUNT :=0; %INTRODUCE; %REPEAT *DEGREES:= S; *CALCULATE; *WRITEOUT; *S:= S+Y; *LINELIMIT(20); R *CH :CHAR; %BEGIN 'COUNT :=COUNT+1;(*FOR PAGE LENGTH*) 'IF (COUNT=X) THEN +BEGIN -WRITELN '('PRESS TO CONTINUE':31); -READ(CH); -PAGE(OUTPUT); -WRITELN  ('DEGREES RADIANS SINE COSINE TANG') +END; 'IF(COUNT>X) THEN (COUN&(*FORMAT AND PRINT OUTPUT*) #PROCEDURE WRITEOUT; &BEGIN (WRITE  (DEGREES,RADIANS:13:4,SINE:8:4,COSINE:8:4); & IF (DEGREES MOD 180)=90 THEN +WRITELN('INFINITY') (ELSE +WRITELN(TANG:8:4); &END;(*WRITEOUT*)  #PROCEDURE LINELIMIT(X:INTEGER); &VA ('DEGREES RADIANS SINE COSINE TANG'); &END; (*INTRODUCE*)   (*CALCULATES RADIANS AND TRIG.FUNCTIONS*) #PROCEDURE CALCULATE; &BEGIN +RADIANS:=DEGREES*K; +SINE:=SIN(RADIANS); +COSINE:=COS(RADIANS); +TANG:=SINE/COSINE &END;(*CALCULATE*)  ; *WRITELN  ('ENTER RANGE OF ANGLES(DEGREES)':35); *WRITE *('FROM SMALLEST-->:':17); *READ(S); *WRITE *('TO LARGEST-->:':22); *READLN(L); *WRITE  ('STEPWISE PROGRESSION?(1,5,10,ETC)'); *READLN(Y); *WRITELN; *WRITELN (*CHART HEADINGS*) ION*) :INTEGER; %SINE,COSINE,TANG, %RADIANS :REAL; % $(*INTRODUCTION AND INSTRUCTIONS*) #PROCEDURE INTRODUCE; &BEGIN *WRITELN  ('A LINE OF TRIGONOMETRIC VALUES':38); *WRITELN  ('WILL FOLLOW EACH ANGLE INPUT.'); *WRITELNLER OPTION I/O*) #USES TRANSCEND;(*CALLS UP LIBRARY FUNCTIONS*) $  (*CONVERSION FACTOR,DEGREES TO RADIANS*) #CONST K=0.01745;(*3.14159/180*) $ #VAR %COUNT,(*LINE COUNTER*) %DEGREES, %S,(*LOWER LIMIT*) %L,(*UPPER LIMIT*) %Y (*STEPWISE PROGRESS  (*THIS PROGRAM WILL CREATE A TABLE OF TRIGONOMETRIC VALUES,IN RADIANS,  FROM A RANGE OF ANGLE VALUES SUBMITTED AS DEGREES. SINE,COSINE AND  TANGENT ARE DISPLAYED.PREPARED BY MAX J.NAREFF,  SAN FRANCISCO,CA.5/80*)   PROGRAM TRIGCHART;(*$I-*)(*COMPIN^eeN^Ӡe ('REPAYMENT COMPLETE IN':25,TERM(R,P,I,N):3:1,' YEARS'); %WRITELN; %WRITELN  ('ANOTHER CALCULATION?:-->Y/N':33); %READ(KEYBOARD,CH); $UNTIL (CH='N'); $WRITELN('THE END':23);  END. (*PROGRAM*) EAL;N:INTEGER):REAL; 'BEGIN )(*CONVERT INTEREST TO DECIMAL*) ,I := I/100; *(*CALCULATION*)  TERM := -(LOG(1-((P*I)/(N*R)))/(LOG(1+I/N)*N)); 'END;(*TERM*) '  BEGIN (*MAIN*) $CH :=('Y'); $REPEAT %DATAENTRY; %WRITELN ->(AMOUNT OF LOAN):':30); *READLN(P); *WRITE  ('ENTER AMT OF REGULAR PAYMENTS:':30); *READLN(R); *WRITE *('ANNUAL INTEREST RATE:':30); *READLN(I); *WRITE '('HOW MANY PAYMENTS/YEAR?:':30); *READLN(N); 'END;(*DATAENTRY*) ' $FUNCTION TERM(R,P,I:RR*) :INTEGER; 'CH (*FOR REPEAT CONTROL*) :CHAR; '  PROCEDURE DATAENTRY; 'BEGIN *WRITELN(CHR(12)); (*CLEARS SCREEN*) *GOTOXY(3,5); ,P:=0;I:=0;R:=0;N:=0; *WRITELN  ('COMPUTATION OF THE TERM OF A LOAN'); *WRITELN; *WRITE *('PRINCIPAL(*COMPUTES THE TERM OF A LOAN.BY MAX J.NAREFF  SAN FRANCISCO,CA.5/80*)   PROGRAM LOANTERM; $USES TRANSCEND;(*CALLS UP LIBRARY FUNCTION (LOG)*) $VAR 'P,(*PRINCIPAL OR LOAN*) 'I,(*ANNUAL INT.RATE*) 'R (*AMT.REGULAR PAYMENTS*) :REAL; 'N (*PAYMENTS/Y  PROGRAM REGPAYMENT;(*$I-*)(*COMPILER OPTION I*)  (*COMPUTES AMOUNT OF EACH REGULAR PAYMENT DUE  ON A LOAN OF'N'YEARS DURATION,FROM THE ANNUAL  INTEREST RATE AND THE NUMBER OF PAYMENTS PER  YEAR.BY MAX J.NAREFF,SAN FRANCISCO,CA.5/80*)  #USES TRAN= 0;ANNINTRATE := 0; .NUMPAYSPERYR:= 0; .WRITE  ('ENTER PRINCIPAL->AMOUNT OF LOAN:':32); .READLN(PRINCIPAL); .WRITE "('ENTER AMT.OF REGULAR PAYMENTS:':32); .READLN(REGPAYMENT); .WRITE #('NUMBER OF PAYMENTS PER YEAR?:':32); .READLN(NUMPAYSPERYR); SPERYR, 'TOTNUMPAYS, 'J (*LOOP ID*) :INTEGER; 'CH (*REPEAT LOOP CONTROL*):CHAR; ' $PROCEDURE DATAENTRY; )BEGIN - PAGE(OUTPUT); .GOTOXY(7,4); .WRITELN '('REMAINING BALANCE ON A LOAN'); .WRITELN; .PRINCIPAL := 0;REGPAYMENT := 0; .TOTNUMPAYS:(*COMPUTES REMAINING BALANCE ON A LOAN  .BY MAX J.NAREFF,SAN FRANCISCO,CA.5/80*)   PROGRAM REMBALANCE; $VAR (*VARIABLES DEFINED BELOW*) 'REGPAYMENT, 'PRINCIPAL, 'ANNINTRATE, 'REMAINBALANCE, 'INTPDWITHEAPAY, 'AMTAMORTEAPAY :REAL; 'NUMPAYN^3u ('$',REGPAY(P,N):6:2,' IN',N:3:1,' REGULAR PAYMENTS/YR FOR'); %WRITELN(Y:17:1,' YEARS'); %WRITELN; %WRITELN('THE END':23);  END. -N*Y)*LN(I/N+1)); )REGPAY := (I*(P/N))/(1-E); &END;(*REPAY*)   BEGIN (*MAIN BODY*) %PAGE(OUTPUT); %GOTOXY(0,8); %WRITELN (*HEADING*)  ('COMPUTES AMT OF REG.PAYMENTS ON A LOAN'); %DATA; %WRITELN EST RATE?: ':32); )READLN(I); )WRITE "('NUMBER OF PAYMENTS PER YEAR?: ':32); )READLN(N); )WRITELN; &END;(*DATA*) # #FUNCTION REGPAY(P,N:REAL):REAL; &(*CALCULATES AMT OF PAYMENT*) &VAR E :REAL; &BEGIN )I := I/100;(*% TO DECIMAL*) )E := EXP((SCEND; #VAR &P,Y,I,N :REAL;(*VARIABLES DEFINED BELOW*) $ #PROCEDURE DATA;(*ENTRIES*) &BEGIN )WRITELN; )WRITE "('ENTER ORIGINAL AMOUNT OF LOAN: ':32); )READLN(P); )WRITE $('ENTER TERM OF LOAN (YEARS): ':32); )READLN(Y); )WRITE '('ANNUAL INTER.WRITE '('ANNUAL INTEREST RATE?:':32); .READLN(ANNINTRATE); .WRITE #('TOTAL NUMBER OF PAYMENTS?:':32); .READLN(TOTNUMPAYS); )END;(*DATAENTRY*) ) %PROCEDURE CALCULATE; )BEGIN +(*CONVERT FROM % TO DECIMAL*) ,ANNINTRATE :=ANNINTRATE/100; 1(*INITIALIZE*) ,REMAINBALANCE := PRINCIPAL; ,INTPDWITHEAPAY:= 0; ,AMTAMORTEAPAY := 0; 1(*LOOP FOR CALCULATIONS*) ,FOR J := 1 TO TOTNUMPAYS DO .BEGIN /(*INTEREST PD WITH EACH PAYMENT*)  INTPDWITHEAPAY := REMAINBALANCE*ANNINTRATE/NUMPAYSPERYR; /(*$WRITELN; $WRITELN('THE END':23);  END. )/I); (END;(*TOTALVALUE*) (  BEGIN(*MAIN BODY*) $PAGE(OUTPUT); $GOTOXY(4,5); $WRITELN $('FUTURE VALUE OF REGULAR DEPOSITS'); $WRITELN('----------':25); $DATAENTRY; $WRITELN $('FUTURE VALUE IN ',Y:2:1,' YEARS=$',TOTALVALUE(R,Y,I,N):8:2); ('NUMBER OF YEARS?:':32); ,READLN(Y); ,WRITE (('NOMINAL INTEREST RATE?:':32); ,READLN(I); (END;(*DATAENTRY*) ( $FUNCTION TOTALVALUE(R,Y,I:REAL;N:INTEGER):REAL; (BEGIN ,I :=(I/N)/100;(*CONVERT % TO DECIMAL*) ,TOTALVALUE := R*((EXP((N*Y)*LN(1+I))-1*) $VAR (R,Y,I :REAL;(*VARIABLES DEFINED BELOW*) (N :INTEGER; ( ( $PROCEDURE DATAENTRY; (BEGIN ,WRITELN; ,WRITE "('ENTER AMT OF REGULAR DEPOSITS:':32); ,READLN(R); ,WRITE "('NUMBER OF DEPOSITS/YEAR?:':32); ,READLN(N); ,WRITE .  PROGRAM FUTUREVALUE;  (*COMPUTES FUTURE VALUE OF AN ACCOUNT WHEN REGULAR DEPOSITS ARE MADE  OVER A GIVEN NUMBER OF YEARS AT A KNOWN INTEREST RATE.  BY MAX J.NAREFF,SAN FRANCISCO,CA.5/80*)  $USES TRANSCEND;(*CALLS UP LIBRARY FUNCTIONS (EXP) & (LN)N^uHE END':23)  END. T 'DATAENTRY; 'CALCULATE; 'WRITELN  ('REMAINING BALANCE AFTER',TOTNUMPAYS:3,' PAYMENTS='); 'WRITELN +('$':16,REMAINBALANCE:10:2); 'WRITELN; 'WRITELN  ('ANOTHER CALCULATION?-->Y/N':33); 'READ(KEYBOARD,CH); %UNTIL (CH='N'); %WRITELN; %WRITELN('TAMT AMORTIZED EACH PAYMENT*)  AMTAMORTEAPAY := REGPAYMENT-INTPDWITHEAPAY;  (*REMAINING BALANCE ON PRINCIPAL*)  REMAINBALANCE := REMAINBALANCE-AMTAMORTEAPAY; .END;(*LOOP*) )END;(*CALCULATE*) +  BEGIN(*MAIN BODY*) %CH := ('Y'); %REPEAN^uN^֠֠IN -WRITELN  ('YEAR ',Y,' AMOUNT OF DEPRECIATION=$':26,AMTDEPREC(P,D,Y):8:2); -LINELIMIT(20); +END;(*LOOP*) -WRITELN; -WRITELN ('ANOTHER CALCULATION?-->Y/N':33); -READ(KEYBOARD,CH); %UNTIL (CH='N'); %WRITELN('THE END':23);  END. BEGIN 0WRITELN 0('PRESS TO CONTINUE':31); 0READ(CH); 0PAGE(OUTPUT); .END *ELSE .IF (COUNT>X) THEN 0COUNT := 0; (END;(*LINELIMIT*) #  BEGIN (*MAIN BODY*) %COUNT := 0;CH := 'Y'; %REPEAT (DATA; (FOR Y := 1 TO N DO(*LOOP FOR YEARS*) +BEG (*EQUATION:AMTDEPREC=P(RICE)*D(EP.RATE)*(1-D(EP.RATE)^(Y(EAR-1)*) % #AMTDEPREC := P*D*(EXP((Y-1)*LN(1-D))); (END;(*AMTDEPREC*) # %PROCEDURE LINELIMIT(X:INTEGER); (VAR CH :CHAR; (BEGIN *COUNT :=COUNT+1;(*FOR PAGE LENGTH*) *IF (COUNT=X) THEN . *READLN(D); *WRITE  ('NUMBER YRS OF DEPRECIATION?:':30); *READLN(N); *WRITELN; (END;(*DATA*) ( %FUNCTION AMTDEPREC(P,D:REAL;Y:INTEGER):REAL; *(*COMPUTATION OF AMOUNT*) (BEGIN *D := D/100;(*% TO DECIMAL*) ) ATA; (BEGIN *PAGE(OUTPUT); *WRITELN  ('THIS PROGRAM CALCULATES THE AMOUNT OF':39); *WRITELN %('DEPRECIATION OF AN ASSET.':32); *WRITELN('----------':25); *WRITE *('ENTER ORIGINAL VALUE:':30); *READLN(P); *WRITE '('ENTER DEPRECIATION RATE:':30); UP LIBRARY FUNCTIONS (EXP) & (LN)*) %VAR (P,(*ORIGINAL VALUE*) (D (*DEPRECIATION RATE*) :REAL; (N,(*YR OF DEPRECIATION*) (Y (*INDEX LOOP VARIABLE*) :INTEGER; (CH (*REPEAT CONTROL*) :CHAR; ' COUNT (*LINE COUNTER*) :INTEGER; ( %PROCEDURE D  (*PROGRAM CALCULATES AMOUNT OF DEPRECIATION WITHIN A PERIOD OF TIME,  FROM THE ORIGINAL VALUE,THE DEPRECIATION RATE AND THE YEAR OF  DEPRECIATION.PREPARED BY MAX J.NAREFF,SAN FRANCISCO,CA.5/80*)   PROGRAM AMTOFDEPRECIATION; %USES TRANSCEND;(*CALLSPROGRAM ADDFRACTNS;  (*ADDS FRACTIONS.ADAPTED FROM A"BASIC  APPROACH TO BASIC",BY HENRY MULLISH,1976.  PREPARED BY MAX J.NAREFF,SAN FRANCISCO,CA.6/80*) $VAR &NUMER1,DENOM1,NUMER2,DENOM2,N3,D3:INTEGER; &CH (*ESCAPE CONTROL*) :CHAR; &X,Y (*REPLACN^ BEGIN (*MAIN*) $INTRODUCTION; $REPEAT &DATAENTRY; &COMMONBASE; &RESTRUCTURE; &PRINTOUT; &WRITELN; &WRITELN &('ANOTHER CALCULATION?-->Y/N':32); &READ (KEYBOARD,CH); &PAGE (OUTPUT); $UNTIL (CH='N'); $WRITELN('THE END':23)  END. )  MONFACTOR; +RESTRUCTURE; )END $END; (*RESTRUCTURE*) $ $PROCEDURE PRINTOUT; $BEGIN &IF (D3=1) THEN )WRITELN "('THE SUM OF THE TWO FRACTIONS= ',N3) &ELSE )WRITELN  ('THE SUM OF THE TWO FRACTIONS= ',N3,'/',D3); $END; (*PRINTOUT*) " $PROCEDURE RESTRUCTURE; &VAR (QUOTIENT,COMMONFACTOR :INTEGER; ( $BEGIN (*RESTRUCTURE*) "IENT:= X DIV Y; &COMMONFACTOR:= X-(QUOTIENT*Y); &IF (COMMONFACTOR=0) THEN )BEGIN +N3:= N3 DIV Y; +D3:= D3 DIV Y; )END &ELSE )BEGIN +X:= Y; +Y:= COMOM1); &WRITE #('ENTER SECOND FRACTION SIMILARLY:'); &READ (NUMER2,DENOM2); $END; (*DATAENTRY*)  &PROCEDURE COMMONBASE; &BEGIN (N3:= 0;D3:= 0; (N3:= (DENOM2*NUMER1)+(DENOM1*NUMER2); (D3:= (DENOM1*DENOM2); (X:= N3;Y:= D3; &END; (*COMMONBASE*) &&PAGE (OUTPUT); &IF (CH=CHR(27)) THEN (EXIT (PROGRAM) &ELSE $END; (*INTRODUCTION*) $ $PROCEDURE DATAENTRY; $BEGIN &GOTOXY(0,10); &WRITELN  ('ENTER FIRST FRACTION AS 2 INTEGERS'); &WRITE  ('SEPARATED BY A :...........'); &READ (NUMER1,DENRITELN; &WRITELN  ('A COMMON FACTOR WHICH CAN REDUCE THE'); &WRITELN; &WRITELN  ('NEW FRACTION TO ITS SIMPLEST FORM IS'); &WRITELN; &WRITELN .('SOUGHT.'); &WRITELN; &WRITELN &('PRESS TO CONTINUE: TO LEAVE'); &READ (KEYBOARD,CH); RITELN  (' THE NUMERATOR OF EACH FRACTION IS'); &WRITELN; &WRITELN  ('MULTIPLIED BY THE DENOMINATOR OF THE '); &WRITELN; &WRITELN  ('OTHER,AND THE TWO ADDED.THE DENOMINATORS'); &WRITELN; &WRITELN  ('ARE MULTIPLIED TO FORM A COMMON BASE.'); &WEMENT VARS*) :INTEGER; $ $PROCEDURE INTRODUCTION; $BEGIN &PAGE (OUTPUT); &WRITELN('THE SUM OF FRACTIONS':30); &WRITELN;WRITELN (' THIS PROGRAM REDUCES THE SUM OF TWO'); &WRITELN; &WRITELN  ('FRACTIONS TO THEIR SIMPLEST FORM.'); &WRITELN; &WPROGRAM PRINT;  "(* JEFFREY SUE *) "(* CONTRIBUTED TO THE S.F. APPLE CORE *) " "(* THIS SIMPLE PROGRAM IS FOR PEOPLE WITHOUT AN UPPER/LOWER &CASE CHIP OR BOARD WHO WANT A QUICK WAY OF ENTERING UPPER AND &LOWER CASE TEXT. OUTPUT CAN BE DIRECTEDIL EOF(INFILE);  CLOSE(OUTFILE,LOCK);  END.  &OLD[J]:=C; &J:=J+1; " END (* ELSE BEGIN *); "END (*OF FOR*); "I:=LENGTH(OLD)-J+1; "IF I>0 THEN DELETE(OLD,J,I);  END (*TRANSLATE*);    BEGIN (* MAIN PROGRAM *) "INIT; "REPEAT $READLN(INFILE,S); " TRANSLATE(S); $WRITELN(OUTFILE,S); "UNT $END (* C='^' *) $ $ELSE BEGIN &IF C='/' THEN &BEGIN (IF I0 THEN &RESET(INFILE,CONCAT(S,'.TEXT')); $(*$I+ TURN I/O CHECKING BACK ON*) $FILEO"WRITELN('(/) ARE LEFT AS UPPER CASE, WHILE THOSE'); "WRITELN('WITHOUT A SLASH ARE CONVERTED TO LOWER'); "WRITELN('CASE. THE OUTPUT FILE MAY BE PRINTER:'); "WRITELN('CONSOLE: OR A DISK FILE NAME.'); "REPEAT $WRITELN; $WRITELN('ENTER NAME OF INPUT F;  BEGIN "PAGE(OUTPUT); "WRITELN('PRINT - SIMPLE CONVERSION PROGRAM'); "WRITELN; "WRITELN; "WRITELN('THIS PROGRAM TRANSLATES FROM UPPER TO'); "WRITELN('LOWER CASE. LETTERS PRECEDED BY SLASH'); OMMANDS FOR OTHER &PURPOSES. & &THIS SIMPLE PROGRAM DOES NOT DO THINGS LIKE EVEN MARGINS, ETC. & "*) "   TYPE CASES=(LOWER,UPPER);   VAR I,J: INTEGER; "INFILE,OUTFILE: TEXT; "S: STRING; "MODE: CASES; "  PROCEDURE INIT;  VAR FILEOK:BOOLEAN TO THE PRINTER: OR TO &CREATE A NEW DISK FILE. ADDITIONALLY, FOR PEOPLE WITH PAPER &TIGER PRINTERS, VARIOUS COMMANDS CAN BE ENTERED TO CHANGE THE &CHARACTERS PER INCH, ETC. PEOPLE WITH OTHER PRINTERS SHOULD &FEEL FREE TO MODIFY THE PROGRAM AND ADD CN^N^xAVEN'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  F 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 ANGE /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 O7^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 CHA PROGRAM DEMOPIC; (* PASCAL HI-RES LOAD/SAVE TO DISK *)   (* This program was copied from The  International Apple Cores APNOTE G12 *)   (* This demo program Creates a hi-res  picture in PASCAL, then saves it to  disk. It is then relocated and á"ˡeudvצ0123456789ABCDEFȄ ?Ȅ ?  UNIT =  צ BLLOOK AT ANOTHER BLOCK ? YéyÍ ɩ ō?ENTER BEGINING BLOCK <0..279>   ˩˄JWHICH DRIVE <1..2>  áisk. You may terminate the listing at the =end of a screen simply by pressing ESC. To continue listing צpress the SPACE BAR.E Y˩y˄N˄n˄fצ.DO YOU WISH TO צ=verting all others to a "!". The HEX format converts every (byte to its equivalent hexidecimal form.to the end of the d ?This program allows access to any block on either of the disks.צ9It displays the information in both ASCII and HEX format.=The ASCII format displays only the printable chatacters, con-" DISC E(F,CHEAT.PTRPART^,16);  CLOSE(F,LOCK);  END; $  BEGIN (* MAIN PROGRAM *)  INITTURTLE;  DRAWPICS;  BSAVE(':DEMO.PIC');  FILLSCREEN(BLACK);  BLOAD(':DEMO.PIC');  REPEAT UNTIL KEYPRESS;  TEXTMODE;  END.  T.INTPART := HIRESP1;  RESET(F,FILENAME);  IO := BLOCKREAD(F,CHEAT.PTRPART^,16);  CLOSE(F,LOCK);  END;   PROCEDURE BSAVE(FILENAME : STRING);  VAR IO : INTEGER; $F : FILE;  BEGIN  CHEAT.INTPART := HIRESP1;  REWRITE(F,FILENAME);  IO := BLOCKWRITETO(0,0); PENCOLOR(NONE);  MOVETO(75,95); WSTRING(' THIS IS A TEST ');  MOVETO(28,5); WSTRING('');  END;   PROCEDURE BLOAD(FILENAME : STRING);  VAR IO : INTEGER; $F : FILE;  BEGIN  CHEA$CH : CHAR; ,  PROCEDURE DRAWPICS; (* THIS CAN BE REPLACED WITH ANY GRAPHICS ROUTINE *)  BEGIN  MOVETO(0,0); PENCOLOR(WHITE);  MOVETO(279,0); TURN(90);  MOVETO(279,191); TURN(90);  MOVETO(0,191); TURN(90);  MOVINSON *)  (* *)  USES TURTLEGRAPHICS, APPLESTUFF;  CONST HIRESP1 = 8192;  VAR CHEAT : RECORD CASE BOOLEAN OF ,TRUE : (INTPART : INTEGER); ,FALSE : (PTRPART : ^INTEGER);  END; o the volume  directory. *)   (* *)  (* PROGRAM LOADS AND SAVES HIRES SCREEN TO DISK *)  (* APPLE COMPUTER 12/79 BY JO & CHARLIE KELLNER *)  (* BASED ON "SLIDE SHOW" BY BILL ATKdis-  played.   The "USES TURTLEGRAPHICS" statement  allocates space for the hi-res screen,  and should be referenced even if Turtle-  graphics are not actually used. Note  that the "CLOSE (F,LOCK)" closes the file  and places it permanently intOCK =  צINDEXצHEX DUMP< ASCII DUMPצ============<צ ==========ȡ  צ : ȡ!  צ ȡX   š ǀ ũ Ʉ  ! x  ˡ  ȡmˡ ('REPAYMENT COMPLETE IN':25,TERM(R,P,I,N):3:1,' YEARS'); %WRITELN; %WRITELN  ('ANOTHER CALCULATION?:-->Y/N':33); %READ(KEYBOARD,CH); $UNTIL (CH='N'); $WRITELN('THE END':23);  END. (*PROGRAM*) 2_P2__2 2M rx &ȡڛ^áɡ۹ڛ)$08 ,ڛۿrڛCá ڛ^ڛCáPڛCá ڛ<ڛCá.CU&P J@ "$:P/á3ɡڛڛ Háٛۿٕš Mrd12^á_צPRINTER:P!_צPRINTER_PRINTER:תP_XPڳ  &ȡڛ^áɡ۹ڛ)$08 ,ڛۿrڛCá ڛڶ_P_á_צSYSTEM.WRK.TEXTP2_"ˡ$2_Pצ.TEXTU"ؓ"צFILE NOT FOUNDءENTER NAME OF OUTPUT FILEצ (RETURN=PRINTER:) : _P_צ&WITHOUT A SLASH ARE CONVERTED TO LOWERצ&CASE. THE OUTPUT FILE MAY BE PRINTER:צCONSOLE: OR A DISK FILE NAME.ENTER NAME OF INPUT FILE (RETURN=SYSTEM.WRK.TEXT) :  #PRINT - SIMPLE CONVERSION PROGRAMצ%THIS PROGRAM TRANSLATES FROM UPPER TO&LOWER CASE. LETTERS PRECEDED BY SLASH'(/) ARE LEFT AS UPPER CASE, WHILE THOSE"f PRINT \צ3PRESS: SPACE BAR to continue ESC to terminate   áá "ˡY *PLEASE CHECK DISK. ERROR IN READING DISK.+ j#J צ*PLEASE CHECK DISK. ERROR IN READING DISK.צ!Press RETURN to return to system.( (. ˡ\צ3PRESS: SPACE BAR to continue ESC to terminate   áá "ˡY *PLEASE CHECK DISK. ERROR IN READING DISK.N^ӠeN^3u ('$',REGPAY(P,N):6:2,' IN',N:3:1,' REGULAR PAYMENTS/YR FOR'); %WRITELN(Y:17:1,' YEARS'); %WRITELN; %WRITELN('THE END':23);  END. -N*Y)*LN(I/N+1)); )REGPAY := (I*(P/N))/(1-E); &END;(*REPAY*)   BEGIN (*MAIN BODY*) %PAGE(OUTPUT); %GOTOXY(0,8); %WRITELN (*HEADING*)  ('COMPUTES AMT OF REG.PAYMENTS ON A LOAN'); %DATA; %WRITELN EST RATE?: ':32); )READLN(I); )WRITE "('NUMBER OF PAYMENTS PER YEAR?: ':32); )READLN(N); )WRITELN; &END;(*DATA*) # #FUNCTION REGPAY(P,N:REAL):REAL; &(*CALCULATES AMT OF PAYMENT*) &VAR E :REAL; &BEGIN )I := I/100;(*% TO DECIMAL*) )E := EXP((SCEND; #VAR &P,Y,I,N :REAL;(*VARIABLES DEFINED BELOW*) $ #PROCEDURE DATA;(*ENTRIES*) &BEGIN )WRITELN; )WRITE "('ENTER ORIGINAL AMOUNT OF LOAN: ':32); )READLN(P); )WRITE $('ENTER TERM OF LOAN (YEARS): ':32); )READLN(Y); )WRITE '('ANNUAL INTER  PROGRAM REGPAYMENT;(*$I-*)(*COMPILER OPTION I*)  (*COMPUTES AMOUNT OF EACH REGULAR PAYMENT DUE  ON A LOAN OF'N'YEARS DURATION,FROM THE ANNUAL  INTEREST RATE AND THE NUMBER OF PAYMENTS PER  YEAR.BY MAX J.NAREFF,SAN FRANCISCO,CA.5/80*)  #USES TRAN(*COMPUTES REMAINING BALANCE ON A LOAN  .BY MAX J.NAREFF,SAN FRANCISCO,CA.5/80*)   PROGRAM REMBALANCE; $VAR (*VARIABLES DEFINED BELOW*) 'REGPAYMENT, 'PRINCIPAL, 'ANNINTRATE, 'REMAINBALANCE, 'INTPDWITHEAPAY, 'AMTAMORTEAPAY :REAL; 'NUMPAY('NUMBER OF YEARS?:':32); ,READLN(Y); ,WRITE (('NOMINAL INTEREST RATE?:':32); ,READLN(I); (END;(*DATAENTRY*) ( $FUNCTION TOTALVALUE(R,Y,I:REAL;N:INTEGER):REAL; (BEGIN ,I :=(I/N)/100;(*CONVERT % TO DECIMAL*) ,TOTALVALUE := R*((EXP((N*Y)*LN(1+I))-1*) $VAR (R,Y,I :REAL;(*VARIABLES DEFINED BELOW*) (N :INTEGER; ( ( $PROCEDURE DATAENTRY; (BEGIN ,WRITELN; ,WRITE "('ENTER AMT OF REGULAR DEPOSITS:':32); ,READLN(R); ,WRITE "('NUMBER OF DEPOSITS/YEAR?:':32); ,READLN(N); ,WRITE .  PROGRAM FUTUREVALUE;  (*COMPUTES FUTURE VALUE OF AN ACCOUNT WHEN REGULAR DEPOSITS ARE MADE  OVER A GIVEN NUMBER OF YEARS AT A KNOWN INTEREST RATE.  BY MAX J.NAREFF,SAN FRANCISCO,CA.5/80*)  $USES TRANSCEND;(*CALLS UP LIBRARY FUNCTIONS (EXP) & (LN)N^uHE END':23)  END. T 'DATAENTRY; 'CALCULATE; 'WRITELN  ('REMAINING BALANCE AFTER',TOTNUMPAYS:3,' PAYMENTS='); 'WRITELN +('$':16,REMAINBALANCE:10:2); 'WRITELN; 'WRITELN  ('ANOTHER CALCULATION?-->Y/N':33); 'READ(KEYBOARD,CH); %UNTIL (CH='N'); %WRITELN; %WRITELN('TAMT AMORTIZED EACH PAYMENT*)  AMTAMORTEAPAY := REGPAYMENT-INTPDWITHEAPAY;  (*REMAINING BALANCE ON PRINCIPAL*)  REMAINBALANCE := REMAINBALANCE-AMTAMORTEAPAY; .END;(*LOOP*) )END;(*CALCULATE*) +  BEGIN(*MAIN BODY*) %CH := ('Y'); %REPEA1(*INITIALIZE*) ,REMAINBALANCE := PRINCIPAL; ,INTPDWITHEAPAY:= 0; ,AMTAMORTEAPAY := 0; 1(*LOOP FOR CALCULATIONS*) ,FOR J := 1 TO TOTNUMPAYS DO .BEGIN /(*INTEREST PD WITH EACH PAYMENT*)  INTPDWITHEAPAY := REMAINBALANCE*ANNINTRATE/NUMPAYSPERYR; /(*.WRITE '('ANNUAL INTEREST RATE?:':32); .READLN(ANNINTRATE); .WRITE #('TOTAL NUMBER OF PAYMENTS?:':32); .READLN(TOTNUMPAYS); )END;(*DATAENTRY*) ) %PROCEDURE CALCULATE; )BEGIN +(*CONVERT FROM % TO DECIMAL*) ,ANNINTRATE :=ANNINTRATE/100; = 0;ANNINTRATE := 0; .NUMPAYSPERYR:= 0; .WRITE  ('ENTER PRINCIPAL->AMOUNT OF LOAN:':32); .READLN(PRINCIPAL); .WRITE "('ENTER AMT.OF REGULAR PAYMENTS:':32); .READLN(REGPAYMENT); .WRITE #('NUMBER OF PAYMENTS PER YEAR?:':32); .READLN(NUMPAYSPERYR); SPERYR, 'TOTNUMPAYS, 'J (*LOOP ID*) :INTEGER; 'CH (*REPEAT LOOP CONTROL*):CHAR; ' $PROCEDURE DATAENTRY; )BEGIN - PAGE(OUTPUT); .GOTOXY(7,4); .WRITELN '('REMAINING BALANCE ON A LOAN'); .WRITELN; .PRINCIPAL := 0;REGPAYMENT := 0; .TOTNUMPAYS:)/I); (END;(*TOTALVALUE*) (  BEGIN(*MAIN BODY*) $PAGE(OUTPUT); $GOTOXY(4,5); $WRITELN $('FUTURE VALUE OF REGULAR DEPOSITS'); $WRITELN('----------':25); $DATAENTRY; $WRITELN $('FUTURE VALUE IN ',Y:2:1,' YEARS=$',TOTALVALUE(R,Y,I,N):8:2); $WRITELN; $WRITELN('THE END':23);  END. IN -WRITELN  ('YEAR ',Y,' AMOUNT OF DEPRECIATION=$':26,AMTDEPREC(P,D,Y):8:2); -LINELIMIT(20); +END;(*LOOP*) -WRITELN; -WRITELN ('ANOTHER CALCULATION?-->Y/N':33); -READ(KEYBOARD,CH); %UNTIL (CH='N'); %WRITELN('THE END':23);  END. BEGIN 0WRITELN 0('PRESS TO CONTINUE':31); 0READ(CH); 0PAGE(OUTPUT); .END *ELSE .IF (COUNT>X) THEN 0COUNT := 0; (END;(*LINELIMIT*) #  BEGIN (*MAIN BODY*) %COUNT := 0;CH := 'Y'; %REPEAT (DATA; (FOR Y := 1 TO N DO(*LOOP FOR YEARS*) +BEG (*EQUATION:AMTDEPREC=P(RICE)*D(EP.RATE)*(1-D(EP.RATE)^(Y(EAR-1)*) % #AMTDEPREC := P*D*(EXP((Y-1)*LN(1-D))); (END;(*AMTDEPREC*) # %PROCEDURE LINELIMIT(X:INTEGER); (VAR CH :CHAR; (BEGIN *COUNT :=COUNT+1;(*FOR PAGE LENGTH*) *IF (COUNT=X) THEN . *READLN(D); *WRITE  ('NUMBER YRS OF DEPRECIATION?:':30); *READLN(N); *WRITELN; (END;(*DATA*) ( %FUNCTION AMTDEPREC(P,D:REAL;Y:INTEGER):REAL; *(*COMPUTATION OF AMOUNT*) (BEGIN *D := D/100;(*% TO DECIMAL*) ) ATA; (BEGIN *PAGE(OUTPUT); *WRITELN  ('THIS PROGRAM CALCULATES THE AMOUNT OF':39); *WRITELN %('DEPRECIATION OF AN ASSET.':32); *WRITELN('----------':25); *WRITE *('ENTER ORIGINAL VALUE:':30); *READLN(P); *WRITE '('ENTER DEPRECIATION RATE:':30); UP LIBRARY FUNCTIONS (EXP) & (LN)*) %VAR (P,(*ORIGINAL VALUE*) (D (*DEPRECIATION RATE*) :REAL; (N,(*YR OF DEPRECIATION*) (Y (*INDEX LOOP VARIABLE*) :INTEGER; (CH (*REPEAT CONTROL*) :CHAR; ' COUNT (*LINE COUNTER*) :INTEGER; ( %PROCEDURE D  (*PROGRAM CALCULATES AMOUNT OF DEPRECIATION WITHIN A PERIOD OF TIME,  FROM THE ORIGINAL VALUE,THE DEPRECIATION RATE AND THE YEAR OF  DEPRECIATION.PREPARED BY MAX J.NAREFF,SAN FRANCISCO,CA.5/80*)   PROGRAM AMTOFDEPRECIATION; %USES TRANSCEND;(*CALLSN^u