`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JO^ffj LINEFEED.TEXTVfjl LINEFEED.CODEVflmHAZEL.MISCINFOf3my GRAFDEMO.CODEVf2y{ HILBERT.CODEVf2{ TREE.TEXTr;Vff TREE.CODEr;Vf2SPIRODEMO.CODEf2GRAFCHARS.CODEf2DATA.1  NIMROD.TEXTVf  DISKIO.TEXTVf &SPIRODEMO.TEXTfE&, HILBERT.TEXTVfE,0HAZELGOTO.TEXTfӟ0L GRAFDEMO.TEXTVfELRGRAFCHARS.TEXTffRZ CROSSREF.TEXTVfZf BALANCED.TEXTVf&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`& D(BUFFER[72]); (* PREFIX INFORMATION BYTE *) "CRTINFO[LEADIN]:=BUFFER[62]; PREFIXED[LEADIN]:=FALSE; "CRTINFO[ERASEOS]:=BUFFER[64]; PREFIXED[ERASEOS]:=ODD(BYTE DIV 8); "CRTINFO[ERASEOL]:=BUFFER[65]; PREFIXED[ERASEOL]:=ODD(BYTE DIV 4);  CRTINFO[RIGHT] *)  (****************************************************************)  VAR BUFFER: PACKED ARRAY[0..511] OF CHAR; $I,BYTE: INTEGER;  F: FILE;  BEGIN "RESET(F,'*SYSTEM.MISCINFO'); "I:=BLOCKREAD(F,BUFFER,1); "CLOSE(F); "BYTE:=OR (****************************************************************)  (* *)  (* READ SYSTEM.MISCINFO AND GET CRT CONTROL CHARACTER INFO *)  (* ADIN);    VAR CH: CHAR; $RECNUM: INTEGER; $LASTCHANGE: BOOLEAN; $DATAFILE: FILE OF PERSON;  CRTINFO: PACKED ARRAY[CRTCOMMAND] OF CHAR; $PREFIXED: ARRAY[CRTCOMMAND] OF BOOLEAN; $ $   PROCEDURE GETCRTINFO; SETOFCHAR=SET OF CHAR; %PERSON=RECORD 1NAME: STRING[NAMELEN]; 1COMPANY: STRING[COMPLEN]; 1STREET: STRING[STREETLEN]; 1CITYSTATE: STRING[CITYLEN]; 1TEL: STRING[TELELEN]; /END;  CRTCOMMAND= (ERASEOS,ERASEOL,UP,DOWN,RIGHT,LEFT,LECREEN CONTROL. *)  (* *)  (*********************************************************)   CONST NAMELEN=32; &COMPLEN=32;  STREETLEN=20; &CITYLEN=30;  TELELEN=14; &  TYPE (*$V-*)  (*$G+*)  PROGRAM DISKIO;  (*********************************************************)  (* *)  (* PROGRAM TO DEMONSTRATE RANDOM ACCESS DISK FILES *)  (* AND TERMINAL-INDEPENDENT SO^E:=BUFFER[66]; PREFIXED[RIGHT]:=ODD(BYTE DIV 2); "CRTINFO[UP]:=BUFFER[67]; PREFIXED[UP]:=ODD(BYTE); "CRTINFO[LEFT]:=BUFFER[68]; PREFIXED[LEFT]:=ODD(BYTE DIV 32);  CRTINFO[DOWN]:=CHR(10); PREFIXED[DOWN]:=FALSE;  END;    PROCEDURE CRT(C: CRTCOMMAND);  (*****************************************************************)  (* *)  (* CRT COMMANDS ARE: ERASEOS,ERASEOL,UP,DOWN,RIGHT,LEFT. *)  (* ame: ',NAME); &WRITELN('Company: ',COMPANY); &WRITELN('Street: ',STREET); &WRITELN('City & State: ',CITYSTATE); &WRITELN('Telephone: ',TEL); $END;  END;    PROCEDURE CHANGEREC(VAR REC: PERSON);  BEGIN "GOTOXY(0,12); CRT(ME,NAMELEN); &CHECK(COMPANY,COMPLEN); &CHECK(STREET,STREETLEN); &CHECK(CITYSTATE,CITYLEN); &CHECK(TEL,TELELEN); $END;  END; (* VALIDATE *)    PROCEDURE SHOWREC(REC: PERSON);  BEGIN "GOTOXY(0,4); CRT(ERASEOS); "WITH REC DO $BEGIN &WRITELN('N$IF LENGTH(S) > MAXLEN THEN GOTO 1; $FOR I:=1 TO LENGTH(S) DO &IF NOT (S[I] IN [' '..'}']) THEN GOTO 1; $EXIT(CHECK); (* STRING IS OK *) "1: ZEROREC(REC); EXIT(VALIDATE); "END; (* CHECK *) "  BEGIN (* VALIDATE *) "WITH REC DO $BEGIN $ CHECK(NALID. *)  (* *)  (*********************************************************) "PROCEDURE CHECK(VAR S: STRING; MAXLEN: INTEGER); "LABEL 1; "VAR I: INTEGER; "BEGIN CEDURE VALIDATE(VAR REC: PERSON);  (*********************************************************)  (* *)  (* TRIES TO DETECT AND ZERO AN UNINITIALIZED RECORD *)  (* NO CHANGE IF ALL FIELDS ARE VA FUNCTION YES: BOOLEAN;  BEGIN "YES:= GETCHAR(['Y','y','N','n']) IN ['Y','y'];  END;    PROCEDURE ZEROREC(VAR REC: PERSON);  BEGIN "WITH REC DO $BEGIN &NAME:=''; &COMPANY:=''; &STREET:=''; &CITYSTATE:=''; &TEL:=''; $END;  END;    PRO$IF S1[1] IN OKSET THEN STEMP:=CONCAT(STEMP,S1) &ELSE IF S1[1]=CHR(8) THEN (BEGIN *CRT(LEFT); WRITE(' '); CRT(LEFT); *DELETE(STEMP,LENGTH(STEMP),1); (END; "UNTIL S1[1] = CHR(13); "IF LENGTH(STEMP) <> 0 THEN S:=STEMP "ELSE WRITE(S);  END;   CHAR;  BEGIN "OKSET:=[' '..'}']; "S1:=' '; "STEMP:=''; "REPEAT " IF LENGTH(STEMP) = 0 THEN S1[1]:=GETCHAR(OKSET + [CHR(13)]) &ELSE IF LENGTH(STEMP)=MAXLEN THEN S1[1]:=GETCHAR([CHR(13),CHR(8)]) -ELSE S1[1]:=GETCHAR(OKSET + [CHR(13),CHR(8)]); STRING ENTERED, DEFAULT AND PRINT PREVIOUS VALUE. *)  (* *)  (***************************************************************)  VAR S1: STRING[1];  STEMP: STRING[80];  OKSET: SET OF RING(VAR S: STRING; MAXLEN: INTEGER);  (***************************************************************)  (* *)  (* GET AND ECHO A STRING UP TO MAXLEN CHARS LONG. *)  (* IF NULL  GOOD: BOOLEAN;  BEGIN  REPEAT $READ(KEYBOARD,CH); $IF EOLN(KEYBOARD) THEN CH:=CHR(13); $GOOD:= CH IN OKSET; $IF NOT GOOD THEN WRITE(CHR(7)) &ELSE IF CH IN [' '..'}'] THEN WRITE(CH); "UNTIL GOOD; "GETCHAR:=CH;  END;    PROCEDURE GETST *)  (* GET A CHARACTER, BEEP IF NOT IN OKSET, ECHO ONLY IF PRINTING *)  (* *)  (******************************************************************)  VAR CH: CHAR; AT(Y: INTEGER; S: STRING);  BEGIN "GOTOXY(0,Y); "WRITE(S); "CRT(ERASEOL);  END;    FUNCTION GETCHAR(OKSET: SETOFCHAR): CHAR;  (******************************************************************)  (* *)  (*****************************************************************)  BEGIN "IF PREFIXED[C] THEN UNITWRITE(1,CRTINFO[LEADIN],1,0,12); "UNITWRITE(1,CRTINFO[C],1,0,12);  END;    PROCEDURE PROMPTERASEOS); "PROMPTAT(12,'(Press return for no change)'); "WITH REC DO $BEGIN &GOTOXY(0,14); &WRITE('Name: '); GETSTRING(NAME,NAMELEN); WRITELN; &WRITE('Company: '); GETSTRING(COMPANY,COMPLEN); WRITELN; &WRITE('Street: '); GETSTRING(STREET,STREETLEN); WRITELN; &WRITE('City & State: '); GETSTRING(CITYSTATE,CITYLEN); WRITELN; &WRITE('Telephone: '); GETSTRING(TEL,TELELEN); WRITELN; #END;  END; (* CHANGEREC *) " "  PROCEDURE NEWFILE;  VAR SU'N','n': NEXT; &'F','f': NEWFILE; &'V','v': VIEW; &'C','c': CHANGE; $END; "UNTIL CH IN ['Q','q']; " "CLOSE(DATAFILE,LOCK);  PROMPTAT(12,'THAT''S ALL FOLKS...');  END.    END; " "  BEGIN (* MAIN PROGRAM *) "GETCRTINFO; "GOTOXY(0,0); CRT(ERASEOS); "NEWFILE; "REPEAT $PROMPTAT(0,'>DISKIO: V(iew, C(hange, N(ext, F(ile, Q(uit '); $CH:=GETCHAR(['N','n','F','f','V','v','C','c','Q','q']); $CRT(ERASEOS); $CASE CH OF &&(*$I-*) &PUT(DATAFILE); $ (*$I+*) &IF (IORESULT<>0) OR EOF(DATAFILE) THEN (BEGIN *GOTOXY(0,20); *WRITELN(CHR(7),'UNABLE TO EXTEND FILE, NO DATA WRITTEN'); $ WRITELN('Use Filer K(runch command to make space after file.'); (END; $END; Y(0,4); *WRITE('Record ',RECNUM,' not in file.'); ( EXIT(NEXT); (END; $END;  GOTOXY(0,2); WRITE('Record number ',RECNUM); "VALIDATE(DATAFILE^); "SHOWREC(DATAFILE^);  IF LASTCHANGE THEN $BEGIN &CHANGEREC(DATAFILE^); &SEEK(DATAFILE,RECNUM); D; "LASTCHANGE:=FALSE;  END; " "  PROCEDURE NEXT;  (* VIEW OR CHANGE NEXT RECORD *)  BEGIN "RECNUM:=RECNUM+1; "SEEK(DATAFILE,RECNUM); "GET(DATAFILE); "IF EOF(DATAFILE) THEN $BEGIN &ZEROREC(DATAFILE^); &IF NOT LASTCHANGE THEN (BEGIN *GOTOX$READLN(RECNUM); "UNTIL IORESULT=0; "(*$I+*) "SEEK(DATAFILE,RECNUM); "GET(DATAFILE); "IF EOF(DATAFILE) THEN $BEGIN &GOTOXY(0,4); &WRITE('Record ',RECNUM,' not in file.'); $END "ELSE $BEGIN &VALIDATE(DATAFILE^); &SHOWREC(DATAFILE^);  EN0); &WRITELN(CHR(7),'UNABLE TO EXTEND FILE, NO DATA WRITTEN'); &WRITELN('Use Filer K(runch command to make space after file.'); $END; "LASTCHANGE:=TRUE;  END; "   PROCEDURE VIEW;  BEGIN "(*$I-*) "REPEAT $PROMPTAT(2,'View which record ? '); EOF(DATAFILE) THEN (* EXTENDING FILE *) ZEROREC(DATAFILE^); "VALIDATE(DATAFILE^); "SHOWREC(DATAFILE^); "CHANGEREC(DATAFILE^); "SEEK(DATAFILE,RECNUM); "(*$I-*) "PUT(DATAFILE);  (*$I+*) "IF (IORESULT<>0) OR EOF(DATAFILE) THEN $BEGIN &GOTOXY(0,2IL SUCESSFUL; "(*$I+*) "RECNUM:=-1;  LASTCHANGE:=FALSE;  END;    PROCEDURE CHANGE;  BEGIN "(*$I-*) "REPEAT $PROMPTAT(2,'Change which record ? '); $READLN(RECNUM); "UNTIL IORESULT=0; "(*$I+*) "SEEK(DATAFILE,RECNUM); "GET(DATAFILE); "IF0(* INITIALIZE CONTENTS OF FILE *) 0FOR IREC:=0 TO MAXREC DO 2BEGIN 4SEEK(DATAFILE,IREC); 4PUT(DATAFILE); 2END; 0CLOSE(DATAFILE,LOCK); (* LOCK IT IN PLACE *) 0RESET(DATAFILE,FILENAME); . SUCESSFUL := (IORESULT = 0); .END; & END; &END; "UNT,READLN(MAXREC); ,SEEK(DATAFILE,MAXREC); ,ZEROREC(DATAFILE^); ,(*$I-*) ,PUT(DATAFILE); ,(*$I+*) ,IF (IORESULT<>0) OR EOF(DATAFILE) THEN .BEGIN 0PROMPTAT(14,'Not enough room. Press return '); 0READLN; 0SUCESSFUL:=FALSE; .END ,ELSE .BEGIN ; (* TRY TO OPEN AN OLD FILE *) $SUCESSFUL := (IORESULT=0); $IF NOT SUCESSFUL THEN (* START A NEW FILE? *) &BEGIN (PROMPTAT(10,'Start a new file ? '); (IF YES THEN *BEGIN ,REWRITE(DATAFILE,FILENAME); ,PROMPTAT(12,'Reserve how many records ? '); CESSFUL: BOOLEAN; $FILENAME: STRING[30];  IREC,MAXREC: INTEGER;  BEGIN "CLOSE(DATAFILE,LOCK); (* IN CASE IT'S ALREADY OPEN *) "(*$I-*) "REPEAT $GOTOXY(0,1); CRT(ERASEOS); $PROMPTAT(8,'File Name: '); READLN(FILENAME); $RESET(DATAFILE,FILENAME)O^ğEO^2E$UNTIL KEYPRESS; $READ(KEYBOARD,CH); $TEXTMODE; "UNTIL FALSE;  END.  EAT WRITE('CHANGE: '); $READLN(CHANGE); UNTIL CHANGE >0; $REPEAT (* FOR EACH SPIRALLELOGRAM *) &DISTANCE:=10; &INITTURTLE; &PENCOLOR(WHITE); &WHILE DISTANCE < 250 DO NEXTLINE; $ FILLSCREEN(REVERSE); &FILLSCREEN(REVERSE); &ANGLE:=ANGLE+15; FOLKS...');  EXIT(PROGRAM);  END;    BEGIN (* MAIN PROGRAM *) "COL:=WHITE; "WRITELN('WELCOME TO WHILEPLOT'); "WRITELN('ENTER ANGLE 0 TO QUIT.'); "WRITELN; "REPEAT $WRITELN; WRITE('ANGLE: '); $READLN(ANGLE); $IF ANGLE=0 THEN GOODBYE; $REPN $BEGIN &IF COL=WHITE2 THEN COL:=WHITE 4ELSE COL:=SUCC(COL); & WHILE COL IN [BLACK,BLACK1,BLACK2,RADAR] & DO COL:=SUCC(COL); $END; "PENCOLOR(COL);  END; (* NEXTLINE *)  "  PROCEDURE GOODBYE;  BEGIN "TEXTMODE; "WRITELN; WRITELN('THAT''S ALL  PROGRAM SPIRODEMO;   USES TURTLEGRAPHICS,APPLESTUFF;   VAR "DISTANCE,ANGLE,CHANGE: INTEGER; "CH: CHAR; "COL: SCREENCOLOR; "  PROCEDURE NEXTLINE;  BEGIN "MOVE(DISTANCE); "TURN(ANGLE); "DISTANCE:=DISTANCE+CHANGE; "IF (DISTANCE MOD 40)=0 THE  PROGRAM HILBERT;   USES TURTLEGRAPHICS;   VAR SIZE,DELTA,N: INTEGER; $ORDER: INTEGER; $CH: CHAR; $  PROCEDURE HIL(I:INTEGER);  VAR A,B: INTEGER; " "PROCEDURE HIL1; "BEGIN $TURN(A); HIL(-B); TURN(A); "END; (* HIL1 *) " "PROCEDURE HIL2D[0]:=126; (* LEAD-IN *) "SEND[1]:=17; (* DC1 *) "IF X<30 THEN SEND[2]:=X+96 +ELSE SEND[2]:=X; "SEND[3]:=Y+96; "UNITWRITE(2,SEND,4);  END;   BEGIN (* DUMMY MAIN *)  END.  (*$U-*)  PROGRAM GOXY;   PROCEDURE FGOTOXY(X,Y:INTEGER);   (* HAZELTINE 1500 AND 1510 GOTOXY *)   VAR SEND: PACKED ARRAY[0..3] OF 0..255; $  BEGIN "IF X>79 THEN X:=79 "ELSE IF X<0 THEN X:=0; "IF Y>23 THEN Y:=23 "ELSE IF Y<0 THEN Y:=0; "SENO^ӟӟ" MOVETO(140-DELTA,96-DELTA); $PENCOLOR(WHITE); " HIL(ORDER); " (* WAIT FOR KEYSTROKE,THEN SWITCH TO TEXT *)  READ(KEYBOARD,CH); TEXTMODE; "UNTIL FALSE;  END.   &BEGIN (WRITELN('THAT''S ALL FOLKS...'); (EXIT(PROGRAM); &END; " INITTURTLE; $DELTA:=2; " (* CALC STARTING X,Y AND SIZE *) " FOR N:=2 TO ORDER DO DELTA:=DELTA*2; " DELTA:=DELTA-1; " SIZE:=190 DIV DELTA; " DELTA:=(DELTA*SIZE) DIV 2; END; $HIL1; HIL2; HIL1; "END;  END; (* HIL *)   BEGIN (* MAIN PROGRAM *) "WRITELN('WELCOME TO HILBERT'); "WRITELN('ENTER ORDER 0 TO QUIT.'); "REPEAT (* FOR EACH ORDER *) " WRITE('ORDER: '); READLN(ORDER); " IF (ORDER < 1) OR (ORDER > 7) THEN ; "BEGIN $MOVE(SIZE); $HIL(B); $TURN(-A); MOVE(SIZE); TURN(-A); $HIL(B); $MOVE(SIZE); "END; (* HIL2 *) "  BEGIN (* HIL *) "IF I=0 THEN TURN(180) "ELSE "BEGIN $IF I>0 THEN $ BEGIN & A:=90; B:=I-1; $ END $ELSE BEGIN &A:=-90; B:=I+1; $N^EE); /END -ELSE FILLSCREEN(REVERSE); $END; "WAIT(3000); ERASE;  END;  "  PROCEDURE GRID;  BEGIN "(* DRAW VERTICAL LINES *) "FOR I:=1 TO 27 DO $BEGIN &PENCOLOR(NONE); &MOVETO(I*10,YMAX); &PENCOLOR(WHITE); &MOVETO(I*10,0); $END; "(* DRAW HOR; &IF I=2 THEN /BEGIN 1PENCOLOR(NONE); 1MOVETO(SKIP,SKIP); 1PENCOLOR(WHITE); 1MOVETO(SKIP,YMAX-SKIP); 1MOVETO(XMAX-SKIP,YMAX-SKIP); 1MOVETO(XMAX-SKIP,SKIP); 1MOVETO(SKIP,SKIP); 1VIEWPORT(SKIP+1,XMAX-SKIP-1,SKIP+1,YMAX-SKIP-1); 1FILLSCREEN(BLACK(TURNTO(5*I); MOVE(400); &END; "WAIT(2000); "IF KEYPRESS THEN GOODBYE; "FILLSCREEN(REVERSE); "FILLSCREEN(REVERSE); " "FOR I:=0 TO 4 DO $BEGIN &SKIP:=I*15; &(* USE VIEWPORT TO SPECIFY PORTION OF SCREEN *) &VIEWPORT(SKIP,XMAX-SKIP,SKIP,YMAX-SKIP)EEN(BLACK);  END;    FUNCTION RANDCOLOR: SCREENCOLOR;  BEGIN "RANDCOLOR:=COLORS[RANDOM MOD 6];  END; " "  PROCEDURE FAN;  BEGIN "FOR J:=1 TO 3 DO $FOR I:=17 DOWNTO 1 DO &BEGIN (PENCOLOR(NONE); MOVETO(0,0); (PENCOLOR(REVERSE);  BEGIN "TEXTMODE; "READ(KEYBOARD,CH); "WRITELN; "WRITELN('THAT''S ALL FOLKS...'); "EXIT(PROGRAM);  END;  "  PROCEDURE ERASE;  BEGIN "IF KEYPRESS THEN GOODBYE; "VIEWPORT(0,XMAX,0,YMAX); "FRAME(WHITE); "VIEWPORT(1,XMAX-1,1,YMAX-1); "FILLSCROR DELAY:=1 TO TIME DO;  END;    PROCEDURE FRAME(COLOR: SCREENCOLOR);  BEGIN "PENCOLOR(NONE); MOVETO(0,0); "PENCOLOR(COLOR); "MOVETO(0,YMAX); MOVETO(XMAX,YMAX); "MOVETO(XMAX,0); MOVETO(0,0);  PENCOLOR(NONE);  END;    PROCEDURE GOODBYE; TYPE PICTURE=PACKED ARRAY[0..53,0..120] OF BOOLEAN;   VAR I,J,K,SKIP,ROW: INTEGER; $CH: CHAR;  COLORS: ARRAY[0..5] OF SCREENCOLOR;  BUTTER: PICTURE;  BIT: BOOLEAN;    PROCEDURE WAIT(TIME:INTEGER);  VAR DELAY: INTEGER;  BEGIN "F *)  (***************************************************************)   USES TURTLEGRAPHICS,APPLESTUFF;   CONST XMAX=279; &YMAX=191; &XMID=140; &YMID=96; & ANSWER SOME OF YOUR QUESTIONS. *)  (* *)  (* MANY THANKS TO THE FINE TEAM AT UCSD. *)  (* ENJOY YOUR NEW PASCAL SYSTEM. BILL ATKINSON, MAY 5 1979 *)  (* SHOWING THE USE OF *)  (* ROUTINES IN TURTLEGRAPHICS AND APPLESTUFF UNITS. *)  (* *)  (* IT DOES HAVE A DESCRIPTION OF DRAWBLOCK TOWARD THE END. *)  (* I HOPE IT HELPS TO  (*$S+*) (* USE SWAPPING OPTION FOR LARGE PROGRAMS *)   PROGRAM GRAFDEMO;  (***************************************************************)  (* *)  (* THIS IS A HURRIDLY-WRITTEN EXAMPLE IZONTAL LINES *) "FOR I:=18 DOWNTO 1 DO $BEGIN &PENCOLOR(NONE); &MOVETO(0,I*10); &PENCOLOR(WHITE); &MOVETO(XMAX,I*10); $END; "WAIT(2000); "FILLSCREEN(REVERSE); "FILLSCREEN(REVERSE); "WAIT(2000); ERASE;  END;  " PROCEDURE DIAGONALS;  BEGIN "TURNTO(45); $FOR I:=-19 TO 27 DO &BEGIN (PENCOLOR(NONE); (MOVETO(I*10,0); (PENCOLOR(WHITE); (MOVE(500); &END; $WAIT(2000); ERASE;  END;  $  PROCEDURE SPIRAL;  BEGIN "PENCOLOR(NONE); MOVETO(XMID,YMID); "TURNTO(0); PENCOLOR(RANDCOLOR); "FO ');  STUFF(BUTTER,' X X--- - **** XX ');  STUFF(BUTTER,' X* --- - ***** X ');  STUFF(BUTTER,' X ** ****** XX ');  STUFF(B ****XX ');  STUFF(BUTTER,' X X ----- --- --- **** X ');  STUFF(BUTTER,' X X ---------------- - ***XX ');  STUFF(BUTTER,' X X----- --- --- - ** * X  STUFF(BUTTER,' X XX ----- ----- - * * XX ');  STUFF(BUTTER,'X XXX ------ ---- ** XX ');  END;   PROCEDURE BUTTER2;  BEGIN  STUFF(BUTTER,' X X --- ------------ --- * * X ');  STUFF(BUTTER,' X XXXX ---------- *** XX ');  STUFF(BUTTER,' X XXX -- --------- -- *** XX '); XXXX ---- XX ');  STUFF(BUTTER,' XXX XXXXX --- * X ');  STUFF(BUTTER,' XX XXXXX --- ** XX ');  STUFF(BUTTER,' X XXXX X XXXXXX X ');  STUFF(BUTTER,'XX XXXXXXX *X ');  STUFF(BUTTER,' XX XXXXXX ----- * X ');  STUFF(BUTTER,' X X X STUFF(BUTTER,' XX XXXXXXX X ');  STUFF(BUTTER,' XX XXXXXXX X ');  STUFF(BUTTER,' X XXXXXXX X ');  STUFF(BUTTER,'BUTTER,' XX XXXXXXXXXXX ');  STUFF(BUTTER,' XXX XXXXXXXXXXXXXXXXXXXXX ');  STUFF(BUTTER,' XXXXXXXXXXXXXXXX XXXXXXXXX XX '); ITMAP FORM STRINGS *)  VAR J: INTEGER;  BEGIN "FOR J:=1 TO LENGTH(S) DO $BEGIN &BIT:=(S[J]<>' '); &BITMAP[ROW,J+59]:=BIT; " BITMAP[ROW,60-J]:=BIT; (* SYMMETRIC *) $END; "ROW:=ROW-1;  END;  "  PROCEDURE BUTTER1;  BEGIN "ROW:=53;  STUFF(E); "FOR I:=1 TO 40 DO $BEGIN &MOVETO((RANDOM MOD 400)-50,(RANDOM MOD 300)-50); &TURNTO(0); &POLYGON((RANDOM MOD 9)+3,(RANDOM MOD 40)+5); $END; "WAIT(4000); ERASE;  END;    PROCEDURE STUFF(VAR BITMAP: PICTURE; S:STRING);  (* MAKE BUTTERFLY B"(* SKIP POLYGONS WHICH DON'T CLOSE ALL THE WAY *) "IF (ANG*SIDES)<>360 THEN EXIT(POLYGON); "PENCOLOR(WHITE);  FOR I:=1 TO SIDES DO $BEGIN &MOVE(EDGE); &TURN(-ANG); $END; "PENCOLOR(NONE);  END; "   PROCEDURE POLYGONS;  BEGIN "PENCOLOR(NONTHEN BEGIN ) TURN(180); & PENCOLOR(RANDCOLOR); . I:=I+1; .END &ELSE TURN((RANDOM MOD 45)-22); &MOVE(10); $END; "ERASE;  END;  "  PROCEDURE POLYGON(SIDES,EDGE: INTEGER);  VAR I,ANG: INTEGER;  BEGIN "ANG:=360 DIV SIDES; EX<0) OR (TURTLEY<0) OR (TURTLEY>YMAX); "ERASE;  END;  $  PROCEDURE WALLBUMP;  BEGIN "PENCOLOR(NONE); MOVETO(XMID,YMID); "PENCOLOR(WHITE); "I:=0; "WHILE I<40 DO $BEGIN &IF (TURTLEX>XMAX) )OR (TURTLEX<0) )OR (TURTLEY>YMAX) )OR (TURTLEY<0) )R I:=1 TO 300 DO $BEGIN &MOVE(I); &TURN(-45); $END; "WAIT(2000); ERASE;  END;  $  PROCEDURE SQUIGGLE;  BEGIN "PENCOLOR(NONE); MOVETO(XMID,YMID); "PENCOLOR(WHITE); "REPEAT $TURN((RANDOM MOD 90)-60); $MOVE(3); "UNTIL (TURTLEX>XMAX) OR (TURTLUTTER,'XXX XX** * ****** X ');  STUFF(BUTTER,' X XX*** ***** XX ');  STUFF(BUTTER,' XXI XX *** *** *** X ');  STUFF(BUTTER,'XXX X I XX** **** ***** * XX ');  STUFF(BUTTER,' X X II XX **** ** ** * * *** ***** X ');  STUFF(BUTTER,' X X II XX ******** *** ** ***** **** XX ');  STUFF(BUTTER,' *)  (* CURRENT SCREEN SOURCE RESULTANT SCREEN *)  (* I---------------I---------------I---------------I *)  (* I FALSE I FALSE I LSB MODE I * *)  (* *)  (* MODE RANGES 0..15 TO FILL IN THE FOLLOWING TRUTH TABLE: *)  (*  (* 6. HEIGHT IN DOTS *)  (* 7. XSCREEN WHERE TO PUT IT ON THE HIRES SCREEN (0..279) *)  (* 8. YSCREEN " " (0..191) *)  (* 9. MODE BEFORE TRANSFERING *)  (* 4. YSKIP HOW MANY ROWS TO SKIP *)  (* 5. WIDTH IN DOTS *) RS TO DRAWBLOCK ARE: *)  (* 1. SOURCE ARRAY NAME *)  (* 2. ROWSIZE IN BYTES 2*(( DOTSWIDE+15 ) DIV 16 ) *)  (* 3. XSKIP HOW MANY DOTS TO SKIP ROCEDURE INITBUTTERFLY;  BEGIN "BUTTER1; "BUTTER2; "BUTTER3;  BUTTER4;  END;   (************************************************************************)  (* *)  (* PARAMETE STUFF(BUTTER,' XXXXXIII X ');  STUFF(BUTTER,' X X ');  STUFF(BUTTER,' XX ');  END;    PUTTER,' X I I 00 III X ');  STUFF(BUTTER,' X IIII I X ');  STUFF(BUTTER,' X I I XXXX '); ');  STUFF(BUTTER,' X X I 0 I 00 I 00 I X ');  STUFF(BUTTER,' X X I 0 I I I X ');  STUFF(BUTTER,'X X I I 0 I I X ');  STUFF(BXXXX X X I I I 00 I IX ');  STUFF(BUTTER,' X XX I I 0 I 00 I I X ');  END;   PROCEDURE BUTTER4;  BEGIN  STUFF(BUTTER,'XXX X I I 000 I II X  STUFF(BUTTER,'XXXXXX X I III I II 0 I X ');  STUFF(BUTTER,' X X X II I III II 0 I X ');  STUFF(BUTTER,' X X X II I I 00 II 0 I X ');  STUFF(BUTTER,'F(BUTTER,' XX X I I I 0 I XXXXXXXXX ');  STUFF(BUTTER,' XX X II I 00 I X XXXX ');  STUFF(BUTTER,' XX X I I II 000 I X '); ;  BEGIN  STUFF(BUTTER,' X X III IIIIXXX *** XX ');  STUFF(BUTTER,' X X I I I II XXX XX ');  STUFF(BUTTER,'XXXX X III I II XXXX XX ');  STUF X X I I IXX* ************ ***** ** X ');  STUFF(BUTTER,'XXXX X II I XX ***** ****** ***** XX ');  STUFF(BUTTER,' X X I I I XX ****** **** XX ');  END;    PROCEDURE BUTTER3)  (* I---------------I---------------I---------------I *)  (* I FALSE I TRUE I I *)  (* I---------------I---------------I---------------I *)  (* I TRUE I FALSE I I *)  (* I---------------I---------------I---------------I *)  (* I TRUE I TRUE I MSB MODE I *)  (* I------ITE); MOVETO(L,T); "MOVETO(R,T); MOVETO(R,B); MOVETO(L,B); "PENCOLOR(NONE); MOVETO(L+3,B+2); "WSTRING(S);  END;    PROCEDURE WRITECHARS;  VAR HORIZ,VERT,ASCII: INTEGER;  BEGIN "INITTURTLE; "ASCII:=0; "FOR VERT:=0 TO 18 DO $BEGIN &MOVETO(0,1*****************************)  VAR L,R,B,T: INTEGER;  BEGIN "PENCOLOR(NONE); MOVETO(X,Y); "L:=X-3; R:=X+2+7*LENGTH(S); "B:=Y-2; T:=Y+10; "VIEWPORT(L,R,B,T); "FILLSCREEN(BLACK); "VIEWPORT(0,279,0,191);  PENCOLOR(NONE); MOVETO(L,B); "PENCOLOR(WH  PROGRAM GRAFCHARS;   USES TURTLEGRAPHICS;   PROCEDURE BOXSTRING(X,Y: INTEGER; S: STRING);  (********************************)  (* *)  (* WRITE A STRING IN ERASED BOX *)  (* *)  (***N^fND.  " " "  ; "COLORS[0]:=WHITE; "COLORS[1]:=REVERSE; "COLORS[2]:=GREEN; "COLORS[3]:=VIOLET; "COLORS[4]:=ORANGE; "COLORS[5]:=BLUE; " "REPEAT $FAN; $GRID; $SPIRAL; $SQUIGGLE; $DIAGONALS; $WALLBUMP; " POLYGONS; $FLUTTER; "UNTIL KEYPRESS; "GOODBYE;  ERAWBLOCK(BUTTER,16,0,0,120,54, 10, 64, 6); "DRAWBLOCK(BUTTER,16,0,0,120,54,150, 0, 6);  END;    BEGIN "WRITELN('PRESS ANY KEY TO QUIT.'); "WRITELN('PLEASE WAIT WHILE CREATING BUTTERFLY'); "INITBUTTERFLY; "INITTURTLE; "FRAME(WHITE); "RANDOMIZE"FILLSCREEN(REVERSE); "(* USE XOR MODE TO REMOVE ONE AT A TIME *) "DRAWBLOCK(BUTTER,16,0,0,120,54, 10, 0, 6); "DRAWBLOCK(BUTTER,16,0,0,120,54,150, 64, 6); "DRAWBLOCK(BUTTER,16,0,0,120,54, 10,128, 6); "DRAWBLOCK(BUTTER,16,0,0,120,54,150,128, 6); "D4); "DRAWBLOCK(BUTTER,16,0,0,120,54, 10,128,14); "DRAWBLOCK(BUTTER,16,0,0,120,54,150,128,14); "DRAWBLOCK(BUTTER,16,0,0,120,54, 10, 64,14); "DRAWBLOCK(BUTTER,16,0,0,120,54,150, 0,14); "WAIT(8000); FILLSCREEN(REVERSE); WAIT(3000); *)  (************************************************************************)    PROCEDURE FLUTTER;  BEGIN "(* DRAW SIX BUTTERFLIES *) "DRAWBLOCK(BUTTER,16,0,0,120,54, 10, 0,14); "DRAWBLOCK(BUTTER,16,0,0,120,54,150, 64,1---------I---------------I---------------I *)  (* *)  (* FOR EXAMPLE, MODE 0=FILL BLACK, 10=COPY SOURCE, 14=OR, 6=XOR, ETC. *)  (* 80-VERT*10); &FOR HORIZ:=0 TO 39 DO (BEGIN *WCHAR(CHR(ASCII)); *ASCII:=(ASCII+1) MOD 128; (END; " END; "READLN;  END;  " "  PROCEDURE YOUTOO;  VAR I: INTEGER;  BEGIN "INITTURTLE; "PENCOLOR(WHITE); "FOR I:=1 TO 300 DO $BEGIN &MOVE(I); &TURN(-89); $END; "BOXSTRING(20,92,'YOU TOO CAN MIX TEXT AND GRAPHICS'); "READLN;  END; "   PROCEDURE CIRCLE;  VAR I: INTEGER;  BEGIN "INITTURTLE; "MOVETO(119,104); WSTRING('POSITION'); "MOVETO(112,92); WSTRING('CHARACTERS'); "MOVETO(119,80)"BEGIN $WRITE(G,' ',W.KEY); $X:=W.FIRST; L:=0;  REPEAT &IF L=C2 THEN (BEGIN *WRITELN(G); *L:=0; WRITE(G,' ':C1+1) (END; (L:=L+1; WRITE(G,X^.LNO:C3); X:=X^.NEXT; $UNTIL X=NIL; $WRITELN(G); "END; (* PRINTWORD *)  BEGIN (* PRINTTREE *) .LEFT) ELSE $IF ID>W^.KEY THEN SEARCH(W^.RIGHT) ELSE $BEGIN NEW(X); X^.LNO:=N; X^.NEXT:=NIL; *W^.LAST^.NEXT:=X; W^.LAST:=X; $END;  END; (* SEARCH *)   PROCEDURE PRINTTREE(W: WORDREF); "PROCEDURE PRINTWORD(W: WORD); "VAR L: INTEGER; X: ITEMREF;  VAR W: WORDREF; X: ITEMREF;  BEGIN W:=W1; "IF W=NIL THEN " BEGIN &NEW(W); &NEW(X); &WITH W^ DO (BEGIN *KEY:=ID; LEFT:=NIL; RIGHT:=NIL; *FIRST:=X; LAST:=X; (END; &X^.LNO:=N; X^.NEXT:=NIL; W1:=W; $END "ELSE $IF ID NIL THEN $BEGIN &PRINTTREE(W^.LEFT); &PRINTWORD(W^); &PRINTTREE(W^.RIGHT); $END;  END; (* PRINTTREE *)    BEGIN (* MAIN *)  ROOT:=NIL; N:=0; K1:=C1; "WRITE('INPUT FILE? '); "READLN(SOURCE); "IF POS('.',SOURCE)=0 THEN SOURCE:=CONCAT(SOURCE,'.TEXT'); "RESET(F,SOURCE); "WRITE('DESTINATION FILE? '); "READLN(DEST); "REWRITE(G,DEST); "WHILE NOT EOF(F) DO "BEGIN IF N=C4 THEN N:=0; $N:=N+1; WRITE(G,N:C3); $WRITE(G,': '); $WHILE NOT EOLN(5IF P2^.BAL=+1 THEN P1^.BAL:=-1 ELSE P1^.BAL:=0; 5P:=P2; 3END; 1P^.BAL:=0; H:=FALSE; /END; (* CASE -1 *) / *END; (* CASE *) &END (* IF WP^.WORD THEN &BEGIN (INSERTIT(W,P^.RIGHT,H); (IF H THEN (* RIGHT BRANCH HAS GROWON *) 5P^.LEFT:=P1^.RIGHT; 5P1^.RIGHT:=P; 5P^.BAL:=0; 5P:=P1; 3END 1ELSE 3BEGIN (* DOUBLE LR ROTATION *) 5P2:=P1^.RIGHT; 5P1^.RIGHT:=P2^.LEFT; 5P2^.LEFT:=P1; 5P^.LEFT:=P2^.RIGHT; 5P2^.RIGHT:=P; 5IF P2^.BAL=-1 THEN P^.BAL:=+1 ELSE P^.BAL:=0; (INSERTIT(W,P^.LEFT,H); (IF H THEN (* LEFT BRANCH HAS GROWN *) *CASE P^.BAL OF ,1: BEGIN 1P^.BAL:=0; 1H:=FALSE; /END; (* CASE1 *) / ,0: P^.BAL:=-1; + +-1: BEGIN (* REBALANCE *) 1P1:=P^.LEFT; 1IF P1^.BAL=-1 THEN 3BEGIN 5(* SINGLE LL ROTATI,P2: NODEPTR;  BEGIN "IF P=NIL THEN (* MAKE NEW NODE *) $BEGIN &NEW(P); H:=TRUE; &WITH P^ DO (BEGIN *LEFT:=NIL; *RIGHT:=NIL; *WORD:=W; *BAL:=0; $ END; $END " "ELSE (* CHASE DOWN TREE FURTHER *) $IF W=K1 THEN K1:=K *ELSE ,REPEAT .A[K1]:=' '; .K1:=K1-1; ,UNTIL K1=K; *ID:=A; SEARCH(ROOT); (END &ELSE (BEGIN *CH:=F^; WRITE(G,CH); GET(F); (END; $END; (* WHILE NOT EOLN *) $WRITELN(G); GET(F); "END; (* WHILE NOT EOF *) "PAGE(G); PRINTTF) DO $BEGIN (* SCAN NON-EMPTY LINE *) &CH:=F^; &IF CH IN ['A'..'Z','a'..'z'] THEN (BEGIN *K:=0; *REPEAT ,IF K4 THEN WRITE(CHR(7)); (* BEEP *) &IF LEVEL<=4 THEN (BEGIN *PENCOLOR(NONE); MOVETO(X+44,Y+3); *PENCOLOR(WHITE); MOVETO(X+56,Y+DELTAY[LEVEL]); *SHOWTREE(P^.LEFT,LEVEL+1); *PENCOLOR(NONE); MOVETO(X+44,Y-3); *PENCOLOR(WHIT "MOVETO(X,Y-5); MOVETO(X,Y); "PENCOLOR(NONE); MOVETO(X+2,Y-4); "WSTRING(W); MOVETO(X,Y);  END;     PROCEDURE SHOWTREE(P: NODEPTR; LEVEL: INTEGER);  VAR X,Y: INTEGER;  BEGIN "IF P<>NIL THEN $BEGIN &X:=TURTLEX; &Y:=TURTLEY; ^.WORD); &PRINTTREE(P^.RIGHT); $END;  END;    PROCEDURE BOXWORD(W: WORDSTRING);  (* BEGIN AND END PEN AT LEFT OF BOX *)  VAR X,Y: INTEGER;  BEGIN "X:=TURTLEX; Y:=TURTLEY; "PENCOLOR(WHITE); MOVETO(X,Y+5); "MOVETO(X+44,Y+5); MOVETO(X+44,Y-5); 3END; 3P^.BAL:=0; H:=FALSE; /END; (* CASE1 *) * *END; (* CASE *) &END (* IF W>P^.WORD *) & $ELSE H:=FALSE;   END; (* INSERTIT *) " " " " 5  PROCEDURE PRINTTREE(P: NODEPTR);  BEGIN "IF P<>NIL THEN $BEGIN &PRINTTREE(P^.LEFT); &WRITELN(P{$SETC APPLE := 2} {$S-}   { The Apple Pascal system has a linefeed flag at location BF0F hex. If "this flag is set to 255 (FF hex), line feeds will be suppressed. If "it is set to 0 (default), line feeds will be passed. } "  PROGRAM LINEFEED;  ġ    :f t-ȡ + > nj`,ȡ-D nj`Z<ȡ2ġ ǐ  ȡrǿ áNǿǿǿ   Ǹ  ȡ ǿȡǿǿ6צTHAT'S ALL FOLKS...Hǿ ǿ  2 p GRAFDEMO CODEe3RTEXTׯ Z ~ ]P ?~ KL$7?.ת.ׯۓ2Save as . JY LINEFEED.TEXTttfr*:>t|t+|LPtt A2/UTILITIEStJJ|r]tJJ]t] d44^2 ^2ECommand: E(dit, R(un, F(ile, C(omp, L(ink, X(ecute, A(ssem,L@",Compile what text? A" Compiling... d44Q4 LINEFEED.CODEODE[*]t\JJz^to^EJ P:A2/UTILITIESBBBBBBBBBBBBBBBB&LINEFEED "TYPE PA=PACKED ARRAY[0..1] OF 0..255; 'TWOFACE=RECORD CASE BOOLEAN OF 1TRUE:(INT:INTEGER); 1FALSE:(PTR:^PA); /END; / "VAR CHEAT:TWOFACE; "  BEGIN "CHEAT.INT:=-16625; {BF0F hex} "CHEAT.PTR^[0]:=255 {Set flag}  END.   ɍ ɍ ǿō9P nj`(ɡK  ɍ ǿō ɍǴ - Tn hنُhˡ ȡڑ B (ȡ8ǐ2,2 ( ǠFXتP,-,-ȡ=, ˫5,;x5<,x,,LV b5< XX XXXXXXXXXXX צ< X I I XXXX < XXXXXIII X צ< X X < XX  I I X P^.WORD THEN INSERTIT(W,P^.RIGHTPTR); &IF WNIL THEN $BEGIN &PRINTTREE(P^.LEFTPTR); &WRITELN(P^.WORD); NG; $W: WORDSTRING; $DELTAY: ARRAY[0..4] OF INTEGER; $   PROCEDURE INSERTIT(W: WORDSTRING; VAR P: NODEPTR);  BEGIN "IF P=NIL THEN (* MAKE NEW NODE *) $BEGIN &NEW(P); &P^.LEFTPTR:=NIL; &P^.RIGHTPTR:=NIL; &P^.WORD:=W; $END "ELSE (* CHASE DOWN***********************)   USES TURTLEGRAPHICS;   CONST WORDLENGTH=6;  CONSOLE=1;   TYPE WORDSTRING=STRING[WORDLENGTH]; %NODEPTR=^NODE; %NODE=RECORD ,WORD: WORDSTRING; ,LEFTPTR,RIGHTPTR: NODEPTR; *END; *  VAR ROOT: NODEPTR; $S: STRI   PROGRAM TREE;   (**************************************)  (* *)  (* MAKE AND PLOT A SIMPLE BINARY TREE *)  (* (PROGRAM BY BILL ATKINSON) *)  (* *)  (***************N^ffō+צTHAT'S ALL FOLKS...ȡ Ǿ놫nj` ^  ^*آ*Í k vޢ̶,áǴš Z Z4צWELCOME TO HILBERTצENTER ORDER 0 TO QUIT.צORDER:  0HILBERT \*x6 x6ǖ@x6 ǀx6ǖǀx6 @x6ǖ@ Ǹ  x6 x6ǖ@x6 ǀx6ǖǀx6 @x6ǖPRESS AETO(X,Y-5); MOVETO(X,Y); "PENCOLOR(NONE); MOVETO(X+2,Y-4); "WSTRING(W); MOVETO(X,Y);  END;     PROCEDURE SHOWTREE(P: NODEPTR; LEVEL: INTEGER);  VAR X,Y: INTEGER;  BEGIN "IF P<>NIL THEN $BEGIN &X:=TURTLEX; &Y:=TURTLEY; &BOXWORD(P^.WORD); &IF LEVEL>4 THEN WRITE(CHR(7)); (* BEEP *) &IF LEVEL<=4 THEN (BEGIN *PENCOLOR(NONE); MOVETO(X+44,Y+3); *PENCOLOR(WHITE); MOVETO(X+56,Y+DELTAY[LEVEL]); *SHOWTREE(P^.LEFTPTR,LEVEL+1); *PENCOLOR(NONE); MOVETO(X+44,Y-3); *PENCOLOR(WHITE); MOVETO(X+56,ꂫ(á á4@צTHAT'S ALL FOLKS...>צWELCOME TO WHILEPLOTצENTER ANGLE 0 TO QUIT.צANGLE: pSPIRODEM ȡR,8ڥ1,8ڥ1צTHAT'S ALL FOLKS...>1011 11 ENTER WORD: &Páȡ--66-צTHE WORDS IN ORDER ARE:Ǫ BINARY TREE:`  .4xd  š ȡR,8ڥ1,8ڥ1צTHAT'S ALL FOLKS...>1011 11 ENTER WORD: &٪á L؟ˡ(ت  ,, \ٟˡw  š 0TREE D.   OT); $WRITELN; $WRITELN('THE WORDS IN ORDER ARE:'); $PRINTTREE(ROOT); $WRITELN; READLN; $INITTURTLE; MOVETO(0,170); $WSTRING('BINARY TREE:'); $MOVETO(0,96); $SHOWTREE(ROOT,0); " READLN; TEXTMODE; "UNTIL FALSE; (* TILL ZERO LENGTH EXIT *)  EN"DELTAY[2]:=12; "DELTAY[3]:=6; "DELTAY[4]:=3; " "REPEAT $WRITE('ENTER WORD: '); $UNITCLEAR(CONSOLE); (* NO TYPE-AHEAD *) $READLN(S); $IF LENGTH(S)=0 THEN GOODBYE; $IF LENGTH(S)<=WORDLENGTH THEN W:=S &ELSE W:=COPY(S,1,WORDLENGTH); $INSERTIT(W,ROY-DELTAY[LEVEL]); *SHOWTREE(P^.RIGHTPTR,LEVEL+1); $ END; $END;  END;    PROCEDURE GOODBYE;  BEGIN "TEXTMODE; "WRITELN; WRITELN('THAT''S ALL FOLKS...'); "EXIT(PROGRAM);  END;    BEGIN "ROOT:=NIL; "DELTAY[0]:=48; "DELTAY[1]:=24;  áצCHANGE:  š ɡ   XP )(.r*Í k vޢdGRAFCHAR Y\צ!YOU TOO CAN MIX TEXT AND GRAPHICSG^whצPOSITIONp\ CHARACTERSwPצANYWHEREǴ,ȡnj\U*oצPRESS RETURN FOR MORE...THAT'S ALL FOLKS...zv 0.0.Zȡ1Ǵ 'ȡǀ@, V,ȡY\צ!YOU TOO CAN MIX TEXT AND GRAPHICSG^whצPOSITIONp\ CHARACTERSwPצANYWHEREǴ,ȡnj\U*oצPRESS RETURN FOR MORE...تP0/. -0/.-  ǿ 0.0-/-/.0.0.Zȡ1Ǵ 'ȡǀ@, V,ȡ0