`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JO^<Ӥvg TURTLE.CODEvg READ.ME.TEXT{READ.ME.TEXT{ik SHOWFOTO.CODEvgks CONCORD.TEXTvgӤsv CONCORD.CODEvgӤv DISKDUMP.TEXTvg㤂 DISKDUMP.CODEvg㤆 STARTUP.TEXTvg㤐 STARTUP.CODEvg㤔SNOWFLAKE.TEXTgSNOWFLAKE.CODEg TURTLE.TEXTPSCAL19 EPSON.UNIT.TEXTӤ EPSON.UNIT.CODEӤ SMARTERM.TEXTvgӤ SMARTERM.CODEvgӤ* CHAREDIT.TEXTvg*1 CHAREDIT.CODEvg1W GRAFEDIT.TEXTvgWc GRAFEDIT.CODEvgci SHOWFOTO.TEXTvg&꽌ɪɖ'*&%&,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 EPSON; INTRINSIC CODE 17;  {REQUIRES AN INTERACTIVE STRUCTURES EP12 INTERFACE BOARD}   INTERFACE   TYPE #POLARITY = (POSITIVE,NEGATIVE); #CENTERING = (CENTER,LEFT); #ROTATION = (ROT,NOROT); #PRINT_SIZE = (LO^1ӤˡáRH6L^| PROCEDURE CHANGECOLS(NUM_COLUMNS:INTEGER);  PROCEDURE PRINTPIC(POL:POLARITY; CENT:CENTERING; 3ROTATE:ROTATION; SIZE:PRINT_SIZE);    IMPLEMENTATION E L2:SYSTEM.SWAPDISK- P ,0,0ȡ-,,,,,-,ؿ,ɡ,,-,- %[\ á M MáMMáMMF ˡˡOPTIONS_SWITCH);  PROCEDURE DBLSTRIKE(SWITCH:OPTIONS_SWITCH);  PROCEDURE CHANGECOLS(NUM_COLUMNS:INTEGER);  PROCEDURE PRINTPIC(POL:POLARITY; CENT:CENTERING; 3ROTATE:ROTATION; SIZE:PRINT_SIZE);    IMPLEMENTATION L E L2:SYSTEM.SWAPDISK   TYPE #POLARITY = (POSITIVE,NEGATIVE); #CENTERING = (CENTER,LEFT); #ROTATION = (ROT,NOROT); #PRINT_SIZE = (LARGE,SMALL); #OPTIONS_SWITCH = (ON,OFF);   PROCEDURE EMPHASIS(SWITCH:OPTIONS_SWITCH);  PROCEDURE ITALICS(SWITCH:BB@ EPSON  begin {main}  end. ;  var #num : integer;  begin  num := 0; #if cent <> CENTER then num := 8; #if rotate <> ROT then num := num + 4; #if size <> LARGE then num := num + 2; #if pol = POSITIVE &then send_cmd(num, 'R') &else send_cmd(num, 'H')  end; {printpic}  (5, 'M')  end; {italics}   procedure dblstrike;  begin #if switch = ON &then send_cmd(14, 'M') &else send_cmd(15, 'M')  end; {dblstrike}   procedure changecols;  begin #send_cmd(num_columns, 'F')  end; {changecols}    procedure printpic#unitwrite(6, chars, 5, 0, 12)  end; {send_cmd}   procedure emphasis;  begin #if switch = ON &then send_cmd(12, 'M') &else send_cmd(13, 'M')  end; {emphasis}   procedure italics;  begin #if switch = ON &then send_cmd(4, 'M') &else send_cmd= chr(9); {wake-up mx80 and/or controller} #str(n,s); #for i := 1 to length(s) do chars[i+1] := chr(ord(s[i])); #i := 2 + length(s); {next free character in chars} #chars[i] := cmd; #while i < 5 do begin &i := i + 1; &chars[i] := chr(0) #end; ITY; CENT:CENTERING; 3ROTATE:ROTATION; SIZE:PRINT_SIZE);    IMPLEMENTATION   type ch_array = packed array [1..5] of char;  procedure send_cmd(n : integer; cmd : char);  var s : string;  i : integer; $chars : ch_array;  begin #chars[1] :ARGE,SMALL); #OPTIONS_SWITCH = (ON,OFF);   PROCEDURE EMPHASIS(SWITCH:OPTIONS_SWITCH);  PROCEDURE ITALICS(SWITCH:OPTIONS_SWITCH);  PROCEDURE DBLSTRIKE(SWITCH:OPTIONS_SWITCH);  PROCEDURE CHANGECOLS(NUM_COLUMNS:INTEGER);  PROCEDURE PRINTPIC(POL:POLAR BEGINDECENDDEC ENDMAIN BEGINMAIBEGINGETENDGET BEGINDISENDDIS GETSTARTGETEND /"/!0 0O^1PASCAL1SYSTEM.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;  {$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 Charedit;   {This program edits the SYSTEM.CHARSET, or similar file from any disk.}  {It does not do the 'half-dot shift' that the Pascal Animation editor }  {can do, but the standard turtlegraphics drawing routines do not show }  {this shi) &end; &for row := 0 to maxrows - 1 do begin {neatly write row # on screen} )str(row*10,tempstr); )moveto(21-7*length(tempstr),ymax-spacey*row); )tempstr:=concat(tempstr,':'); )wstring(tempstr) &end; &for index := 0 to numchars do begin )row := i question} &i: integer; # #begin {long routine so it can nicely display characters} &initturtle; &seehires; &for col := 0 to maxcols - 1 do begin {write columns across screen} )moveto(xstart+spacex*col,ymax+16); )str(col,tempstr); )wstring(tempstr# index: 0..numchars; &xscreen: 0..xmax; {position for next blockwrite} &yscreen: 0..ymax; {ditto} &col: 0..maxcols; &row: 0..maxrows; &tempstr: string; {used for wstring function} &ch: char; {for printode = 10; {write over screen contents} &maxcols = 10;maxrows = 13; {display format for 80-col screen} &spacex = 20;spacey = 12; {spacing for blockwrite on screen} &xstart = 35; {space past indexes} #var #end; {put_charset} {to get it fixed w/o losing everything.} # #Procedure Display; #const &xmax = 279;ymax = 167; &rowsize = 1; {for blockwrite} &xskip = 0;yskip = 0; {ditto} &width = 7;height = 8; {ditto} &mn begin )writeln(chr(7),'I/O error # ',temp); )exit(putcharset) &end;  {$i-} close(workfile,lock); {$i+}  temp:=ioresult; &if temp=0 then exit(program); {we're through - quit} &write(chr(7),'I/O error # ',temp) {don't crap out on error - try} )outname := 'apple2:system.charset'; &if outname = '$' then outname := inname; & &workfile^ := character;  {$i-} {don't croak on error} &rewrite(workfile,outname); &put(workfile);  {$i+} temp := ioresult; {save ioresult to print} &if temp <> 0 theset} # # # #Procedure Put_charset; #var temp:integer; #begin &writeln; &write('Enter filename ( escapes, ''*'', ''$'') :'); &readln(outname); &if length(outname)=0 then exit(putcharset); &if outname = '*' then w figure out what happened} & &if ioresult <> 0 then begin )getcharset := false; )writeln('File not found.'); &end &else begin )getcharset := true; )character := workfile^; {move all 128 chars from buffer} &end; &close(workfile); #end; {get_char); &if length(inname) = 0 then exit(program); {abort on null} &if inname = '*' then inname := 'apple2:system.charset'; {default}   {$i-} {turn off error check so prog can do it} &reset(workfile,inname); {recall 'reset' also does a 'get'}  {$i+} {no#c: char; #foundfile: boolean; #clearline, #escape: char; # #(* has_silent: boolean; {if you've got one} *) # # # #Function Get_charset: boolean; #begin &write('File to edit ( quits, ''*'' defaults) :'); &readln(innamerray [0..numchars] of charimage; #charfile = file of charset;  Var #character: charset; {this is the 128 characters to be munched} #workfile: charfile; {SYSTEM.CHARSET or similar} #outname: string; {file names} #inname: string; write to your input file. }   Uses turtlegraphics,smarterm (* ,silentype *);  Const #numchars = 127; #clr_line = 29; #esc = 27; { }  Type #charimage = packed array[0..7] of 0..255; {treat as byte array, unpack later} #charset = packed aft anyway. See READ.ME.TEXT for notes on the smarterm unit. }  {When started it will ask for the file to edit. '*' defaults to }  {Apple2:System.Charset -- change as necessary. On exit, '*' writes }  {to that same default file, while '$' willndex div maxcols; )col := index - row * maxcols; )xscreen := spacex*col+xstart; {char pos. on screen} )yscreen := ymax - spacey*row; )drawblock(character[index],rowsize,xskip,yskip, ,width,height,xscreen,yscreen,mode) &end; {for}   (* &if has_silent then begin )moveto(0,0); )wstring('Would you like to print this file? :'); read(ch); )if ch='y' then begin ,setnegative; ,printpic )end {begin print} &end; {has_printer routine}  *) & &read(ch); &seetext; &exit(display) {return newcode(index); &repeat {until hit} )cursoroff; {don't have an irritating display} )gotoxy(0,0); {home, don't clear screen} )write('Edit: C(hange, A(dvance, P(revious, N(ew, '); )write('D(isplay, exits:',clearline); )cursoron; )read(c) then word := word + ctr; :ctr := ctr*2 7end; 7character[index,row]:=word 4end; 4ch:=escape {force exit} 1end , ,end {case} )until ch = escape &end; {change} * # # #begin {edit} &index := 0; {char # 0 first} &page(output); {clear field} &7end; 7row := 7;col := 0 {reset cursor} 4end; / /27 {escape}: showchar(index); {redraw figure before exit} / /3 {etx}: begin {recode bytes} 4for row := 7 downto 0 do begin 7word := 0; 7ctr := 1; 7for col := 0 to 6 do begin :if newchar[row,col]/ /75,107 {k}:if col < 6 then col := col + 1; / /77,109 {m}:if row > 0 then row := row - 1; / /90,122 {zero}:begin 4for row := 7 downto 0 do 7for col := 0 to 6 do begin :newchar[row,col] := false; :gotoxy(startx+2*col,starty-row); :write('.') ; ,case ord(ch) of /32 {space}:begin 4newchar[row,col] := false; 4write('.') 1end; 1 /83,115 {set}:begin 4newchar[row,col] := true; 4write('*') 1end; 1 /73,105 {i}:if row < 7 then row := row + 1; / /74,106 {j}:if col > 0 then col := col - 1; or in the upper left} )gotoxy(0,0); )write('Change: clears, S(et, [i,j,k,m move],'); )write(' Z(ero, accepts, aborts.',clearline); )cursoron; {make sure cursor is visible} )repeat ,gotoxy(startx+2*col,starty-row); ,read(keyboard,ch))write('Edit which ASCII code: ',clearline); )index := getnum(index); )showchar(index) &end; {newcode} % % % &Procedure Change(var index: integer); &var )ch: char; )col,row: integer; )ctr: integer; &begin )row := 7; )col := 0; {position cursf changed and (new_value <= maxsize) ,then getnum := new_value ,else getnum := old_value {don't change if or illegal value} &end; {getnum} ! & & &Procedure Newcode(var index: integer); &begin )gotoxy(0,2); egin )new_value := 0; )changed := false; )read(ch); )while ch in ['0'..'9'] do begin {exit on non-digit} ,new_value := new_value*10 + ord(ch) - ord('0'); ,changed := true; {remember we've read in at least one good digit} ,read(ch) )end; {while} )i )end; {row} )cursoron &end; {showchar} & & & &Function Getnum(old_value: integer): integer; &{get digits from keyboard - return previous value if only} &const )maxsize=numchars; &var )new_value:integer; )changed:boolean; )ch:char; &b,for col := 0 to 6 do begin /bit := word mod 2; {decode left-most 7 bits} /word := word div 2; /if (bit = 1) then begin 2write('* '); 2newchar[row,col] := true /end /else begin 2write('. '); 2newchar[row,col] := false /end {test bit} ,end {col} &begin )cursoroff; {don't have irritating display} )gotoxy(22,2); {write over previous ASCII code} )write(clearline,index); )for row := 7 downto 0 do begin ,gotoxy(startx,starty-row); ,word := character[index,row]; {get each byte of char} eger; &word: 0..255; &c: char; &newchar: charmask; &index: 0..numchars; ! &Procedure Showchar(var index: integer); {draw an expanded view of} &var {a new character. } )word: 0..255; )bit,row,col: integer;to menu [edit or main]} #end; {display} # # # #Procedure Edit; #const &starty = 12; {bottom of enlarged char map} &startx = 33; {left boundary of char map} #type &charmask = array[0..7,0..7] of boolean; {enlarged char map} #var &i,bit,line: int; )case c of ,'c','C':change(index); , ,'a','A':begin 2if index < numchars then index := index + 1; 2gotoxy(22,2); 2showchar(index) /end; {advance} , ,'p','P':begin 2if index > 0 then index := index - 1; 2gotoxy(22,2); 2showchar(index) /end; {previous} , ,'n','N':newcode(index); , ,'d','D':display; ) )end {case}; &until c=escape; #end; {edit}  #Procedure Quit; #var ch: char; #begin &page(output); &while true do begin )gotoxy(0,0); )writeln('Quit:'); )writeln(' S(avܹDF Fɡ FFFFš FFFqFkgAp`EO +I"$&(*,.02468:<>@DQJLNPRTVXZk^ܩá2 P Quit:צ S(~٩áL s^  F F*Edit: C(hange, A(dvance, P(revious, N(ew, D(isplay, exits:ȡ+ ܂𩅃zy  "$&(*,.0468:t>@BDFHJLNPRTVXZ\^`bdfhjlnprtvxz|~xp!ۏ ڕٹ.*ɡšɡšġ?ȡ-!ۏ ڕ.خġ_ ݂0Ȅ: RצEdit which ASCII code: خHצ*Change: clears, S(et, [i,j,k,m move],צ$ Z(ero, accepts, aborts./`  ġ! ەȡ[á!צ* . p  ݳ 6   11ȡ%#ۏǧP    11ȡG P ǧ ܏22P2צ:Q2P11ȡF  ۏ#ǧ ܏ǧ , '*', '$') :/P/á/*/צapple2:system.charsetP/$/XP/"ˡ8 I/O error #  "á I/O error # Ͷ*File to edit ( quits, '*' defaults) :XPXáX*Xצapple2:system.charsetPX"ˡ(File not found. *Enter filename ( escapesB1@*P CHAREDIT ge(output); &write('Charedit: E(dit, D(isplay all, Q(uit:',clearline); &read(c); &case c of )'e','E': edit; )'d','D': display; )'q','Q': quit; &end {case}; #until false {infinite repeat}  end. {main} quit}; B    begin {main} #clearline := chr(clr_line); escape := chr(esc); #while not get_charset do ; {get_charset doesn't loop - for some reason!} # #(* has_silent := hasprinter; {check if silentype present} *) # #repeat {infinite repeat} &pae the character set,'); )writeln(' E(xit without saving,'); )writeln(' R(eturn to Charedit.'); )read(keyboard,ch); )case ch of ,'e','E': exit(program); ,'r','R': exit(quit); ,'s','S': put_charset; )end {case} &end {infinite repeat} #end {ave the character set, E(xit without saving, R(eturn to Charedit.عp jfEs^ ,( "$&(*,.02468:<>@XDFHJLNPRTVXZlh6 H / צ%Charedit: E(dit, D(isplay all, Q(uit: lh dDq\ & "$&(*,.02468:<>@PVFHJLNPRTVXZf {r - reverse. }  {It then moves straight down from the cursor's position as far as }  {possible and starts drawing horizontal lines of your chosen color }  {until it hits a line directly above t }  {v - violet }  {o - orange }  {b - blue } waits for you to type a letter for the color: }  {k - black (sorry) }  {w - white }  {g - green one of the buttons. The }  {program beeps to confirm, and then waits for you to do the same at }  {a second point. }  { }  {Fill  {Several of the options (box, circle, viewport) require two points }  {on the figure (for circle, the center and a point on the edge; for }  {box and viewport, two diagonal corners). This is done by moving }  {the cursor to that point and pushing copy of hi-res screen 1) that may be very rapidly }  {displayed with 'Showfoto'. }  { } r) which provide a }  {very compact way to store pictures, as well as allowing the }  {drawing to be edited by deleting the most recent instruction. }  {If desired (for speed) the picture may also be saved as a foto- }  {file (a 16-blocks they produce are incompatible. }  { }  {Hit '?' for instructions at any time. Drawings are always saved }  {as graffiles (instructions for the graphic edito Program Graphic_Editor;   {A program to help you design figures with straight lines and }  {circles using the game paddles or joystick. The format is similar }  {to the Pilot Graphics Editor, but is not identical, and the }  {graffileSTART PSTART PEND 78O^ 1"(V~": v   R(eturn to Charedit.عp jfEs^ ,( "$&(*,.02468:<>@XDFHJLNPRTVXZlhe initial point. }  { }  { by Norris Preyer, McCallie School, Chattanooga, Tn. 37404 }   Uses applestuff,smarterm,turtlegraphics,transcend (* ,silentype *);   Const #x_val = 250; y_val = 240; #scrn_x_max = 279; scrn_y_max = 191; # #{These are the values stored in command to repesent the various } #{options. Most have several numbers stored following. Note that } #{'grid' is not here as it is NOT store&graffile : file of command_type; &filename : string; &ch : char; &input : boolean; &result : integer; &foo : hook; &num : integer; &do_foto : boolean; &fotofile : file; &i:integer; & &Procedure Bad_io; &begin )seetext; )close(graffile); )wonst &hires_start = 8192; &hires_length = 8192; #type # byte = 0..255; &screen = packed array [1..hires_length] of byte; &hook = record ,case boolean of ,true : (ptr : ^screen); ,false: (addr: integer) ,end; #var for i := 1 to len do /s := concat(s,copy(alphabet,command[cmd_ctr+i],1)); ,cmd_ctr := cmd_ctr + len )end; &pencolor(none); &moveto(anchor.x,anchor.y); &wstring(s); &cmd := 't' #end; {writestring} # # #Procedure Disk; {handle in and out here} #cth(s); 2put_cmd(len); 2for i := 1 to len do 5command[cmd_ctr+i] := 5pos(copy(s,i,1),alphabet); 2cmd_ctr := cmd_ctr + len; 2command[0] := cmd_ctr /end; ,seehires )end )else begin {playback mode} ,adv_cmd; ,len := command[cmd_ctr]; ,s := ''; ,,seetext; ,writeln; ,writeln('String to be shown : '); ,readln(s); ,if (cmd_ctr + length(s) + 1) > max_cmd /then begin 2Writeln('Command buffer overflow. String cannot be saved.'); 2rem_cmd; rem_cmd; rem_cmd /end , else begin / len := leng&read(cmd); &cmd := 't'; &seehires #end;    Procedure Writestring; #var &s: string; &len,i: integer; #begin &if playback then adv_cmd; &readpaddles(anchor); &if not playback )then begin ,put_cmd(write_cmd); ,put_point(anchor); pressing button #1 draws a white'); &write('line, button #0 draws a black line.'); &writeln(' Hit ''q'' to resume track mode.'); &writeln; writeln('Hit to quit program.'); &writeln; writeln('Hit a key to continue...'); &repeat until keypress; teln('T(rack paddles (default).'); &writeln('V(iewport - give two opposite corners.'); &writeln('W(rite string at cursor point.'); &writeln('X - erase the last command.'); &writeln; &write('Pressing the buttons starts Rubberband mode - '); &writeln('&writeln('C(ircle - give center and point on rim.'); &writeln('D(isk get or put.'); &writeln('E(rase in viewport.'); &writeln('F(ill with color.'); &writeln('G(rid in viewport.'); #(* writeln('P(rint screen.'); *) &writeln('R(eset viewport.'); &wri# #Procedure Menu; #begin &page(output); &seetext; &writeln('Pascal Graphic Editor 1.2'); &writeln;writeln; &writeln('Available Commands:'); &writeln; &writeln('B(ox - give two opposite corners.'); forward; #Procedure Adv_cmd; forward; #Procedure Read_paddles(var here: point); forward; #Procedure Re_run; forward; #Procedure Get_point(var here: point); forward;  Procedure Big_cursor(here: point); forward; #Procedure Call_Procs; forward; # al; #i: integer; #anchor,point_1,point_2,ul,lr: point; #cmd: char; #command: command_type; #cmd_ctr: 0..max_cmd; #play_back: boolean; # # #Procedure Put_point(here: point); forward; #Procedure Put_cmd(word: integer); forward; #Procedure Rem_cmd;#write_cmd = -8; rubber_cmd = -9; # #pi = 3.1415926; #num_sides = 60;  Type #point = record x,y: integer end; #command_type = array[0..max_cmd] of integer;   var #alphabet: string[120]; #x_min,x_max,y_min,y_max: integer; #x_scale,y_scale: red - it is for work lines } #{only. Command[0] stores the # of commands entered. } #max_cmd = 1000; #box_cmd = -1; circle_cmd = -2; fill_cmd = -3; #empty_cmd = -5; reset_cmd = -6; view_cmd = -7; riteln('I/O error #',result); )writeln;writeln('Press a key to continue...'); )read(cmd); )seehires; )cmd := 't'; )exit(disk) &end; & #begin {disk} # seetext; &cmd := 't'; &writeln;writeln; &write('Do you want to G(et or S(ave a picture ? '); &read(ch); &writeln; &if not (ch in ['g','G','s','S']) then begin )seehires; )exit(disk) &end; &input := (ch = 'g') or (ch = 'G'); &if not input then begin )write('F(oto file?'); )read(ch); )writeln; )do_foto := (ch='y') or (ch='Y') &end; &w/else pencolor(white); ,moveto(point_2.x,point_2.y); ,pencolor(none); ,anchor := point_2 )end; &if keypress then read(cmd); {throw away char} &cmd := 't' {resume track mode} #end; {rubber_band} # # #Procedure Put_cmd{word: integer}; #begin &if)until keypress {not playback} )else begin {in playback mode} ,adv_cmd; ,get_point(anchor); ,adv_cmd; ,get_point(point_2); ,pencolor(none); ,moveto(anchor.x,anchor.y); ,adv_cmd; ,if command[cmd_ctr] = 0 /then pencolor(black) (anchor); /put_point(point_2); /pencolor(none); /moveto(anchor.x,anchor.y); /if button0 then pencolor(black) else pencolor(white); /if button0 then put_cmd(0) else put_cmd(1); /moveto(point_2.x,point_2.y); /pencolor(none); /anchor := point_2 ,end do begin /pencolor(none); /moveto(anchor.x,anchor.y); /pencolor(reverse); /moveto(point_2.x,point_2.y); /big_cursor(point_2) ,end; ,pencolor(none); ,if (button(0)) or (button(1)) then begin /button0 := button(0); /put_cmd(rubber_cmd); /put_point)moveto(right,height); )pencolor(none); )height := height + 1 &until (height > ymax) #end {fill}; # # #Procedure Rubber_band; #var &i:integer; &button0:boolean; #begin &if not playback )then repeat ,read_paddles(point_2); ,for i := 1 to 2 or.x - 1; )repeat {find right-most point} ,right := right + 1 )until screenbit(right,height) or (right > xmax); )if right > xmax then exit(fill); )if left = right then exit(fill); {at top} ) )moveto(left,height); )pencolor(color); (fill); &height := height + 1; &pencolor(none); & &repeat )left := anchor.x + 1; )repeat {find left-most point at this level} ,left := left - 1 )until screenbit(left,height) or (left < x_min); )if left < x_min then exit(fill); ) )right := anchfor i := 1 to command[cmd_ctr] do color := succ(color); ,adv_cmd; ,get_point(anchor) )end; & &height := anchor.y + 1; &repeat {find bottom} )height := height - 1 &until screenbit(anchor.x,height) or (height < y_min); &if height < y_min then exit/'v','V' : color := violet; /'o','O' : color := orange; /'b','B' : color := blue; /'r','R' : color := reverse ,end; ,put_cmd(ord(color)); ,read_paddles(anchor); ,put_point(anchor) )end )else begin {in playback mode} ,adv_cmd; ,color := none; ,)then begin ,put_cmd(fill_cmd); ,cmd := 't'; ,repeat /read(ch) ,until ch in ['k','K','w','W','g','G','v','V', 9'o','O','b','B','r','R']; ,case ch of /'k','K' : color := black; /'w','W' : color := white; /'g','G' : color := green; then bad_io; )close(foto_file,lock); )result := ioresult; )if result <> 0 then bad_io &end; {foto} #seehires; #{$i+} #end; {disk} # # #Procedure Fill; #var &left,right,height:integer; &ch:char; &color:screencolor; #begin &if not playback 1,length(filename)-5); )filename := concat(filename,'.foto'); )rewrite(foto_file,filename); )result := ioresult; )if result <> 0 then bad_io; )foo.addr := hires_start; )num := blockwrite(foto_file,foo.ptr^,16); )result := ioresult; )if result <> 0 ,seehires; ,get(graffile); ,command := graffile^; ,re_run )end )else begin ,graffile^ := command; ,put(graffile); ,close(graffile,lock) )end; &result := ioresult; &if result <> 0 then bad_io; &if do_foto then begin )filename := copy(filename,riteln;write('File name : ');readln(filename); &filename := concat(filename,'.graf'); &{$i-} &if input )then reset(graffile,filename) )else rewrite(graffile,filename); &result := ioresult; &if result <> 0 then bad_io; &if input )then begin cmd_ctr < max_cmd - 1 )then begin ,cmd_ctr := cmd_ctr + 1; ,command[cmd_ctr] := word; ,command[0] := cmd_ctr )end )else begin ,note(20,20); {overflow} ,note(20,20); ,exit(call_procs) {punch out of whatever command we're in} )end #end; {put_cmd} & & & #Procedure Put_point{here: point}; #begin &put_cmd(here.x); &put_cmd(here.y) #end; {put_point} # # # #Procedure Rem_cmd; #begin &if cmd_ctr > 0 then begin )cmd_ctr := cmd_ctr - 1; )command[0] := cmd_ctr &end #end; {rem_cmd} # # # # #Procedure Grid; #var &i,j:integer; &dot:boolean; #begin &dot := true; &for i := 0 to 35 do )for j := 0 to 24 do ,if (8*i >= x_min) and (8*i <= x_max) ,and(8*j >= y_min) and (8*j <= y_max) ,then drawblock(dot,1,0,0,1,1,8*i,8*j,10); &cmd lor(white); )moveto(circle_point.x,circle_point.y); )pencolor(none) &end; &pencolor(none); &cmd := 't' #end; {circle} # # # #Procedure Empty; #begin &if not playback then put_cmd(empty_cmd); &fillscreen(black); &cmd := 't' #end; {empty} # int_2.y)); &pencolor(none); &moveto(point_1.x+round(r),point_1.y); &for i := 1 to num_sides do begin )angle := 2 * pi * i / num_sides; )circle_point.x := round(point_1.x + r * cos(angle)); )circle_point.y := round(point_1.y + r * sin(angle)); )pencoe:real; &circle_point:point; &i:integer; #begin &if not playback then put_cmd(circle_cmd) else adv_cmd; &read_twice; &if not playback then begin )put_point(point_1); )put_point(point_2) &end; &r := sqrt(sqr(point_1.x-point_2.x) + sqr(point_1.y-po&moveto(ul.x,lr.y); &pencolor(white); &moveto(ul.x,ul.y); &moveto(lr.x,ul.y); &moveto(lr.x,lr.y); &moveto(ul.x,lr.y); &pencolor(none); &cmd := 't'; &for i := 1 to 100 do ; {delay for paddle} #end; {box} ) # # #Procedure Circle; #var &r,anglpoint_1.y; ,ul.y := point_2.y )end; #end; {get_rect} # # # #Procedure Box; #var i: integer; #begin &if not playback then put_cmd(box_cmd) else adv_cmd; &if not get_rect then begin )rem_cmd; )exit(box) &end; &pencolor(none); hich corner do we have?} )then begin ,ul.x := point_1.x; ,lr.x := point_2.x )end )else begin ,lr.x := point_1.x; ,ul.x := point_2.x )end; &if point_1.y > point_2.y )then begin ,ul.y := point_1.y; ,lr.y := point_2.y )end )else begin ,lr.y := ctangle?} &or (point_1.y = point_2.y) )then begin ,note(30,30); ,cmd := 't'; ,get_rect := false; ,exit(get_rect) )end; &get_rect := true; &if not playback then begin )put_point(point_1); )put_point(point_2) &end; &if point_1.x < point_2.x {w,read_paddles(point_1); ,note(20,20); ,repeat track until button(0) or button(1); ,read_paddles(point_2); ,note(20,20) )end #end; {read_twice} # # # #Function Get_rect:boolean; #begin &read_twice; &if (point_1.x = point_2.x) {do we have a rehor); &big_cursor(anchor) #end; {track} # # #  Procedure Read_twice; #begin &if playback )then begin ,get_point(point_1); ,adv_cmd; ,get_point(point_2) )end )else begin ,repeat track until button(0) or button(1); n ,pencolor(none); ,moveto(x_min,y); ,pencolor(reverse); ,moveto(x_max,y); ,pencolor(none); ,moveto(x,y_min); ,pencolor(reverse); ,moveto(x,y_max) )end; &pencolor(none) #end; {big_cursor} #  # #Procedure Track; #begin &read_paddles(anc x_max; ,for i := 1 to 10 do; ,here.y := y_min + round(paddle(0)*y_scale); ,if here.y > y_max then here.y := y_max )end #end; {read_paddle} # # # #Procedure Big_cursor{here: point}; #var i:integer; #begin &for i := 1 to 2 do )with here do begi&here.y := command[cmd_ctr]; #end; {get_point} # # # #Procedure Read_paddles{var here: point}; #var i:integer; #begin &if playback )then get_point(here) )else begin ,here.x := x_min + round(paddle(1)*x_scale); ,if here.x > x_max then here.x :=# #Procedure Adv_cmd; #var i:integer; #begin &if cmd_ctr < command[0] )then cmd_ctr := cmd_ctr + 1 )else exit(call_procs) #end; {adv_cmd} # # # #Procedure Get_point{var here: point}; #begin % here.x := command[cmd_ctr]; &adv_cmd; := 't' #end; {grid} # # # #(* #Procedure Print; #begin &seetext; &writeln; &write('Single or double-size (s/d) ? '); &read(cmd); &setnegative; &setdark(7); &if (cmd = 'd') or (cmd = 'D') )then begin ,setunidirect; ,setleftmargin(12); ,dblprint )end )else printpic; &cmd := 't'; &seehires #end; {print} #*) # # #Procedure Reset_Viewport; #begin &if not playback then put_cmd(reset_cmd); &x_min := 0; x_max := scrn_x_max; &y_min := 0; y_max := scrn_y_max; &viewport(x_min,x_max,y_mi*GRAPHICE )read(cmd); )if (cmd = 'y') or (cmd ='Y') ,then cmd := chr(27) ,else cmd := 't' &end #until (ord(cmd) = 27)  end. " teln('Cmd_ctr = ',cmd_ctr); ,writeln;write('Press a key to continue'); ,rem_cmd; ,read(cmd); ,cmd := 't'; ,seehires )end; &if keypress then read(cmd); # if ord(cmd) = 27 then begin )seetext; )writeln; )write('Do you really want to quit ? '); IJKLMNOPQRSTUVWXYZ'; #alphabet := concat(alphabet,'[\]^_`abcdefghijklmnopqrstuvwxyz{|}~'); #reset_viewport; #initturtle; #seehires; #repeat &call_procs; &if cmd_ctr >= max_cmd - 1 )then begin ,seetext; ,writeln('Command buffer overflow!!'); ,wrie_last; )'?' : menu; &end; &if button(0) or button(1) then rubber_band; #end; {call_procs} & &   begin {main} #cmd_ctr := 0; #command[0] := cmd_ctr; #playback := false; #cmd := 't'; #alphabet := ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGH&case cmd of )'b','B' : box; )'c','C' : circle; )'d','D' : disk; )'f','F' : fill; )'g','G' : grid; )'e','E' : empty; &(* 'p','P' : print; *) )'r','R' : reset_viewport; )'t','T' : track; )'v','V' : view; )'w','W' : writestring; )'x','X' : removremove_last); &while (cmd_ctr > 0) and (command[cmd_ctr] >= 0) do )cmd_ctr := cmd_ctr - 1; &cmd_ctr := cmd_ctr - 1; {remove last command word} &command[0] := cmd_ctr; &re_run #end; {remove_last} & & & #Procedure Call_Procs; #begin et_viewport; ,view_cmd : view; ,write_cmd : writestring; ,rubber_cmd : rubberband )end {case} &end; {while} &playback := false; &cmd := 't' #end; {re_run} # # #  Procedure Remove_last; " var i:integer; #begin &if command[0] = 0 then exit(true; &cmd_ctr := 0; &viewport(0,279,0,191); &fillscreen(black); &while cmd_ctr < command[0] do begin )cmd_ctr := cmd_ctr + 1; )case command[cmd_ctr] of ,box_cmd : box; ,circle_cmd : circle; ,fill_cmd : fill; ,empty_cmd : empty; ,reset_cmd : res&x_min := ul.x; x_max := lr.x; &y_min := lr.y; y_max := ul.y; &viewport(x_min,x_max,y_min,y_max); &x_scale := (x_max - x_min) / x_val; &y_scale := (y_max - y_min) / y_val; &cmd := 't' #end; {view} # # # # Procedure Re_run; #begin &playback := n,y_max); &x_scale := x_max/x_val; &y_scale := y_max/y_val; &cmd := 't' #end; {reset_viewport} & & & #Procedure View; #begin &if not playback then put_cmd(view_cmd) else adv_cmd; &if not get_rect then begin )rem_cmd; )exit(view) &end; Bq  צPascal Graphic Editor 1.2Available Commands:צ!B(ox - give two opposite corners.'C(ircle - give center and point on rim.צD(isk get or put.tSdȡ l>>OMPNOMPO<ȡTI@ފ<POtSc > tSM4OM9 RPNéOMÍtS>OMPNɡ PLNJPJNLOMš OKMIOIMKj>LILKJKJILIإT=*>RآCFBšآB ȡةAD@šة@,fبȡ/CBکAک@; N QQ > OQM StS\ =ɡ+==T=ؚT= Lب=š==T=*=Tɡ== ,آT=ة@šnGl >Mȡ!RQNMM J QMRQ١١NMQMEQMRQT=áNM68:<>@RDFHJkNPR}VXZq^`mdfhQQ0HT=Hȡ HHQQRةAɍةAɡRکCɍکCɡR٩Bō٩Bšá"̅AʅAˡ ̅BƅEʅB̅C"̅AʅAˡƅE"̅AʅAˡƅE0 P >tS۳۹# ~ ytBwl +=1 -$&(DP.024 File name : ƅPƅ̅nƅnƅPƅnצ.grafUƅnPʅ@ ƅ ƅ"̅AʅAˡʅ@TبإT"̅AʅAˡʅDƅƅƅnƅƅnPƅ̅nƅnƅPƅnצ.fotoUƅnPƅEƅtS ƅEƆqƁ-tS)Do you want to G(et or S(ave a picture ? ƅ?ʅ? ʅ?gʅ?GÍ̅@ʅ@8 F(oto file?ƅ?ʅ?yʅ?YÍ̅D+צP*+,*,ȡ=--P-ƀT=*ƀ-P**=+=RQtSh   I/O error #A Press a key to continue...Sing to be shown : P=šM1Command buffer overflow. String cannot be saved._++*+,*,ȡ+T=*-*-**=+=T=qT=lack line. Hit 'q' to resume track mode.צHit to quit program.צHit a key to continue...StS >Q>QStrצW(rite string at cursor point.צX - erase the last command.-Pressing the buttons starts Rubberband mode -צ pressing button #1 draws a whiteצ#line, button #0 draws a bE(rase in viewport.צF(ill with color.G(rid in viewport.R(eset viewport.T(rack paddles (default).צ&V(iewport - give two opposite corners.#ȡGȡ5ُCُBȄ؏AĄ؏@Ȅُ؏ tSQH d>CBAǿ@CBA@ FBD@tSJ>LCJBIAK@CBA@ FBCD@AtSb>=ǿ  =TɡW==T= 51-)%!  # +17>tSr Tá=ťT=Ą===#num := blockread(hires_file,foo.ptr^,16); #{$i+} #bad_io; #close(hires_file); #read(ch); #seetext  end. ogram) &end #end; #  begin #write('File name ? '); readln(filename); #filename := concat(filename,'.foto'); #foo.addr := hires_start; #initturtle; #seehires; #{$i-} #reset(hires_file,filename); #bad_io; name : string; #ch : char; #foo : hook; #hires : screen; #num : integer; #hires_file : file; # #Procedure Bad_io; #var result : integer; #begin &result := ioresult; &if result <> 0 then begin )seetext; )writeln('I/O error #',result); )exit(prm,turtlegraphics;  Const #hires_start = 8192; #hires_length = 8192;  Type #byte = 0..255; #screen = packed array [1..hires_length] of byte; #hook = record /case boolean of 2true : (ptr : ^screen); 2false: (addr: integer) /end;  Var #fileProgram Showfoto;   {Shows fotofiles (from Grafedit or similar sources) on the hi-res}  {screen. This program appends '.foto' to whatever filename you }  {enter. Press a key to return to the command-level menu. }   Uses applestuff,smarterO^F= צPress a key to continueStS SSáQDo you really want to quit ? SSyéSYÍStSSá: 0<J B$6^(Z4'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZx??x?צ$[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ǜ?x =ġCommand buffer overflow!!צ Cmd_ctr = = צPress a key to continueStS SSáQDo you really want to quit ? SSyéSYÍStSSá: 0<=T=>tSצ; !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZx??x?צ$[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ǜ?x =ġCommand buffer overflow!!צ Cmd_ctr = =T=E`S0   |?xt ><:0:8 "$&F*F.FDB68:<>@BDF~|zpzxTVXZ\^`bdfjn "new(new_entry); "attatch := new_entry; "with new_entry^ do begin %name := word; %writeln; %write(word); %count := 1; %left_ptr := nil; %right_ptr := nil "end  end; {make_entry}     Procedure Add_List(start: ptr);  begin "with start^ do %s := copy(charset,ord(ch)-31,1); %word := concat(word,s); %if eof(in_file) then exit(read_word); {have just done last char} %read(in_file,ch) "until (not (ch in goodset))  end; {read_word}     Procedure Make_entry(var attatch:ptr);  begin "while (not eof(in_file)) and (not (ch in goodset)) %do read(in_file,ch); "if (eof(in_file)) and (not (ch in goodset)) then exit(read_word); "{throw away last break character} " "word := ''; "repeat {collect characters until break character or eof}tring; #in_file : text; #word : word_type; #new_entry,start_list : ptr; #goodset : goodchar;  charset : string[95];  # #  Procedure Read_word;  var "ch:char; "s:word_type;  begin " "{skip until a good character found} "read(in_file,ch);Program Concordance;  Uses smarterm;  Const #word_len = 30;  Type #word_type = string[word_len]; #ptr = ^entry; #entry = record )name : word_type; )count : integer; )left_ptr, right_ptr : ptr &end; &goodchar = set of char;  Var #filename : sO^uӤ -9 ƀ:SYSTEM.SWAPDISK&:(7,*SYSTEM.WRK.CODE[*]תצTo what codefile? ( צO,á<צ$88š8(8X͞"ˡ0 I/O error # B/[ File name ? PWWPW.fotoUWP -//-./,/Bq(SHOWFOTO %if name = word then begin (write('.'); (count := count + 1 %end %else if word < name (then if left_ptr = nil +then make_entry(left_ptr) +else add_list(left_ptr) (else if right_ptr = nil +then make_entry(right_ptr) +else add_list(right_ptr)  end; {add_list} "     Procedure Print_list(start:ptr);  begin "if start = nil then exit(print_list); "with start^ do begin %print_list(left_ptr); %writeln(count:5, ' ', name); %print_list(right_ptr) "end  end; {print_list}     ProceO^J4PV\4| ٣á٢٣X؟á٣٣ צ ٣Jk{צ! !"#$%&'()*+,-./0123456789:;<=>?@_{{_ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^}_{{_ _`abcdefghijklmnopqrstuvwxyz{|}~_iRead what file ? PP.textUP,$C,Xii, i,٢٣0Yٵ٣á٢٣٣á٢٣X؟á٣٣ צ ٣Jk{צ! !"#$%&'()*+,-./0123456789:;<=>?@_{{_ABCDEFGHIJKLMNOPQRS,, إk ,, إkYצ{YY<, ,إkQ jةjj٥YY٢٢٢B٥Y.B&CONCORDA word; &add_list(start_list) #until eof(in_file); #writeln; #print_list(start_list); #cursoron  end. #start_list := nil; #write('Read what file ? '); #readln(filename); #filename := concat(filename,'.text'); #reset(in_file,filename); #cursoroff  end;     begin #initialize; #read_word; #make_entry(start_list); {make start} #repeat &read_dure Initialize;  begin #goodset := ['_','0'..'9','A'..'Z','a'..'z'];  charset := ' !"#$%&''()*+,-./0123456789:;<=>?@'; #charset := concat(charset,'ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^'); #charset := concat(charset,'_`abcdefghijklmnopqrstuvwxyz{|}~');  Program Diskdump;   {This program dumps any kind of 16 sector disks, one sector at at time,}  {on an 80-column display or printer. When started it will ask for the }  {unit number (4,5,9..12) and if it is a DOS disk. }  {If a ,sector); #writeln(sysout,'Block-number = ',blocknum, 5' Track = ' ,track:3, 5' Sector = ',sector); #list_sector(dos_to_pos(sector) mod 2); #sector := sector - 1; {walk DOWN disk} #if sector < 0 then begin §or := 15; &track := track - 1dos_to_pos} # # #Procedure Get_Sector(t,s: integer); #begin &blocknum := t * 8 + dos_to_pos(s) div 2; &unitread(unitnum,buffer,512,blocknum) #end; {get_sector} #   begin {dump_dos} #if out_name = 'CONSOLE:' then page(sysout); #get_sector(track end; {dump_pascal}  #   Procedure Dump_Dos;  #Function Dos_to_Pos(s: integer): integer; &{maps DOS sectors to POS sectors} &{see Beneath Apple DOS, p 3-23 } #begin &if s in [0,15] )then dos_to_pos := s )else dos_to_pos := 15 - s " end; {out); &writeln(sysout,'Block-number = ',blocknum, 5' Track = ' ,(blocknum*2) div 16, 5' Sector = ',(blocknum*2) mod 16 + i); &list_sector(i); &read(ch); &if ord(ch) = escape then exit(dump_pascal) #end; #blocknum:=blocknum+1 in &writeln; &write(' to quit, any key to continue:') #end  end; {list_sector}     Procedure Dump_Pascal;  var i: integer;  begin #unitread(unitnum,buffer,512,blocknum); #for i:=0 to 1 do begin &if (out_name = 'CONSOLE:') then page(sys=256*secnum+16*i+j; )if (index mod 8)=0 then write(sysout,' '); )temp := chr(ord(buffer[index]) mod 128); )if ord(temp) in [32..127] +then write(sysout,temp) +else write(sysout,'.'); &end; &writeln(sysout) #end; #if out_name = 'CONSOLE:' then beg&for j:=0 to 15 do begin )index:=256*secnum+16*i+j; )if (index mod 8)=0 then write(sysout,' '); )write(sysout,digit[ord(buffer[index]) div 16], 6digit[ord(buffer[index]) mod 16],' '); &end; &write(sysout,' '); &for j:=0 to 15 do begin )index:LE:'; #reset(sysout,out_name)  end; {get_parameters} #    Procedure List_Sector(secnum: integer);  {secnum = 0,1 and determines which half of the buffer to list}  var #i,j,index : integer; #temp : char;  begin #for i:=0 to 15 do begin dln(track); )write('Sector #');readln(sector) &end &else begin )write('blocknumber');readln(blocknum) &end; & #write('Output to printer ? '); read(ch); #writeln; #if (ch = 'Y') or (ch = 'y') &then out_name := 'PRINTER:' &else out_name := 'CONSOnitnumber (0 exits) '); #repeat &readln(unitnum) #until unitnum in [0, 4,5, 9..12]; #if unitnum = 0 then exit(program); # #write('DOS format ?'); read(ch); #writeln; #dos := (ch = 'Y') or (ch = 'y'); # #if dos &then begin )write('Track # ');rea#i: integer; #ch: char; #dos: boolean; {how do we map t/s --> blocks?} #digit: array[0..15] of char; {used to store hex digits}  & &  Procedure Get_Parameters;  begin #page(output); #write('u }   Const escape = 27; { }   Var #buffer: packed array [0..511] of char; {one block} #sysout: interactive; #out_name: string[8]; {'PRINTER:' or 'CONSOLE:'} #blocknum,unitnum, #track,sector: integer; ectors in DESCENDING order. }  {After each sector is dumped the program waits for you to press a key. }  {If is pressed, the options are shown again, otherwise the next }  {sector is displayed. The ASCII display on the right is modulo 128. Pascal disk, you are asked for the starting block number, and are}  {then shown successive halves of the blocks (in ascending order). }  {If a DOS disk, you are asked for the starting track and sector numbers}  { (decimal), and are then shown the s; &if track < 0 then track := 0 #end; #read(ch)  end; {dump_dos} # #   begin {Main} #for i:=0 to 9 do digit[i]:=chr(i+48); #for i:=10 to 15 do digit[i]:=chr(i+55); #repeat {until false} &get_parameters; &repeat {until esc} & if dos ,then dump_dos ,else dump_pascal &until ord(ch) = escape; &close(sysout) #until false  end. O^6:ץ/9 L9Lȡ<99099 9L9Lȡ<99799;:á**R@88  ڕ878&0CONSOLE:ׯ  65Block-number = 8 צ Track = 6  Sector = 5 5555ɡ5666ɡ8ȡ0CONSOLE:ׯ  Block-number = 8 צ Track = 8  Sector = 8؂ ::á88  ڕצ ȡf؏ۏڂáצ ǀܳ  .0CONSOLE:ׯ7# to quit, any key to continue:L\U n7 צOutput to printer ? ::Yé:yÍ0צPRINTER:0צCONSOLE:0Qȡȡm؏ۏڂá << Ͷ unitnumber (0 exits) 7 717áצ DOS format ?::Yé:yÍ;;PצTrack # 6 Sector #5 *צ blocknumber8BDISKDUMP  Program Startup;   Type #date_record = packed record )month : 0..12; )day : 0..31; )year : 0..100 &end; #dir_size = 0..77; #vol_id = string[7]; #file_id = string[15]; #file_type = (untyped,xdisk,code,text,info,data,graf,foto,securedir); #ge(output); #second_page  end.  &' blocks used, ' ,tot_free, ' unused, ' ,max_free, ' in largest')   end; {second_page}     begin {Main} #unitread(4,dir[0],sizeof(dir),2); #write(chr(20),'c2'); {switch to underline cursor on Smarterm board} #first_page; #read(ch); #pa&end; {with} & &with dir[num_files] do {free blocks at end?} )if last_block < max_block then empty_block(max_block, last_block); & &writeln(num_files, ' files in dir, ' ,max_block - tot_free, lock:6); )write(last_byte:6); )case file_kind of ,code : writeln(' Codefile'); ,text : writeln(' Textfile'); ,info : writeln(' Infofile'); ,data : writeln(' Datafile'); ,graf : writeln(' Graffile'); ,foto : writeln(' Fotofile') )end; {case} les do &with dir[index] do begin )if first_block <> prev_end ,then empty_block(first_block,prev_end); )prev_end := last_block; )write(file_name,' ':18-length(file_name)); )write((last_block - first_block):2); )nice_date(file_date); )write(first_b&write('< UNUSED >',' ':18-10); &write(free_blocks:2); &writeln(prev_end:16) #end; {empty_block} #  begin {second_page} #prev_end := dir[0].last_block; #max_free := 0; #tot_free := 0; #writeln; #writeln(diskname,':'); #for index := 1 to num_fi# #Procedure empty_block(first_block,prev_end : integer); #var free_blocks : integer; #begin &free_blocks := first_block - prev_end; &tot_free := tot_free + free_blocks; &if free_blocks > max_free then max_free := free_blocks; #nice_date(sys_date); #writeln;writeln;writeln; #writeln('(c) Apple Computer Inc. 1979,1980'); #writeln('(c) U.C. Regents 1979')  end; {first_page} # # #  Procedure Second_page;  var #prev_end,max_free,tot_free : integer; #index : dir_size;  ock := dir[0].total_block; #num_files := dir[0].num_files; #sys_date := dir[0].last_boot; #gotoxy(0,8); #writeln('Welcome ',diskname,' to Apple II Pascal 1.1'); #writeln; #writeln('Based on UCSD Pascal II.1'); #writeln; #write('Current date is'); ,7 : write('Jul'); ,8 : write('Aug'); ,9 : write('Sep'); ,10: write('Oct'); ,11: write('Nov'); ,12: write('Dec') )end; )write('-',year) &end {with}  end; {nice_date} . .   Procedure First_page;  begin #diskname := dir[0].vol_name; #max_bl; #ch : char; # # #  Procedure Nice_date(date : date_record);  begin #with date do begin &write(day:3,'-'); )case month of ,1 : write('Jan'); ,2 : write('Feb'); ,3 : write('Mar'); ,4 : write('Apr'); ,5 : write('May'); ,6 : write('Jun'); f,foto : 2(file_name : file_id; 3lastbyte : 1..512; 3file_date : date_record) )end; #directory = array [dir_size] of dir_record;    Var #diskname : vol_id; #max_block : integer; #num_files : integer; #sys_date : date_record; #dir : directorydir_record = record )first_block : integer; )last_block : integer; )case file_kind : file_type of ,securedir,untyped : 2(vol_name : vol_id; 3zero_block, 3num_files, 3total_block : integer; 3last_boot : date_record); ,xdisk,code,text,info,data,graSTARTUP p := false #end; {initilize} & & & #Procedure Newvalue(var value:integer); #var ch : char; #begin &write(value,' :'); {returns original value if hit} &read(ch); &if eoln then exit(newvalue); &value := 0; &while not eoln do begin )value h, n= # of sides} #out,flipflop : boolean; {determine how turtle turns at each level} #maxsize : integer; # # # #Procedure Initilize; #begin &level := 1; {set up for triangle to start (why not?)} &n := 3; &maxsize := 100; &out := true; &flipflo Program Snowflake; {Recursive fractal-type curve drawing program}   Uses turtlegraphics,smarterm,applestuff;   Const pi = 180.0; {degrees for turtlegraphics}   Var #side,theta : real; #ch : char; #level,n,i : integer; {level=recursion deptHERE  O^a  in largest B M צc2 LTd    Codefile Textfile Infofilet DatafileT Graffile4 Fotofile nP2 M ɡ  files in dir, ؕ צ blocks used,  צ unused, M :MMȡ M ˡݢ ݢ ݢ  ݣ   Codefile Textfile Infofilerent date is !(c) Apple Computer Inc. 1979,1980צ(c) U.C. Regents 1979\ؕڂڶšڸ < UNUSED >    b zk\M>/- < 4 M  M  M  M Welcome צ to Apple II Pascal 1.1Based on UCSD Pascal II.1צCurب -JanצFebMarצAprMayצJunJuluצAugdSepSצOctBNov1צDec  B:= value * 10 + ord(ch) - ord('0'); {else decode char by char} )read(ch); &end #end; {newvalue} & # # #Procedure Newtruth(var switch:boolean); {return original value if hit} #var s : string; #begin &if switch then write('yes') else write('no'); &write(' :'); &readln(s); &if length(s) = 0 then exit(newtruth); &writeln; &switch := s[1] in ['Y','y'] #end; {newtruth} # # # #Procedure Wend(level:integer; side:real; out,flipflop:boolean); &{draO^ڣ(y/n) : 4C(`á ȡKI*0 G  צ Snowflake curve drawing program.צ6Enter new values: leaves value, depth := 0 quitsצRecursion depth : áצNumber of sides :  Size (50+) : Outward growing? (y/n) : Flip-flop? 2 ܏ ءٓá#١  f4Cȡ4Cٓ G  צ Snowflake curve drawing program.  d   צ :   ق0#`yesצnoצ :PáR|BqSNOWFLAK ; &theta := 2 * pi / n; &initturtle; &seehires; &moveto(40,96); &pencolor(white); &if n = 3 then turn(30) else turn(round(theta/2)); &for i := 1 to n do wend(level,side,out,flipflop); &read(ch); &seetext; #until false  end. {Snowflake}  value(level); &if level = 0 then exit(program); &write('Number of sides :'); newvalue(n); &write('Size (50+) :'); newvalue(maxsize); &write('Outward growing? (y/n) :'); newtruth(out); &write('Flip-flop? (y/n) :'); newtruth(flipflop); &side := maxsize#end; {wend} #    Begin {main} #page(output); #writeln('Snowflake curve drawing program.');  initilize; #write('Enter new values: leaves value, depth := 0 quits'); #repeat {forever} &writeln; writeln; &write('Recursion depth :'); new,wend (level-1,side/3,out,flipflop); ,turn (round(pi)); ,for i := 1 to n-1 do wend (level-1,side/3,out,flipflop); ,turn (round(pi)); {face forward again} ,wend (level-1,side/3,out,flipflop); ,if not out then turn (round(-2*theta)) )end {else} 1 then level := 1; {terminate if too small} & &if level = 1 )then begin {bottom recursion level --> straight sides} ,move (round(side)); ,if out /then turn (round(-theta)) /else turn (round(theta)) ,end {then} )else begin {put flakes on side} w one side if level=1; else push 'til its easy} #var i:integer; #begin & &{neat sounds!} ¬e(50-10*level,10); & &if keypress then exit(wend); {crap out if desired} & &{take care of various options} &if flipflop then out := not out; &if side <=)'m','M': move_proc; )'t','T': turn_proc; )'p','P': color_proc; )'i','I': init_proc; )'q','Q': quit_proc &end #until ch = chr(27); { also punches out} #quit_proc  end. wport(0,278,170,191); &fillscreen(black); &pencolor(none); &moveto(0,180); &wstring('M(ove, T(urn, P(encolor, I(nit, Q(uit:'); &read(keyboard,ch); &wchar(ch); &viewport(1,278,1,168); &moveto(x,y); &turnto(angle); &pencolor(color); &case ch of (temp_s = 'REVERSE') then color := reverse; &pencolor(color) #end; {color_proc} # # # #Procedure Quit_proc; #begin &seetext; &exit(program) #end; {quit_proc} # # #  begin {Main} #init_proc; #repeat {until 'Q' or } &draw_turtle; &viehen color := violet; &if (temp_s = 'orange') or (temp_s = 'ORANGE') then color := orange; &if (temp_s = 'blue') or (temp_s = 'BLUE') then color := blue; &if (temp_s = 'none') or (temp_s = 'NONE') then color := none; &if (temp_s = 'reverse') or &if (temp_s = 'white') or (temp_s = 'WHITE') then color := white; &if (temp_s = 'black') or (temp_s = 'BLACK') then color := black; &if (temp_s = 'green') or (temp_s = 'GREEN') then color := green; &if (temp_s = 'violet') or (temp_s = 'VIOLET') t&moveto(0,180); &wstring('Color: White, Black, Green, Violet'); &moveto(0,170); &wstring('Orange, Blue, None, Reverse: '); &readln(keyboard,temp_s); &wstring(temp_s); &viewport(1,278,1,168); &moveto(x,y); &turnto(angle); 278,1,168); &moveto(x,y); &turnto(angle); &turn(temp_ang); &angle := turtleang #end; {turn_proc} # # # #Procedure Color_proc; #var &temp_s: string; &temp_c: screencolor; #begin &viewport(0,279,170,191); &fillscreen(black); &pencolor(none); # #Procedure Turn_proc; #var &temp_ang: integer; &temp_s: string; #begin &pencolor(none); &viewport(0,279,170,191); &moveto(0,170); &wstring('Turn how much? '); &readln(keyboard,temp_ang); &str(temp_ang,temp_s); &wstring(temp_s); &viewport(1,&moveto(0,170); &wstring('Move how far? '); &readln(keyboard,dist); &str(dist,temp_s); &wstring(temp_s); &viewport(1,278,1,168); &moveto(x,y); &turnto(angle); &pencolor(color); &move(dist); &x := turtlex; &y := turtley #end; {move_proc} # # closes at (x,y) } &turnto(angle); {face turtle correctly} &pencolor(color) {reset color} #end; {draw_turtle} # # # #Procedure Move_proc; #var &temp_s: string; &dist: integer; #begin # pencolor(none); &viewport(0,279,170,191); ) #end; {init_proc} # # # #Procedure Draw_turtle; #const &width = 2; &length = 7; &ang = 17; #begin &pencolor(white); &turn(-90); &move(width); &turn(90+ang); &move(length); &turn(180-2*ang); &move(length); &moveto(x,y); {make sure it moveto(279,169); &moveto(0,169); &moveto(0,0); & &viewport(1,278,1,168); & &{Effect of Initturtlegraphics on simulated turtle} &angle := 0; &x := 140; &y := 85; &color := none; &fillscreen(black); &pencolor(none); &moveto(x,y); &turnto(angle Program Turtle_Simulator;  uses turtlegraphics,smarterm;  var #ch: char; #angle,x,y: integer; #color: screencolor; # # # #Procedure Init_proc; #begin &initturtle; &seehires; & &moveto(0,0); {draw box} &pencolor(white); &moveto(279,0); &%Most of these programs are set up (and have been compiled) to use an %Smarterm 80-col board, which allows software switching from text %display to hi-res display. I do this by means of an intrinsic unit %added to the system.library ('Smarterm' - inc BEGINDECENDDEC ENDMAIN BEGINMAIBEGINGETENDGET BEGINDISENDDIS GETSTARTGETEND J^1NONEׯצreverseצREVERSETǪǿ  Ǵצ&M(ove, T(urn, P(encolor, I(nit, Q(uit:Ǩ okgc_ItX# !- "$&(*,.02468:<>@ODFHcLNa[TVmá )"(>\&REENצvioletVIOLETׯצorangeORANGEׯ צblueBLUEׯ צnoneNONEׯצreverseצREVERSETǪǿ  Ǵצ&M(ove, T(urn, P(encolor, I(nit, Q(uit:Ǩ okgc_ItX# !one, Reverse: PǨ צwhiteצWHITEצblackצBLACKצgreenצGREENצvioletVIOLETׯצorangeORANGEׯ צblueBLUEׯ צnone*  TǪǿ ǪצTurn how much?  P Ǩ TxǪǿ  Ǵצ"Color: White, Black, Green, VioletǪOrange, Blue, NǩǩǨ njU ^ZZǴ:Ǫǿ ǪצMove how far? * *P Ǩ B1@*TURTLESI luded) which provides %this in the two routines 'seehires' and 'seetext' (replacing %'grafmode' and 'textmode' from the turtlegraphics unit) - you will %have to to provide equivalent routines to send the appropriate %control codes to your board (or use grafmode and textmode instead). % %The 'cursoron' and 'cursoroff' routines do just that to provide a %neater display, but are not needed and can be deleted if you do not %have this available with your board.  &put_cmd(here.x); &put_cmd(here.y) #end; {put_point} # # # #Procedure Rem_cmd; #begin &if cmd_ctr > 0 then begin )cmd_ctr := cmd_ctr - 1; )command[0] := cmd_ctr &end #end; {rem_cmd} # # # #Procedure Adv_cmd; #var i:integer; #begin &if cmr + 1; ,command[cmd_ctr] := word; ,command[0] := cmd_ctr )end )else begin ,note(20,20); {overflow} ,note(20,20); ,exit(call_procs) {punch out of whatever command we're in} )end #end; {put_cmd} & & & #Procedure Put_point{here: point}; #begin ,pencolor(none); ,anchor := point_2 )end; &if keypress then read(cmd); {throw away char} &cmd := 't' {resume track mode} #end; {rubber_band} # # #Procedure Put_cmd{word: integer}; #begin &if cmd_ctr < max_cmd - 1 )then begin ,cmd_ctr := cmd_ctin {in playback mode} ,adv_cmd; ,get_point(anchor); ,adv_cmd; ,get_point(point_2); ,pencolor(none); ,moveto(anchor.x,anchor.y); ,adv_cmd; ,if command[cmd_ctr] = 0 /then pencolor(black) /else pencolor(white); ,moveto(point_2.x,point_2.y); (none); /moveto(anchor.x,anchor.y); /if button0 then pencolor(black) else pencolor(white); /if button0 then put_cmd(0) else put_cmd(1); /moveto(point_2.x,point_2.y); /pencolor(none); /anchor := point_2 ,end )until keypress {not playback} )else beg.x,anchor.y); /pencolor(reverse); /moveto(point_2.x,point_2.y); /big_cursor(point_2) ,end; ,pencolor(none); ,if (button(0)) or (button(1)) then begin /button0 := button(0); /put_cmd(rubber_cmd); /put_point(anchor); /put_point(point_2); /pencolor)height := height + 1 &until (height > ymax) #end {fill}; # # #Procedure Rubber_band; #var &i:integer; &button0:boolean; #begin &if not playback )then repeat ,read_paddles(point_2); ,for i := 1 to 2 do begin /pencolor(none); /moveto(anchorght-most point} ,right := right + 1 )until screenbit(right,height) or (right > xmax); )if right > xmax then exit(fill); )if left = right then exit(fill); {at top} ) )moveto(left,height); )pencolor(color); )moveto(right,height); )pencolor(none); 1; &pencolor(none); & &repeat )left := anchor.x + 1; )repeat {find left-most point at this level} ,left := left - 1 )until screenbit(left,height) or (left < x_min); )if left < x_min then exit(fill); ) )right := anchor.x - 1; )repeat {find rir, McCallie School, Chattanooga, Tn. 37404   %an Epson MX-80 with Graftrax and an Interactive Structures EP12 %interface board - the supplied unit provides simple control of the %printer with such an interface board. It should be adaptable for %similar boards like the Grappler. % %Norris Preye %Some of these programs have sections to control a Silentype printer %(they are commented-out of the programs now) - the routines needed %are the ones in the back of the Silentype manual. I currently use d_ctr < command[0] )then cmd_ctr := cmd_ctr + 1 )else exit(call_procs) #end; {adv_cmd} # # # #Procedure Get_point{var here: point}; #begin % here.x := command[cmd_ctr]; &adv_cmd; &here.y := command[cmd_ctr]; #end; {get_point} # # # #Procedure Read_paddles{var here: point}; #var i:integer; #begin &if playback )then get_point(here) )else begin ,here.x := x_min + round(paddle(1)*x_scale); ,if here.x > x_max then here.x := x_max; ,for i := 1 to 10 do; ,here.y := y_min + round(p&cmd := 't'; &seehires #end; {print} #*) # # #Procedure Reset_Viewport; #begin &if not playback then put_cmd(reset_cmd); &x_min := 0; x_max := scrn_x_max; &y_min := 0; y_max := scrn_y_max; &viewport(x_min,x_max,y_min,y_max); &x_scale := x_max/x#(* #Procedure Print; #begin &seetext; &writeln; &write('Single or double-size (s/d) ? '); &read(cmd); &setnegative; &setdark(7); &if (cmd = 'd') or (cmd = 'D') )then begin ,setunidirect; ,setleftmargin(12); ,dblprint )end )else printpic; &i,j:integer; &dot:boolean; #begin &dot := true; &for i := 0 to 35 do )for j := 0 to 24 do ,if (8*i >= x_min) and (8*i <= x_max) ,and(8*j >= y_min) and (8*j <= y_max) ,then drawblock(dot,1,0,0,1,1,8*i,8*j,10); &cmd := 't' #end; {grid} # # # le_point.y); )pencolor(none) &end; &pencolor(none); &cmd := 't' #end; {circle} # # # #Procedure Empty; #begin &if not playback then put_cmd(empty_cmd); &fillscreen(black); &cmd := 't' #end; {empty} # # # #Procedure Grid; #var int_1.x+round(r),point_1.y); &for i := 1 to num_sides do begin )angle := 2 * pi * i / num_sides; )circle_point.x := round(point_1.x + r * cos(angle)); )circle_point.y := round(point_1.y + r * sin(angle)); )pencolor(white); )moveto(circle_point.x,circr; #begin &if not playback then put_cmd(circle_cmd) else adv_cmd; &read_twice; &if not playback then begin )put_point(point_1); )put_point(point_2) &end; &r := sqrt(sqr(point_1.x-point_2.x) + sqr(point_1.y-point_2.y)); &pencolor(none); &moveto(po&moveto(ul.x,ul.y); &moveto(lr.x,ul.y); &moveto(lr.x,lr.y); &moveto(ul.x,lr.y); &pencolor(none); &cmd := 't'; &for i := 1 to 100 do ; {delay for paddle} #end; {box} ) # # #Procedure Circle; #var &r,angle:real; &circle_point:point; &i:integeend; {get_rect} # # # #Procedure Box; #var i: integer; #begin &if not playback then put_cmd(box_cmd) else adv_cmd; &if not get_rect then begin )rem_cmd; )exit(box) &end; &pencolor(none); &moveto(ul.x,lr.y); &pencolor(white); ul.x := point_1.x; ,lr.x := point_2.x )end )else begin ,lr.x := point_1.x; ,ul.x := point_2.x )end; &if point_1.y > point_2.y )then begin ,ul.y := point_1.y; ,lr.y := point_2.y )end )else begin ,lr.y := point_1.y; ,ul.y := point_2.y )end; #)then begin ,note(30,30); ,cmd := 't'; ,get_rect := false; ,exit(get_rect) )end; &get_rect := true; &if not playback then begin )put_point(point_1); )put_point(point_2) &end; &if point_1.x < point_2.x {which corner do we have?} )then begin ,,repeat track until button(0) or button(1); ,read_paddles(point_2); ,note(20,20) )end #end; {read_twice} # # # #Function Get_rect:boolean; #begin &read_twice; &if (point_1.x = point_2.x) {do we have a rectangle?} &or (point_1.y = point_2.y) ocedure Read_twice; #begin &if playback )then begin ,get_point(point_1); ,adv_cmd; ,get_point(point_2) )end )else begin ,repeat track until button(0) or button(1); ,read_paddles(point_1); ,note(20,20); ; ,moveto(x_max,y); ,pencolor(none); ,moveto(x,y_min); ,pencolor(reverse); ,moveto(x,y_max) )end; &pencolor(none) #end; {big_cursor} #  # #Procedure Track; #begin &read_paddles(anchor); &big_cursor(anchor) #end; {track} # # #  Praddle(0)*y_scale); ,if here.y > y_max then here.y := y_max )end #end; {read_paddle} # # # #Procedure Big_cursor{here: point}; #var i:integer; #begin &for i := 1 to 2 do )with here do begin ,pencolor(none); ,moveto(x_min,y); ,pencolor(reverse)_val; &y_scale := y_max/y_val; &cmd := 't' #end; {reset_viewport} & & & #Procedure View; #begin &if not playback then put_cmd(view_cmd) else adv_cmd; &if not get_rect then begin )rem_cmd; )exit(view) &end; &x_min := ul.x; x_max := lr.x; &y_min := lr.y; y_max := ul.y; &viewport(x_min,x_max,y_min,y_max); &x_scale := (x_max - x_min) / x_val; &y_scale := (y_max - y_min) / y_val; &cmd := 't' #end; {view} # # # # Procedure Re_run; #begin &playback := true; &cmd_ctr := 0; &viewport צPascal Graphic Editor 1.2Available Commands:צ!B(ox - give two opposite corners.'C(ircle - give center and point on rim.צD(isk get or put.Bq GRAPHICE )if (cmd = 'y') or (cmd ='Y') ,then cmd := chr(27) ,else cmd := 't' &end #until (ord(cmd) = 27)  end. " ,writeln;write('Press a key to continue'); ,rem_cmd; ,read(cmd); ,cmd := 't'; ,seehires )end; &if keypress then read(cmd); # if ord(cmd) = 27 then begin )seetext; )writeln; )write('Do you really want to quit ? '); )read(cmd); abet := concat(alphabet,'[\]^_`abcdefghijklmnopqrstuvwxyz{|}~'); #reset_viewport; #initturtle; #seehires; #repeat &call_procs; &if cmd_ctr >= max_cmd - 1 )then begin ,seetext; ,writeln('Command buffer overflow!!'); ,writeln('Cmd_ctr = ',cmd_ctr);&end; &if button(0) or button(1) then rubber_band; #end; {call_procs} & &   begin {main} #cmd_ctr := 0; #command[0] := cmd_ctr; #playback := false; #cmd := 't'; #alphabet := ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ'; #alph)'c','C' : circle; )'d','D' : disk; )'f','F' : fill; )'g','G' : grid; )'e','E' : empty; )(* )'p','P' : print; )*) )'r','R' : reset_viewport; )'t','T' : track; )'v','V' : view; )'w','W' : writestring; )'x','X' : remove_last; )'?' : menu;  0) and (command[cmd_ctr] >= 0) do )cmd_ctr := cmd_ctr - 1; &cmd_ctr := cmd_ctr - 1; {remove last command word} &command[0] := cmd_ctr; &re_run #end; {remove_last} & & & #Procedure Call_Procs; #begin &case cmd of )'b','B' : box; ,write_cmd : writestring; ,rubber_cmd : rubberband )end {case} &end; {while} &playback := false; &cmd := 't' #end; {re_run} # # #  Procedure Remove_last; " var i:integer; #begin &if command[0] = 0 then exit(remove_last); &while (cmd_ctr >(0,279,0,191); &fillscreen(black); &while cmd_ctr < command[0] do begin )cmd_ctr := cmd_ctr + 1; )case command[cmd_ctr] of ,box_cmd : box; ,circle_cmd : circle; ,fill_cmd : fill; ,empty_cmd : empty; ,reset_cmd : reset_viewport; ,view_cmd : view; E(rase in viewport.צF(ill with color.G(rid in viewport.R(eset viewport.T(rack paddles (default).צ&V(iewport - give two opposite corners.צW(rite string at cursor point.צX - erase the last command.-Pressing the buttons starts Rubberband mode -צ&pressing button #1 draws a white line,צ