LnSOS BOOT 1.1 SOS.KERNEL SOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUND%INVALID KERNEL FILE: xةw,@  ȱlmi8#)!) DOBODY DOEND MAIN C D PROCS DOLINE CONSTS VARS DOWORDS Zy]'b; v] ZN]>@j<O^jtd S;!9%SEG.T j+Ÿ/ III.MSC.05u' )DISK.CODECS)!IDISKNAME.DAT1:!T DUDMANh1!1LOMARTIRE2<S'!S'*MENU.MAKER }+>/PRINTER.CONTROL ?BLANKu' BLANKu'  >dLԡm#i㰼m#iЕOLԡȱfg hi !dLԡ憦  Ljmkm l y`2 Lԡ8(Je稽)ʈ@L  !"#$%&'()*+,-./0123456789:;to look for in directory } #user_quits : boolean; { for do_xxx file reads } #oa_char : string[2]; { for do_help, do_xxx file reads } " " { get_escape -- wait forever until the user presses } procedure get_escape; es in sos.driver } #prefix : string; { Current SOS prefix } #blk_devs : array [1..MAX_BLK_DEVS] of string; #file_list : files; { list of files in a directory } #file_type : filekind; { file types #retcode : integer; { SOS Return status codes } #file_cnt : integer; { # of files in a directory } #file_idx : integer; { Pointer to file in list } #num_blk_devs : integer; { # of block devic= 12; #ESCAPE_KEY = 27; #RETURN_KEY = 13; #LEFT_ARROW = 8; {used only by do_menu: move?} #UP_ARROW = 11; #DOWN_ARROW = 10; #RIGHT_ARROW = 21;   type #date_string = string[18]; "  var enu_maker; uses #{$using /menumods/disk.lib} #chainstuff, #sosio, #console_io, #{$USING /menumods/list.cat.code } sos_catalog_list; " const " BLANK = ' '; #READ_ONLY = 1; #ON_VALUE = 255; {move to do_asci?} #MAX_BLK_DEVS s Word Processing & (with optional dumping to .printer, window by window. B.D. ) &Setting and switching disk volumes &(Machine/Memory Status removed. B.D.)  =============================================================================}  program m#The original version was written in Business Basic. # #The Pascal Menu Maker supports the following functions: # &Execution of Pascal programs &Loading of Font files &Display of the following types of text files: )PascalTEXT )ASCII )/// EZ-Piece======= #Modified Menu Maker - Pascal Version # #Author: Tom Bartkiewicz, Barbara Dudman # #Date: 21-Oct-87, 04-Mar-90 # #This is a Pascal version of the Washington Apple Pi Menu Maker program. i, and do_3ezp sub-procedures of a new do_words procedure to take advantage of common features of the three. (4/7/90) This change is reflected in changes to the main body, too.}  {=====================================================================m the textdump procedure of the module alldump, by C. M. Davidson, on the WAP contributors' disk #1, Three.Sig 1053. I used SOSIO instead of direct SOS calls, and I gathered characters into a line buffer. I have also made the procedures do_text, do_asc{3/4/90 This is modified from the Pascal MenuMaker, by Tom Bartkiewicz} { I have added a dump window facility to the reading of text, ascii, and /// E-Z Pieces WP files, to send a window at a time to .printer. The printwindow procedure is modified fro var #key : char; # begin #repeat &get_kbd( key ); #until (key = chr(ESCAPE_KEY)); end; { quit_now -- wait until the user says continue or quit } function quit_now : boolean; var #key : char; # begin #repeat &get_kbd( key ); #until (key = chr(ESCAPE_KEY)) or (key = chr(RETURN_KEY)); #if (key = chr(ESCAPE_KEY)) then &quit_now := TRUE #else &quit_now := FALSE; end;  { get_blk_devices -- obtain a list of all the block devices installed } procedure get_blk_devices; const" i : integer; { index loop counter } "  begin #viewport( 0, 0, 23, 79 ); #inverse; #clear_viewport; #ctr_print( 'WAP /// Pascal Menu Maker' ); #curlocat( 23, 0 ); #ctr_print( 'Press for HELP; to exit' ); upper left corner row } #ulc : integer; { upper left corner column } #lrr : integer; { lower right corner row } #lrc : integer; { lower right corner column viewport corners } print( ' 3EZP WP ' ); ,otherwise print( ' ???? ' ); )end; &end; end; " "  { draw_main_screen -- display the fixed portion of the display; leaves 7viewport set at 1,2 - 22,77 } procedure draw_main_screen; var " ulr : integer; {) print( concat( filler, strg )); } )case f_type of ,CODE_TYPE : print( ' Code ' ); ,TEXT_TYPE : print( ' Text ' ); ,ASCI_TYPE : print( ' Ascii ' ); ,FONT_TYPE : print( ' Font ' ); ,CAT_TYPE : print( ' Catalog ' ); ,EZWP_TYPE : #strg : string; { temporary } #  begin #with file_list do &begin )filler := copy( blanks, 1, length(blanks )-length(name )); )print( concat( name, filler )); ){ str( size, strg ); ) filler := copy( blanks, 1, 5-length(strg)); pretty_date ); end; " { list_files -- print the files on the console } procedure list_file( var file_list : files_rec ); const #BLANKS = ' '; { 16 blanks }   var #filler : string; { empty space } + (ord(oldf[6]) - ascii_0); &newf := concat( copy( oldf, 7, 2 ), '-', copy( MONTHS, 3*idx+1, 3 ), 6 '-', copy( oldf, 3, 2 ), ' ', copy( oldf, 10, 2 ), 7':', copy( oldf, 12, 2 )) #end;  begin #sos_get_time( time_buf ); #make_pretty_date( time_buf, e( oldf : date_string; var newf : date_string ); # #const &MONTHS = '???JanFebMarAprMayJunJulAugSepOctNovDec'; & #var &idx : integer; &ascii_0 : integer; & #begin &newf := BLANK; &ascii_0 := ord( '0' ); &idx := ((ord(oldf[5]) - ascii_0) * 10) end;   { get_date_time -- get system date and time } procedure get_date_time( var pretty_date : date_string ); var #time_buf : date_string; # # #{ make_pretty_date -- format system date/time notation to decent form } #procedure make_pretty_datrns a value greater than 127 (msb is 1 for blk devs } )sos_d_info( i, dev_name, dev_list, retcode ); )if (retcode = 0) and (dev_list[2] > chr(127)) then ,begin /num_blk_devs := num_blk_devs + 1; /blk_devs[num_blk_devs] := dev_name; ,end; &end; har; { returned device attributes } # begin #num_blk_devs := 0; #for i := 1 to MAX_DEVICES do &begin ){ search all possible device entries for a valid block device } ){ block devices are found when the 2nd character in the device } ){ list retuCONTRIBUTIONS DISK #4 DISK #MAX_DEVICES = 24; { maximum number of devices in sos.driver } # var #i : integer; { loop counter } #dev_name : string; { device name string } #dev_list : packed array [0..10] of c#curlocat( 12, 0 ); #ctr_print( 'Washington Apple Pi, Ltd.' ); #wait( 60 ); #normal; #ulr := 11; #ulc := 37; #lrr := 12; #lrc := 42; #viewport( ulr, ulc, lrr, lrc ); #clear_viewport; #wait( 1 ); #for i := 1 to 5 do &begin )ulr := ulr - 2; )lrr := lrr + 2; )ulc := ulc - 7; )lrc := lrc + 7; )viewport( ulr, ulc, lrr, lrc ); )clear_viewport; )wait( 1 ); &end; #curlocat( 0, 0 ); end; { synch_prefix -- set the sos prefix equivalent to the pascal prefix } procedure synch_prefix( var curren2i := 1 /else 2i := i + 1 ,else if ord( key ) = UP_ARROW then { up arror } /if i = 1 then 2i := num_vols /else 2i := i - 1 ,else if ord( key ) = RETURN_KEY then /begin 2new_prefix := vol_name[i]; 2do_vol_list := true /end; ,if i <> old then[i], ' is off-line.' )); #if num_vols > 0 then &begin )i := 1; )curlocat( i, 17 ); )inverse; )print( vol_name[i] ); )normal; )repeat ,old := i; ,get_kbd( key ); ,if ord( key ) = DOWN_ARROW then { down arrow } /if i = num_vols then locat( num_vols, 17 ); /print( vol_name[num_vols] ); /println( concat( ' in drive ', blk_devs[i] )) ,end )else ,on_line[i] := false &end; #for i := 1 to num_blk_devs do &if (on_line[i] = false ) then )println( concat( ' ', blk_devs#curlocat( 0, 0 ); #for i := 1 to num_blk_devs do # begin )sos_volume( blk_devs[i], vol_name[num_vols+1], tb, fb, retcode ); )if retcode = 0 then ,begin /on_line[i] := true; /num_vols := num_vols + 1; /insert( '/', vol_name[num_vols], 1 ); /cur#on_line : packed array [1..max_blk_devs] of boolean; # begin #do_vol_list := false; #num_vols := 0; #new_prefix := prefix; #open_window( 3, 10, 4+num_blk_devs, 70, 'Volumes On-Line', &'Press to select a new volume, to exit.' ); integer; { Number of on-line volumes } #old : integer; { Temporary variable } #vol_name : packed array [1..max_blk_devs] of string[16]; { the volumes name } { total blocks on a volume } #fb : integer; { free space on a volume } #i : integer; { loop counter } #key : char; { User's key stroke } #num_vols : vol_list -- present a list of all the volumes currently on line. The } { user may change the prefix by selecting a new active volume } function do_vol_list( var new_prefix : string ) : boolean; var #tb : integer; #println( concat( oa_char, 'V displays, selects available block devices' ) ); #println( concat( oa_char, '? displays this information' ) ); #println( ' ' ); #ctr_print( 'Program written by Tom Bartkiewicz' ); #get_escape; #close_window; end; { do_s the prefix to the directory.' ); #println( ' Ascii : Displays the file.' ); #println( ' Text : Displays the file.' ); #println( ' 3EZP WP : Formats and displays the file.' ); #print( '-----------------------------------------------' ); s to select it.' ); #println( ' ' ); #println( ' Action taken depends on selected file''s type.' ); #println( ' Code : Runs the selected program.' ); #println( ' Font : Downloads the font to the console.' ); #println( ' Catalog : Setwindow( 3, 17, 20, 63, 'Menu Maker v1.0 Help Screen', 0'Press to continue...' ); #curlocat( 0, 0 ); #get_date_time( today ); #r_print( today ); #curlocat( 2, 0 ); #println( ' Use the arrow keys to highlight a file' ); #println( ' and pres#sos_set_prefix( current_prefix, retcode ); #if (retcode <> 0) then &println( 'Error synchronizing Pascal-SOS prefix' ); end; { do_help -- give the user the low down on this program } procedure do_help; var #today : date_string; # begin #open_t_prefix : string ); var #s_len : integer; begin #get_prefix( current_prefix ); # #{ remove trailing / from prefix } #s_len := length( current_prefix ); #if (current_prefix[s_len] = '/' ) then &delete( current_prefix, s_len, 1 ); /begin 2curlocat( old, 17 ); 2print( vol_name[old] ); 2curlocat( i, 17 ); 2inverse; 2print( vol_name[i] ); 2normal /end )until ((key = chr(RETURN_KEY)) or (key = chr(ESCAPE_KEY))) &end; #close_window; end; { confirm_quit -- make sure that the user really wants to leave menu.maker } function confirm_quit : boolean; begin #open_window( 19, 19, 20, 57, 'Exit MENU MAKER?', ' ' ); #println( ' Press to exit Menu Maker ' ); #print( ' Press to return to the menu' ); #confirm_8else ;temp := file_cnt; )RETURN_KEY : do_item := true; )RIGHT_ARROW : if ((odd( temp )) and (temp < file_cnt)) then ;temp := temp + 1; )ESCAPE_KEY : if confirm_quit then ;do_item := false 8else ;key := chr(0); ( 175, 191 : do_help; #repeat &get_kbd( key ); &case (ord( key )) of )LEFT_ARROW : if (not odd( temp )) then ;temp := temp - 1; )DOWN_ARROW : if (temp < file_cnt-1 ) then ;temp := temp + 2 8else ;temp := 1; )UP_ARROW : if (temp > 2 ) then ;temp := temp - 2 edure move_to_item( i : integer );  #begin &if (odd( i mod 2 )) then )curlocat( 3+(i div 2 ), 4 ) &else )curlocat( 2+(i div 2 ), 44 ); #end; # begin #temp := file_idx; #move_to_item( temp ); #inverse; #list_file( file_list[temp] ); #normal; &end; end;  { do_menu -- allow the user to select a file or option to be acted upon } function do_menu( var file_idx : integer ) : boolean; var #key : char; #temp : integer; #do_item : boolean; #new_prefix : string;  #proc,end &end; & #{ display the list of files of the selected type(s ) in this directory } # #for i := 1 to file_cnt do &begin )if (odd( i mod 2 )) then ,curlocat( 3+(i div 2 ), 4 ) )else ,curlocat( 2+(i div 2 ), 44 ); )list_file( file_list[i] ); eans to move towards the } #{ root directory via this subdirectories parent } # #else if is_subdir( prefix ) then &begin )file_cnt := file_cnt + 1; )with file_list[file_cnt] do ,begin /name := PARENT_NAME; /f_type := CAT_TYPE; /size := 0; ors on return } # #list_catalog( file_type, prefix, file_list, file_cnt, retcode ); #if retcode <> 0 then &begin )println( ' ' ); )inverse; )println( 'Error in directory processing' ); )normal; &end # #{ if this is a subdirectory, provide the m; #file_cnt := 0; #if (partial_prefix = PARENT_NAME ) then &pop_catalog #else if (partial_prefix <> BLANK ) then &push_catalog( partial_prefix ); #clear_viewport; #curlocat( 1, 0 ); #ctr_print( prefix ); # #{ get the file names and check for err#function is_subdir( test_prefix : string ) : boolean; # #begin &delete( test_prefix, 1, 1 ); { remove 1st char (always . or / ) } &if pos( '/', test_prefix ) = 0 then )is_subdir := false &else )is_subdir := true; #end;  begin #retcode := 0efix := concat( prefix, '/', partial_prefix ); &if (set_prefix( prefix )) then )synch_prefix( prefix ) &else )println( 'Error setting new prefix' ); #end; # # #{ is_subdir -- determine if a prefix is a directory or subdirectory } f (set_prefix( prefix )) then )synch_prefix( prefix ) &else )println( 'Error setting new prefix' ); #end; # # #{ push_catalog -- add a subdirectory to the current directory tree } #procedure push_catalog( partial_prefix : string ); # #begin ≺ { true when last / has been found } & #begin &found := false; &i := length( prefix ); &while (i > 0 ) and (not found ) do )if (prefix[i] = '/' ) then ,found := true )else ,i := i - 1; &delete( prefix, i, (length(prefix ) - i ) + 1 ); &iconst #PARENT_NAME = '< ..Parent.. >'; # var #i : integer; { loop counter }   #{ pop_catalog -- set the prefix to this catalogs parent } #procedure pop_catalog; # #var &i : integer; { counting variable } &found : booleanquit := (not quit_now ); #close_window; end; { do_catalog -- set the new prefix and obtain all files of interest in the 0 directory then display the files name, size, and type in 0 the window } procedure do_catalog( partial_prefix : string ); { oa-/ or oa-? } )214, 246 : if (do_vol_list( new_prefix )) then { oa-v or oa-V } ;begin >prefix := new_prefix; >if (set_prefix( prefix )) then Abegin Dsynch_prefix( prefix ); Ddo_catalog( BLANK ) Aend; >file_idx := 1; >temp := file_idx; >move_to_item( file_idx ); >inverse; >list_file( file_list[file_idx] ); >normal ;end; &end; &if (temp <> file_idx ) then )begin ,move_to_item( file_idx ); ,list_file( file_list[file_idx] ); ,move_to_item( temp ); ,inverse; "const oap = 240; oabigp = 208; {for trial print dump} "var key:char; "begin &repeat *get_kbd( key ) &until ( key=chr( oap)) or ( key=chr( oabigp)) or ,( key = chr( ESCAPE_KEY)) or ( key = chr( RETURN_KEY)); &if ( key=chr( oap)) or ( key=chbuf, 1, COLMAX, retcode ); ,sos_s_write ( prt_idx, cr_lf, 1, 2, retcode ); ,row := row + 1 'until row = ROWMAX; 'sos_close ( prt_idx, retcode ) "end; {printwindow} " "Procedure printquery; {mine: print?} hen 3scrnchar := chr( ord( scrnchar ) - 128 ); {strip hi bit} 1if ord( scrnchar ) < 32 then 1 scrnchar := chr( 32 ); {replace control character by space} 1col := col + 1; 1linebuf[col] := scrnchar ,until col = COLMAX; ,sos_s_write ( prt_idx, line ( printer, WRITE_ONLY, 0, sysbuf, prt_idx, retcode ); 'sos_s_write ( prt_idx, cr_lf, 1, 2, retcode ); 'row := 0; 'repeat ,col := 0; ,repeat 1curlocat ( row, col ); 1sos_d_status ( con_id, READ_SCRN, scrnchar, retcode ); 1if ord( scrnchar ) > 127 t'cr_lf := ' '; cr_lf[1] := chr( 13 ); cr_lf[2] := chr( 10 ); 'printer := '.PRINTER'; console := '.CONSOLE'; 'fillchar ( linebuf[1], COLMAX, ' ' ); '{$R-} 'linebuf[0] := chr( COLMAX ); '{$R+} 'sos_get_D_num ( console, con_id, retcode ); 'sos_open printer, *console : string[10]; *cr_lf : string[2]; {make console_io's public? } *linebuf : string; *prt_idx, *con_id, *row, col : integer; *scrnchar : char; *sysbuf : char; * "begin of direct SOS calls, and characters have been gathered into a line buffer instead of being sent to the printer singly.} "const READ_SCRN = 17; *COLMAX = 80; *ROWMAX = 21; {window of menumaker's do_xxx} *WRITE_ONLY = 2; " "var { current line in the window } " " "Procedure printwindow; {The printwindow procedure is modified from the textdump procedure of the module alldump, by C. M. Davidson, on the WAP contributors' disk #1, Three.Sig 1053. SOSIO is used instead%sysbuf : char; { sos i/o buffer; not used } %in_buff : string; { input buffer for reads } %w_width : integer; { window width } %w_height : integer; { window height } %cur_line : integer; 22; #WR = 79;  var header, %footer, %type_name : string; %ifd : integer; { text file; internal file descriptor } %bytesread : integer; { number of bytes read from text file } ing the three kinds of wordy files } const #CM_ADVANCE = 1; { .console cursor movement constants } #CM_WRAP = 4; #CM_SCROLL = 8; #WT = 2; { window corner coordinates } #WL = 0; #WB = R' ); #normal; #curlocat( 7, 0 ); #clear_eov; #setchain( prog_name ); #exit( program ); end; { do_words -- display the selected wordy file in the window, and maybe print it} Procedure do_words( name : string; f_type : integer ); { a shell for process#curlocat( 2, 0 ); #clear_eov; #curlocat( 3, 0 ); #ctr_print( concat( 'Running program: ', prog_name ) ); #viewport( 0, 0, 23, 79 ); #curlocat( 6, 0 ); #inverse; #clear_eol; #ctr_print( 'When program finishes, enter X to restart MENU.MAKE,list_file( file_list[temp] ); ,normal; ,file_idx := temp; )end; #until ((key = chr(RETURN_KEY)) or (key = chr(ESCAPE_KEY))); #do_menu := do_item; end; { do_exec -- run the selected pascal program } procedure do_exec( prog_name : string ); begin r( oabigp)) then printwindow &else if ( key=chr( ESCAPE_KEY)) then user_quits:=true "end; Procedure do_line; " "begin )cur_line := cur_line + 1; )if ( cur_line > w_height ) then ,begin /cur_line := 1; /printquery; /clear_viewport; ,end; "end; {do_line} " "Procedure finish_up; " "begin " cursor_movement( CM_ADVANCE + CM_WRAP + CM_SCROLL ); %sos_close( ifd, retcode ); %if (not user_quits ) then (printquery; %close_window; %viewport( 1, 2, 22, 77 ); { set window to normal menu ma#while ((retcode = 0 ) and (not user_quits)) do &begin ){ a text record, get the line of text associated with this record } )if (ord( cmd_buff[1]) < 208 ) then ,begin /sos_set_mark( ifd, 2, 2, 0, retcode ); { jump ahead 2 bytes } /sos_s_read( ifd, y [0..1] of char; { command input buffer }  begin #sos_set_mark( ifd, 0, 300, 0, retcode ); { advance past 300 byte header } #if (retcode = 0) then &sos_read( ifd, cmd_buff, 2, bytesread, retcode ); { read 1st rec } h, bytesread, retcode ); &end; #finish_up; end;  { do_3ezp -- display the selected /// EZ Pieces WP file in the window } procedure do_3ezp( wp_file : string ); #  var #i : integer; { index counter } #cmd_buff : packed arra#sos_s_read( ifd, in_buff, 1, w_width, bytesread, retcode ); #while ((retcode = 0) and (not user_quits)) do &begin ){$RANGECHECK-} )in_buff[0] := chr( bytesread ); ){$RANGECHECK+} )do_line; )println( in_buff ); )sos_s_read( ifd, in_buff, 1, w_widt)read_a_line( ifd, in_buff, retcode ); &end; $finish_up end; { do_text } { do_asci -- display the selected ascii text file in the window } procedure do_asci( ascii_file : string );  begin #sos_newline( ifd, ON_VALUE, chr( RETURN_KEY ), retcode ); #if (retcode = 0 ) then &sos_read( ifd, page_buff, 1024, bytesread, retcode ); { read 1st page } &if (retcode = 0 ) then )read_a_line( ifd, in_buff, retcode ); #while ((retcode = 0) and (not user_quits)) do &begin )do_line; )println( in_buff ); _buff[spaces+1], chr_cnt ); &pbuf_pos := pbuf_pos + chr_cnt; &{ set the string length } &in_buff[0] := chr( chr_cnt + spaces ); &{$RANGECHECK+} #end;  begin #pbuf_pos := 0; #sos_set_mark( ifd, 0, 1024, 0, retcode ); { advance past header page }ll out the line until the max length is reached or found } &{ must use 79-spaces instead of 80 since scan counts from 0, not 1 } &{$RANGECHECK-} &chr_cnt := scan( (79-spaces), =chr(CR), page_buff[pbuf_pos] ) + 1; &moveleft( page_buff[pbuf_pos], in&if (page_buff[pbuf_pos] = chr(DLE)) then )begin ,spaces := ord( page_buff[pbuf_pos+1] ) - 32; ,if ((spaces > 0) and (spaces < 80)) then /fillchar( in_buff[1], spaces, chr(SPACE) ) ,else /spaces := 0; ,pbuf_pos := pbuf_pos + 2; )end; & &{ now fi); ,if ((retcode = 0 ) and (bytesread = 1024)) then /pbuf_pos := 0 ,else /begin / retcode := 1; 2exit( read_a_line ); /end; )end; & &{ pbuf_pos now points to a valid character in a string } &{ see if we need to do DLE expansion } o in_buff } # #begin &spaces := 0; &chr_cnt := 0; & &{ determine if we need to read in the next page from the text file } &if ((pbuf_pos = 1023) or (page_buff[pbuf_pos] = chr(NULL))) then )begin ,sos_read( ifd, page_buff, 1024, bytesread, retcode r in_buff : string; 9var retcode : integer ); 4 #const &NULL = 0; &DLE = 16; &CR = 13; &SPACE = 32; & #var &spaces : integer; { # of DLE expansion spaces added to line } &chr_cnt : integer; { number of characters xfer'd t#page_buff : two_blocks; { page buffer for text file reads } #pbuf_pos : integer; { position in the page buffer } # #{ read_a_line -- read the next line of text from a pascal text file } #procedure read_a_line( ifd : integer; vaker proportions } "end; {finish_up} { do_text -- display the selected pascal text file in the window } procedure do_text( text_file : string ); { cut up from Tom's for shell } #  var in_buff, 1, ord(cmd_buff[0])-2, bytesread, ;retcode ); /{$RANGECHECK-} /in_buff[0] := chr( bytesread ); /{$RANGECHECK+} /{ strip out special codes in the text string } /for i := bytesread downto 1 do 2if (ord( in_buff[i] ) < 32 ) then 5case ord( in_buff[i] ) of 81 : in_buff[i] := chr(18); { begin bold } 82 : in_buff[i] := chr(17); { end bold } 811: in_buff[i] := ' ' { sticky space } 8otherwise delete( in_buff, i, 1 ); 5end; /do_line; /println( in_buff ); ,end , ){ a li> IGHT 1983 BY PRO/PAC, INC." =5:*"THIS PROGRAM WILL SET UP YOUR APPLE"+"IMAGEWRITER FOR SOME OF THE PRINTING",L"OPTIONS AVAILABLE SUCH AS BOLD PRINT,"."COMPRESSED CHARACTERS, & OTHER OPTIONS."."----------------------------------( œ: DOES NOT STOP PROGRAM ON ERROR #16);1): 40 COLUMN DISPLAY  40C @20000 X=12500:X: SCREEN PAUSE:." APPLE IMAGEWRITER PRINTER ".X" CONTROL PROGRAM "4=22:" PROGRAM COPYR<=LOMARTIRE2vS'' '*DISK.CLEAN AT J<)DISK.TEXTKT I<$DOCSZT S<DT.BASIC gT J/ <-READ.ME.FIRST T S< do_font ) )end #end; # # #{ get_font -- read the font file into the font buffer } #procedure get_font( font_file : string ); # #var &ifd : integer; { font file; internal file descriptor } &bytesread : integer; { number o#fontbuf : two_blocks; { new font to be downloaded } # # #{ error_chk -- check for and process errors } #procedure error_chk( retcode : integer ); # #begin &if retcode <> 0 then )begin ) writeln( 'SOS i/o error # ', retcode ); ,exit(YPE then do_asci( name ) % else if f_type = EZWP_TYPE then do_3ezp( name ) "end; { do_words }  { do_font -- change the font to the selected font } procedure do_font( font_file : string ); $ var w( WT, WL, WB, WR, header, footer ); %sos_open( name, READ_ONLY, 0, sysbuf, ifd, retcode ); %cursor_movement( CM_ADVANCE ); %in_buff := ' '; %cur_line := 0; %user_quits := FALSE; %if f_type = TEXT_TYPE then do_text( name ) % else if f_type = ASCI_T 'Press',oa_char,'-P to print, for next page, '); %footer := concat( footer,' to quit.' ); %w_width := (WR - WL) + 1; %w_height := (WB - WT) + 1; %viewport( 1, 0, 23, 79 ); { set full screen width for text display } %open_windo%if f_type = TEXT_TYPE then type_name := 'Text' % else if f_type = ASCI_TYPE then type_name := 'ASCII' % else if f_type = EZWP_TYPE then type_name := '/// E-Z Pieces WP'; %header := concat( 'Listing ',type_name,' File: ',name ); %footer := concat(ne record was encountered, write out a blank line } )else if (ord( cmd_buff[1] ) = 208 ) then ,begin /do_line; /println( ' ' ); ,end; )sos_read( ifd, cmd_buff, 2, bytesread, retcode ); &end; #finish_up; end;   begin 8d **** A DISK DRIVE CLEANER PROGRAM *****x200( ***** ALARM BELL *****'LOOP=110:7);:WAIT=1100::: 16);1.=10:"40C";"DISK DRIVE CLEANER PROGRAM"WAIT=11500::S,=3:"This psen for cleaning in successive order. If only one drive"N|"is to be cleaned, enter '1' for the number of drives to be cleaned, and"L"that specific drive number for the lowest drive number to be cleaned."F"Insert the cleaner disk in the appGOBLOCK GOBLOCK  ".Dg`UUhhhhhhLpi0&Lp쭖 ȭHH` Written by Bob Consorti.BDEF[A3/1.2] GOBLOCK @GHIrogram allows the use of commercially available head cleaner disks"R@"with an Apple ///. Input how many drives you will be cleaning (up to four)"UT"and the lowest drive number of those units to be cleaned. All selected drives"Oh"will then be choropriate drive AT THE PROMPT."Y=15:=1:29);:"Enter total number of drives to be cleaned (1 - 4): ";:"";total%$(total%>4total%<1)140:460R=17:=1:31);:"Enter the lowest drive number to be cleaned: ";:"";start%$(start%>4start%<1)140:500whoa%=start%+total%-10whoa%>4140:460D0,1980,24X".D1/DISK.CODE"ld.num%=start%whoa%4"Insert the cleaning disk in drive .d";d.num%:6"Press [RETURN] to begin, [ESCAPE] to abort." =4:g$g$=; corresponding to the drive they want to access (.D1 - .D4) and 'block.num' ; is the block number on the disk they want to access. ; ; --------------------------------------------------------------------------- ; ; This was written from a request by John ivates the selected disk drive and attempts to read a block. ; ------------------------------------------------------------------------ ; PERFORM GoBlock(%d.num,%block.num) ; ; Where 'd.num' is a Business Basic integer type that is a number from 1-4 usiness Basic invokable module to activate a 5.25 disk drive for the ; purpose of head cleaning. ; ; --------------------------------------------------------------------------- ; ; There is one routine that this invokable contains. It is: ; ; GoBlock: Act; ; This file may be reproduced freely as long as this notice of authorship ; remain intact. ; ; Version 1.00 First Started: 10/07/90 Last Revision: 10/07/90 ; ; --------------------------------------------------------------------------- ; ; A B; =========================================================================== ; ; Apple /// Business Basic Disk Activation Routines ; ------------------------------------------------- ; by Bob Consorti (c) 1990 by ON THREE, Inc. With all rights reserved. JLMNOPQRSTUVWX0 1 2 3  O^zxT=11500: :1100:lk.num%)blk.num%;" "; blk.num% d.num%:O=21:=1:29);::"Press [RETURN] to repeat, [ESCAPE] to exit.";:c$$c$=13):4608c$<>27)140:1000 L::/`::=23:=1::"Error #";;" in line #";;tWAI27)1000g$<>13)140:700:2 "Cleaning drive .D";d.num%;" Please wait." œ:=32880:ۺ11204(".D"+d.num%))4H:::"NOT A CLEANING DISK. PRESS [RETURN]."\:b$:640pblk.num%=12798Goblock(%d.num%,%bLomartire for a way to activate a ; dik drive and position the r/w head on different areas so as to not wear ; out the cleaning disk in one spot only. ; ; =========================================================================== ; =========================================================================== ; Macro Defintions ; =========================================================================== (.MACRO SOS ;To make SOS calls (BRK (.BYTE %1 (.WORD %2 (.ENDM (.MACRO 0.ASCII ".D" Dr_Num .BYTE 00 D_Num .WORD 00 ;Temp integer for device number Our_Addr .WORD 00 ;Temp for return address Info_List .BYTE 04 ;Param count Info_Num .BYTE6. ;Leave room for one block 0.BLOCK 256. D_List .BYTE 02 ;Param count 0.WORD D_Name ;Pointer to device name Dev_Num .BYTE 00 ;Returned device number D_Name .BYTE 03 .BYTE 00 ;Device number 0.WORD R_Buf ;Read buffer 0.WORD 0200 ;1 block (512 bytes) Blk_Num .WORD 00 ;Block to read 0.WORD 0000 ;Transfer count R_Buf .BLOCK 25------------------------------------------------------ ; ; Data area below ; ; --------------------------------------------------------------------------- (.ASCII "Written by Bob Consorti." BRead_List .BYTE 05 ;Param count BRead_Dev; =========================================================================== Basic_Error LDA #14. ;We want to raise a basic error 0STA Subrnumb ;condition 0JSR Dispatch ;Does not return ; --------------------- BRead_Dev 0SOS Read_Block,BRead_List ;Do it...and fall to exit ; --------------------------------------------------------------------------- Re_Exit PUSH Our_Addr 0RTS ;Return like this k that the block they 0CMP Info_Blks+1 ;want us to access is in range 0BCC $30 0BNE $00 LDA Blk_Num 0CMP Info_Blks 0BCS $00 $30 LDA Dev_Num ;Setup for the read 0STA;Setup for the D_Info call 0STA Info_Num 0SOS D_Info, Info_List ;Check if it's a drive 0LDA Info_Type ;Check it's a disk drive 0BPL $15 ;If not error out 0LDA Blk_Num+1 ;Chec0SOS Get_Dev_Num,D_List ;See if the device exits 0BEQ $20 $15 LDX #38. ;'Resource Not Available' error  JMP Basic_Error ;Does not return  $20 LDA Dev_Num oes not return $10 LDA D_Num ;Make sure it's in the range of 1-4 0BEQ $00 0CMP #05 0BCS $00  CLC ;Convert binary 1-4 to ascii 1-4 0ADC #"0" 0STA Dr_Num ;And the drive number  LDA D_Num+1 ;Make sure it's not out of range BEQ $10 $00 LDX #05 ;Give them an 'Illegal Quantity' error  JMP Basic_Error ;Db .EQU 0E7 ; =========================================================================== 0.PROC GoBlock,2 POP Our_Addr ;Save the return address 0POP Blk_Num ;Get the block number 0POP D_Num ; =========================================================================== Read_Block .EQU 80 ;For SOS Get_Dev_Num .EQU 84 D_Info .EQU 85 Dispatch .EQU 0E4 ;Business Basic internals SubrnumPOP (PLA (STA %1 (PLA (STA %1+1 (.ENDM  .MACRO PUSH (LDA %1+1 (PHA (LDA %1 (PHA (.ENDM ; =========================================================================== ; Equates 00 0.WORD Info_Name 0.WORD Info_Opts 0.BYTE 07 ;Thru total blocks field Info_Name .BLOCK 16. ;Leave space for the largest name  Info_Opts .BYTE 00 ;Slot ( .BYTE 00 ;Unit num Info_Type .BYTE 00 ;Device type 0.BYTE 00 ;Sub type 0.BYTE 00 ;Not used Info_Blks .WORD 00 ; --------------------------------------------------------------------------- 0.END ======================================================================= .PROC GoBlock,2 POP Our Addr ;Save the return address POP Blk Num ;Get the block number POP ================================================= Read Block .EQU 80 ;For SOS Get Dev Num .EQU 84 D Info .EQU 85 Dispatch .EQU 0E4 ;Business Basic internals Subrnumb .EQU 0E7 ; ==== STA %1+1 .ENDM .MACRO PUSH LDA %1+1 PHA LDA %1 PHA .ENDM ; =========================================================================== ; Equates ; ============================================================================================= .MACRO SOS ;To make SOS calls BRK .BYTE %1 .WORD %2 .ENDM .MACRO POP PLA STA %1 PLA areas so as to not wear ; out the cleaning disk in one spot only. ; ; =========================================================================== ; =========================================================================== ; Macro Definitions ; ======== block number on the disk they want to access. ; ; --------------------------------------------------------------------------- ; ; This was written from a request by John Lomartire for a way to activate a ; disk drive and position the r/w head on different-------------------------------------------------------- ; PERFORM GoBlock(%d.num,%block.num) ; ; Where 'd.num' is a Business Basic integer type that is a number from 1-4 ; corresponding to the drive they want to access (.D1 - .D4) and 'block.num' ; is theof head cleaning. ; ; --------------------------------------------------------------------------- ; ; There is one routine that this invokable contains. It is: ; ; GoBlock: Activates the selected disk drive and attempts to read a block. ; ----------------emain intact. ; ; Version 1.00 First Started: 10/07/90 Last Revision: 10/07/90 ; ; --------------------------------------------------------------------------- ; ; A Business Basic invokable module to activate a 5.25 disk drive for the ; purpose Y[\]^_`abcdef ; Apple /// Business Basic Disk Activation Routines ; ------------------------------------------------- ; by Bob Consorti (c) 1990 by ON THREE, Inc. With all rights reserved. ; ; This file may be reproduced freely as long as this notice of authorship ; r This is the ASCII version of a Pascal source code written by Bob Consorti and used to produce the invokable module (for use with Apple /// Business Basic) called DISK.CODE. ; =========================================================================== ; D Num ;And the drive number LDA D Num+1 ;Make sure it's not out of range BEQ $10 $00 LDX #05 ;Give them an 'Illegal Quantity' error JMP Basic Error ;Does not return $10 LDA D Num ;Make sure it's in the range of 1-4 BEQ $00 CMP #05 BCS $00 CLC ;Convert binary 1-4 to ascii < This is a short Business Basic program to illustrate: how DISK.CODE can be used to activate disk drives.&( Written by Bob Consorti 10/902:<:Z".d1/disk.code" dd.num%=1blk.num%=02798,GoBlock(%d.num%,%blk.num%) ^TE 00 ;Not used Info Blks .WORD 00 ; --------------------------------------------------------------------------- .END Name .BLOCK 16. ;Leave space for the largest name Info Opts .BYTE 00 ;Slot .BYTE 00 ;Unit num Info Type .BYTE 00 ;Device type .BYTE 00 ;Sub type .BY ;Temp for return address Info List .BYTE 04 ;Param count Info Num .BYTE 00 .WORD Info Name .WORD Info Opts .BYTE 07 ;Thru total blocks field Info name Dev Num .BYTE 00 ;Returned device number D Name .BYTE 03 .ASCII ".D" Dr Num .BYTE 00 D Num .WORD 00 ;Temp integer for device number Our Addr .WORD 00 .WORD 0000 ;Transfer count R Buf .BLOCK 256. ;Leave room for one block .BLOCK 256. D List .BYTE 02 ;Param count .WORD D Name ;Pointer to device ;Param count BRead Dev .BYTE 00 ;Device number .WORD R Buf ;Read buffer .WORD 0200 ;1 block (512 bytes) Blk Num .WORD 00 ;Block to read n ; --------------------------------------------------------------------------- ; ; Data area below ; ; --------------------------------------------------------------------------- .ASCII "Written by Bob Consorti." BRead List .BYTE 05 =========================================================================== Basic Error LDA #14. ;We want to raise a basic error STA Subrnumb ;condition JSR Dispatch ;Does not returv SOS Read Block,BRead List ;Do it...and fall to exit ; --------------------------------------------------------------------------- Re Exit PUSH Our Addr RTS ;Return like this ; nge BCC $30 BNE $00 LDA Blk Num CMP Info Blks BCS $00 $30 LDA Dev Num ;Setup for the read STA BRead De ;Check it's a disk drive BPL $15 ;If not error out LDA Blk Num+1 ;Check that the block they CMP Info Blks+1 ;want us to access is in raMP Basic Error ;Does not return $20 LDA Dev Num ;Setup for the D Info call STA Info Num SOS D Info, Info List ;Check if it's a drive LDA Info Type 1-4 ADC #"0" STA Dr Num SOS Get Dev Num,D List ;See if the device exits BEQ $20 $15 LDX #38. ;'Resource Not Available' error Jblk.num% blk.num%iDUDMANv1' '+BPMENU.TEXT7l11 h+DUMPER.CODE 19 h+DUMPER.TEXTr?|19 h/DUMPERDOCS.TEXTk 19' h/GETTIMEASM.CODE1O8h/GETTIMEASM.TEXTinitial data in the lobytes and hibytes sections and interchanging decs and incs in refresh and refresh2. I also renamed the blocks to keep block1 at the top of the screen. HBarbara Dudman prints a graphics byte with its lsb at the top.) Davidson reads from upper right, down columns and I needed to read from lower left, up columns. This meant only replacing the printout still looked funny. I  finally figured out that I needed to rotate from screen to printer by the opposite quarter-turn to the one C. M. Davidson used. (A byte in memory appears  on the screen with its lsb at the left and the Imagewriter II ad_list section and replaced the lin192_buf and lin384_buf data lines by Imagewriter II escape sequences. I also needed to  add data sections for character pitch and line pitch and calls to write these to the printer in the setup subroutine. But the 8Dumperdocs 1/25/90 %To adapt the module alldump, by C. M. Davidson, (WAP contribs disk 1,  Three.Sig 1053) to work with the Imagewriter II, I made the following changes: %No changes for textdump: works perfectly. ( %For graphics, I removed the jlmnopO^yh 1O7h*MENU2.TEXT,1- h-READ.ME.FIRST_1Sh.TIMESTAMP.CODE1O0h.TIMESTAMP.TEXT 17 h ;if so, finish up 0inc linctr 0jsr refresh2 ;if not, init. bytes 0jmp $1 ;and start a new line finis sos close,cl_list ;close .printer 0rts ;re sos write,lin192_list ;sets up 192 dots/line jsr block3 0jsr block2 0jsr block1 0sos write, cr_list ;CR/LF 0lda linctr 0cmp #27 ;done 40 lines? 0beq finis ;Procedure DUMP2000. Dumps $2000 graphics page to ImagewriterII printer.  ;----------------------------------------------------------------------- 0 0jsr setup 0jsr lobytes ;sets up lookup tables 0jsr hibytes $1 address pointer 8 0.macro sos ;makes SOS calls 0brk 0.byte %1 0.word %2 0.endm 0 0 0.proc dump2000 ;----------------------------------------------------------------------- u 0CC d_status .equ 082 get_dev_num .equ 084  ctr .equ 90 ;counts blocks of 16 bytes linctr .equ 80 ;counts lines ptr .equ 50 ;zp1 and 2, graphics 560, and text  ;------------------------------------------------------------------------ :;*** Macros and .equs *** 8 open .equ 0C8 ;SOS call numbers write .equ 0CB close .eq  ; Module DUMPER  ; Modified by Barbara Dudman from alldump, by C. M. Davidson, ; from WAP Contributers Disk 1 (Three.Sig 1053) ; to use the ImagewriterII 1/25/90 ; Procs dump2000, dump4000, dumpboth, textdump ; for graphics 280 page qstuvwxyz{|}~1 2 3 5 6 7 4 lt?(*JeO^rturn to BASIC or Pascal setup sos open,op_list ;opens printer 0lda op_ref ;store printer refnum 0sta da_ref ;for data write, 0sta cr_ref ;CR/LF, 0sta cl_ref ;close, 0sta cpitch_ref ;char pitch, 0sta lpitch_ref ;line pitch, 0sta lin192_ref ;and 192 dots/line 0sos write,cpitch_list ;set char pitch 0sos write,l ;done 8 bytes yet? $3 bne $4 ;if not, go for more 0inx ;increment lo-byte index 0cpx #4 ;done 16 bytes yet? 0bne $5 ;if not, go fo ldy #0 ;and hi-byte index $4 jsr setptr ;make byte pointer 0jsr prbyte ;print byte 0iny ;increment hi-byte index 0cpy #8 0cmp #4 ;done 64 bytes yet? 0bne $6 ;if not, go for more 0jsr hibytes 0rts ;on to block2 0 block2 ldx #02 ;init lo-byte index $5 ;done 16 bytes yet? 0bne $5 ;if not, go for more 0jsr refresh ;decrement hi-byte table 0ldx #0 ;resets lo-byte index 0inc ctr 0lda ctr iny ;increment hi-byte index 0cpy #8 ;done 8 bytes yet? $3 bne $4 ;if not, go for more 0inx ;increment lo-byte index 0cpx #2 ctr $6 ldx #00 ;init lo-byte index $5 ldy #0 ;and hi-byte index $4 jsr setptr ;make byte pointer 0jsr prbyte ;print byte 00inc 62 ;restores hi-byte table 0inc 63 0inc 64 0inc 65 0jsr hibytes 0rts ;reading from bottom left up columns, across to right block3 lda #00 ;init. 64-byte counter 0sta 73 0dec 74 0dec 75 0dec 76 0dec 77 0rts 0 refresh2 inc 60 ;sets lo-byte table one 0inc 61 ;higher for new line, and _list 0pla ;restores old Y 0tay 0rts 0 refresh dec 70 ;sets up hi-bytes after 0dec 71 ;each 16 bytes printed 0dec 72 ;for $2000 page 0dec #8F 0sta 1601+ptr 0rts 0 prbyte tya ;saves current Y 0pha ;on stack 0ldy #00 lda @ptr,Y ;prints one byte 0sta da_buf 0sos write,da0sta 75 0lda #27 0sta 76 0lda #23 0sta 77 0rts   setptr lda 60,X ;recreates pointer at 50 for 0sta ptr ;each byte to be printed. 0lda 70,Y 0sta ptr+1 0lda ;sets up hi-byte lookup 0sta 70 ;table from 70 to 77 0lda #03B ;from bottom left 0sta 71 0lda #37 0sta 72 0lda #33 0sta 73 0lda #02F 0sta 74 0lda #02B 50 ;beginnings of lines 0sta 61 ;from bottom 0lda #0A8 0sta 62 0lda #28 0sta 63 0lda #80 0sta 64 0lda #00 0sta 65 0rts 0 hibytes lda #03F pitch_list ;set line pitch 0lda #00 0sta linctr ;initialize line counter 0rts 0  lobytes lda #0D0 ;sets up lo-byte lookup 0sta 60 ;table from 60 to 65 0lda #r more 0jsr refresh ;decrement hi-byte table 0ldx #02 ;resets lo-byte index 0inc ctr 0lda ctr 0cmp #8 ;done 64 bytes yet? 0bne block2 ;if not, go for more 0jsr hibytes 0rts ;on to block1 0 block1 ldx #04 ;init lo-byte index $5 ldy #0 ;and hi-byte ind ;return to BASIC or Pascal setup sos open,op_list ;opens printer 0lda op_ref ;store printer refnum 0sta da_ref ;for data write, 0sta cr_ref ;CR/LF, 0sta nis ;if so, finish up 0inc linctr 0jsr refresh2 ;if not, init. bytes 0jmp $1 ;and start a new line finis sos close,cl_list ;close .printer 0rts $1 sos write,lin192_list ;sets up 192 dots/line jsr block3 0jsr block2 0jsr block1 0sos write, cr_list ;CR/LF 0lda linctr 0cmp #27 ;done 40 lines? 0beq fi- ;Procedure DUMP4000. Dumps $4000 graphics page to ImagewriterII printer.  ;----------------------------------------------------------------------- 0 0jsr setup 0jsr lobytes ;sets up lookup tables 0jsr hibytes f .byte 1B,54,31,34 ;esc T 01 04: 14/144 inches  ; between lines 0 0rts ;end of DUMP2000 0.proc dump4000 ;---------------------------------------------------------------------- .byte 03 ;for write cpitch_ref .byte 00 0.word cpitch_buf 0.word 0002 cpitch_buf .byte 1B,6E ;esc n: 9 cpi lpitch_list .byte 03 lpitch_ref .byte 00 0.word lpitch_buf 0.word 0004 lpitch_bu cr_buf .byte 0D,0A lin192_list .byte 03 ;write 192 DOTS/LINE code lin192_ref .byte 00 0.word lin192_buf 0.word 0005 lin192_buf .byte 1B,67,30,32,34 ;esc g 024: 192=24*8 0 0 cpitch_list e data byte cl_list .byte 01 ;CLOSE has one parameter cl_ref .byte 00 cr_list .byte 03 ;write CR/LF code cr_ref .byte 00 0.word cr_buf 0.word 0002 ;WRITE has three parameters da_ref .byte 00 ;save space for SOS to put Refnum / .word da_buf ;pointer to data to be printed / .word 0001 ;length of message da_buf .byte 00 ;print on.word 0000 ;no optional parameters needed... / .byte 00 ;... so these are zeros op_path .byte 08 ;length of pathname / .ascii ".printer" ;the file to OPEN / da_list .byte 03 0rts ;back to program op_list .byte 04 ;OPEN has four parameters / .word op_path ;pointer to pathname to open op_ref .byte 00 ;reserve a space for SOS to put Refnum / -byte table 0ldx #04 ;resets lo-byte index 0inc ctr 0lda ctr 0cmp #0C ;done 64 bytes yet? 0bne block1 ;if not, go for more ;if not, go for more 0inx ;increment lo-byte index 0cpx #6 ;done 16 bytes yet? 0bne $5 ;if not, go for more 0jsr refresh ;decrement hiex $4 jsr setptr ;make byte pointer 0jsr prbyte ;print byte 0iny ;increment hi-byte index 0cpy #8 ;done 8 bytes yet? $3 bne $4 cl_ref ;close, 0sta cpitch_ref ;char pitch, 0sta lpitch_ref ;line pitch, 0sta lin192_ref ;and 192 dots/line 0sos write,cpitch_list ;set char pitch 0sos write,lpitch_list ;set line pitch 0lda #00 0sta linctr ;initialize line counter 0rts  lobytes lda #0D0 ;sets up lo-byte lookup 0sta 60 ;table from 60 to not, go for more 0jsr refresh ;decrement hi-byte table 0ldx #02 ;resets lo-byte index 0inc ctr 0lda ctr 0cmp #8 ;done 64 bytes yet? 0bne block2 ;if not, ;done 8 bytes yet? $3 bne $4 ;if not, go for more 0inx ;increment lo-byte index 0cpx #4 ;done 16 bytes yet? 0bne $5 ;if $5 ldy #0 ;and hi-byte index $4 jsr setptr ;make byte pointer 0jsr prbyte ;print byte 0iny ;increment hi-byte index 0cpy #8 ;done 64 bytes yet? 0bne $6 ;if not, go for more 0jsr hibytes 0rts ;on to block2 0 block2 ldx #02 ;init lo-byte index ;done 16 bytes yet? 0bne $5 ;if not, go for more 0jsr refresh ;decrement hi-byte table 0ldx #0 ;resets lo-byte index 0inc ctr 0lda ctr 0cmp #4 ;increment hi-byte index 0cpy #8 ;done 8 bytes yet? $3 bne $4 ;if not, go for more 0inx ;increment lo-byte index 0cpx #2 $6 ldx #00 ;init lo-byte index $5 ldy #0 ;and hi-byte index $4 jsr setptr ;make byte pointer 0jsr prbyte ;print byte 0iny -byte table 0inc 63 0inc 64 0inc 65 0jsr hibytes 0rts ;reading from bottom left up columns, across to right block3 lda #00 ;init. 64-byte counter 0sta ctr ge 0dec 73 0dec 74 0dec 75 0dec 76 0dec 77 0rts 0 refresh2 inc 60 ;sets lo-byte table one 0inc 61 ;higher for new line, and 0inc 62 ;restores hi write,da_list 0pla ;restores old Y 0tay 0rts 0 refresh dec 70 ;sets up hi-bytes after 0dec 71 ;each 16 bytes printed 0dec 72 ;for $4000 pa0lda #8F 0sta 1601+ptr 0rts 0 prbyte tya ;saves current Y 0pha ;on stack 0ldy #00 lda @ptr,Y ;prints one byte 0sta da_buf 0sos B 0sta 75 0lda #47 0sta 76 0lda #43 0sta 77 0rts  setptr lda 60,X ;recreates pointer at 50 for 0sta ptr ;each byte to be printed. 0lda 70,Y 0sta ptr+1 ;sets up hi-byte lookup 0sta 70 ;table from 70 to 77 0lda #05B ;from bottom left 0sta 71 0lda #57 0sta 72 0lda #53 0sta 73 0lda #04F 0sta 74 0lda #0465 0lda #50 ;beginnings of lines 0sta 61 ;from bottom 0lda #0A8 0sta 62 0lda #28 0sta 63 0lda #80 0sta 64 0lda #00 0sta 65 0rts 0 hibytes lda #05F go for more 0jsr hibytes 0rts ;on to block1 0 block1 ldx #04 ;init lo-byte index $5 ldy #0 ;and hi-byte index $4 jsr setptr ;make byte pointer 0jsr prbyte ;print byte 0iny ;increment hi-byte index 0cpy #8 ;done 8 bytes yet? $3 bne $4 sos open,op_list ;opens printer 0lda op_ref ;store printer refnum 0sta da_ref ;for data write, 0sta cr_ref ;CR/LF, 0sta cl_ref ;close, 0sta sos write,cr_list 0lda linctr 0cmp #27 0beq finis 0inc linctr 0jsr refresh2 0jmp newline finis sos close,cl_list ;close .printer 0rts ;return to BASIC or Pascal setup newline ld_pge #4 0sos write,lin384_list jsr block3 0jsr block2 0jsr block1 0sos write,cr_list 0jsr hibytes 0ld_pge #2 0sos write,lin384_list 0jsr block3 0jsr block2 0jsr block1 0000 page 0lda %1 0sta pge 0.endm 0 0.macro ck_pge ;checks which page 0lda pge 0cmp %1 0.endm  0jsr setup 0jsr lobytes jsr hibytes --------------------- ;Procedure DUMPBOTH. Dumps $2000 and $4000 graphics pages ; to ImagewriterII printer.  ;--------------------------------------------------------------------------- 0 0.macro ld_pge ;selects $2000 or $404 lpitch_buf .byte 1B,54,31,34 ;esc T 01 04: 14/144 inches  ; between lines 0 0rts ;end of DUMP4000 0 0 0.proc dumpboth ;------------------------------------------------------cpitch_list .byte 03 ;for write cpitch_ref .byte 00 0.word cpitch_buf 0.word 0002 cpitch_buf .byte 1B,6E ;esc n: 9 cpi lpitch_list .byte 03 lpitch_ref .byte 00 0.word lpitch_buf 0.word 00A lin192_list .byte 03 ;write 192 DOTS/LINE code lin192_ref .byte 00 0.word lin192_buf 0.word 0005 lin192_buf .byte 1B,67,30,32,34 ;esc g 024: 192=24*8 0 0 one data byte cl_list .byte 01 ;CLOSE has one parameter cl_ref .byte 00 cr_list .byte 03 ;write CR/LF code cr_ref .byte 00 0.word cr_buf 0.word 0002  cr_buf .byte 0D,0 ;WRITE has three parameters da_ref .byte 00 ;save space for SOS to put Refnum / .word da_buf ;pointer to data to be printed / .word 0001 ;length of message da_buf .byte 00 ;print/ .word 0000 ;no optional parameters needed... / .byte 00 ;... so these are zeros op_path .byte 08 ;length of pathname / .ascii ".printer" ;the file to OPEN / da_list .byte 03 _list .byte 04 ;OPEN has four parameters / .word op_path ;pointer to pathname to open op_ref .byte 00 ;reserve a space for SOS to put Refnum te table 0ldx #04 ;resets lo-byte index 0inc ctr 0lda ctr 0cmp #0C ;done 64 bytes yet? 0bne block1 ;if not, go for more 0rts ;back to program op ;if not, go for more 0inx ;increment lo-byte index 0cpx #6 ;done 16 bytes yet? 0bne $5 ;if not, go for more 0jsr refresh ;decrement hi-by cpitch_ref ;char pitch, 0sta lpitch_ref ;line pitch, 0sta lin384_ref ;and 384 dots/line 0sos write,cpitch_list ;set char pitch 0sos write,lpitch_list ;set line pitch 0lda #00 0sta linctr ;initialize line counter 0rts  lobytes lda #0D0 ;sets up lo-byte lookup 0sta 60 ;table from 60 to 65 0lda #50 ;beginnings of lines 0sta ;if not, go for more 0inx ;increment lo-byte 0cpx #2 ;done 16 bytes yet? 0bne $5 ;if not, go for more 0jsr refresh ;increment hi- byte table 0ldx #0 ;$2000 page ? 0bne $2 ;if not, go to $2 0cpy #8 ;done 8 bytes yet? 0jmp $3 $2 cpy #10 ;done 8 bytes yet? $3 bne $4 $1 ldy #8 ;init hi-byte $40 $4 jsr setptr ;make byte pointer 0jsr prbyte ;print byte 0iny ;increment hi-byte 0ck_pge #2 tr $6 ldx #00 ;init lo-byte $5 ck_pge #2 ;$2000 page ? 0bne $1 ;if not, go to $1 0ldy #0 ;if so, init hi-byte $20 0jmp $4 61 ;higher for new line, and 0inc 62 ;restores hi-byte table 0inc 63 0inc 64 0inc 65 0jsr hibytes 0rts block3 lda #00 ;init. 64-byte counter 0sta c 79 ;each 16 bytes printed 0dec 7A ;for $4000 page 0dec 7B 0dec 7C 0dec 7D 0dec 7E 0dec 7F 0rts 0 refresh2 inc 60 ;sets lo-byte table one 0inc 0dec 71 ;each 16 bytes printed 0dec 72 ;for $2000 page 0dec 73 0dec 74 0dec 75 0dec 76 0dec 77 0rts $1 dec 78 ;sets up hi-bytes after 0dec tores old Y 0tay 0rts 0 refresh ck_pge #2 ;2000 page ? 0bne $1 ;if not, go to $1 dec 70 ;sets up hi-bytes after ;on stack 0ldy #00 lda @ptr,Y ;prints one byte 0sta da_buf 0sos write,da_list 0sos write,da_list ;prints byte again $2 pla ;res ;recreates pointer at 50 for 0sta ptr ;each byte to be printed. 0lda 70,Y 0sta ptr+1 0lda #8F 0sta 1601+ptr 0rts 0 prbyte tya ;saves current Y 0pha 0sta 79 ;(page 2000) 0lda #37 0sta 7A 0lda #33 0sta 7B 0lda #02F 0sta 7C 0lda #02B 0sta 7D 0lda #27 0sta 7E 0lda #23 0sta 7F 0rts   setptr lda 60,X 0sta 76 0lda #43 0sta 77 lda #03F ;sets up hi-byte lookup 0sta 78 ;table from 78 to 7F 0lda #03B ;from bottom left ;table from 70 to 77 0lda #05B ;from bottom left 0sta 71 ;(page 4000) 0lda #57 0sta 72 0lda #53 0sta 73 0lda #04F 0sta 74 0lda #04B 0sta 75 0lda #47 61 ;from bottom 0lda #0A8 0sta 62 0lda #28 0sta 63 0lda #80 0sta 64 0lda #00 0sta 65 0rts 0 hibytes lda #05F ;sets up hi-byte lookup 0sta 70 ;resets lo byte 0inc ctr 0lda ctr 0cmp #4 ;done 64 bytes yet? 0bne $6 ;if not, go for more 0jsr hibytes 0rts ;on to block2 0 block2 ldx #02 ;init lo-byte $5 ck_pge #2 ;$2000 page ? 0bne $1 ;if not, go to $1 0ldy #0 ;if so, init hi-byte $20 0jmp $4 $1 t .byte 03 ;write 384 DOTS/LINE code lin384_ref .byte 00 0.word lin384_buf 0.word 0005 lin384_buf .byte 1B,67,30,34,38 ;esc g 048: 384=48*8 cpitch_list .byte 03 ;for write cpitch_ref .byte .byte 01 ;CLOSE has one parameter cl_ref .byte 00 cr_list .byte 03 ;write CR/LF code cr_ref .byte 00 0.word cr_buf 0.word 0002  cr_buf .byte 0D,0A ;CR,LF lin384_lisda_ref .byte 00 ;save space for SOS to put Refnum / .word da_buf ;pointer to data to be printed / .word 0001 ;length of message da_buf .byte 00 ;print one data byte cl_list al parameters needed... / .byte 00 ;... so these are zeros op_path .byte 08 ;length of pathname / .ascii ".printer" ;the file to OPEN / da_list .byte 03 ;WRITE has three parameters ;back to program op_list .byte 04 ;OPEN has four parameters / .word op_path ;pointer to pathname to open op_ref .byte 00 ;reserve a space for SOS to put Refnum / .word 0000 ;no option ;increment hi- byte table 0ldx #04 ;resets lo byte 0inc ctr 0lda ctr 0cmp #0C ;done 64 bytes yet? 0bne block1 ;if not, go for more 0rts $3 bne $4 ;if not, go for more 0inx ;increment lo-byte 0cpx #6 ;done 16 bytes yet? 0bne $5 ;if not, go for more 0jsr refresh ;$2000 page ? 0bne $2 ;if not, go to $2 0cpy #8 ;done 8 bytes yet? 0jmp $3 $2 cpy #10 ;done 8 bytes yet? ldy #8 ;init hi-byte $40 $4 jsr setptr ;make byte pointer 0jsr prbyte ;print byte 0iny ;increment hi-byte 0ck_pge #2 block1 ldx #04 ;init lo-byte $5 ck_pge #2 ;$2000 page ? 0bne $1 ;if not, go to $1 0ldy #0 ;if so, init hi-byte $20 0jmp $4 $1 0ldx #02 ;resets lo byte 0inc ctr 0lda ctr 0cmp #8 ;done 64 bytes yet? 0bne block2 ;if not, go for more 0jsr hibytes 0rts ;on to block3 0 , go for more 0inx ;increment lo-byte 0cpx #4 ;done 16 bytes yet? 0bne $5 ;if not, go for more 0jsr refresh ;increment hi- byte table ;$2000 page ? 0bne $2 ;if not, go to $2 0cpy #8 ;done 8 bytes yet? 0jmp $3 $2 cpy #10 ;done 8 bytes yet? $3 bne $4 ;if not ldy #8 ;init hi-byte $40 $4 jsr setptr ;make byte pointer 0jsr prbyte ;print byte 0iny ;increment hi-byte 0ck_pge #2 00 0.word cpitch_buf 0.word 0002 cpitch_buf .byte 1B,6E ;esc n: 9 cpi lpitch_list .byte 03 lpitch_ref .byte 00 0.word lpitch_buf 0.word 0004 lpitch_buf .byte 1B,54,31,34 ;esc T 1 4: 14/144 inches  ; between lines pge .byte 00 ;page switch 0rts ;end of BIGDUMP2 0 0 0.proc textdump  ;---------------------------------------------------------------------------t_cursor .byte 03 ;read character at (x,y) (console) get_ref .byte 00 0.byte 17. 0.word character character .byte 00 8 0.end ;end of DUMPER  cr_list .byte 03 ;carriage return, LF (printer) cr_ref .byte 00 0.word cr_buf 0.word 0002 cr_buf .byte 0D,0A clpr_list .byte 01 ;close file (printer) clpr_ref .byte 00 ge_path .byte 08 0.ascii ".console" text_list .byte 03 ;restores window (console) text_ref .byte 00 0.word text 0.word 0001 text .byte 01 ( ( .byte 00 0.word gotoxy_buffer 0.word 0003 gotoxy_buffer .byte 26. x_posn .byte 00 y_posn .byte 00 dev_list .byte 02 ;list for get_dev_num (console) 0.word dev_path devnum .byte 00 dev".console" wr_list .byte 03 ;"write" parameters (printer) wr_ref .byte 00 0.word charprnt 0.word 0001 charprnt .byte 00 ( xy_list .byte 03 ;read screen list (console) xy_ref pr_path .byte 08 0.ascii ".printer" co_list .byte 04 ;"open" parameters (console) 0.word co_path co_ref .byte 00 0.word 0000 0.byte 00 co_path .byte 08 0.ascii t ;done! close printer 0 0rts ;back to BASIC or Pascal 8 pr_list .byte 04 ;"open" parameters (printer) 0.word pr_path pr_ref .byte 00 0.word 0000 0.byte 00 f not, next column 0sos write,cr_list ;if so, CR/LF 0iny ;next line 0ldx #00 ;first column again 0cpy #24. ;bottom of screen? 0bne loop ;if not, next line 0sos close,clpr_lisis 0lda #32. ;if so, change to space $01 sta charprnt 0sos write,wr_list ;print character to printer 0inx ;increase column 0cpx #80. ;right-hand side? 0bne loop ;i0sos write,xy_list ;position cursor at x,y 0sos d_status,get_cursor ;read character 0lda character , , and #7F ;strip hi bit 0cmp #32. ;control character? 0bcs $01 ;if not, save as get_ref ;store console devnum 0 0sos write,text_list ;restore window 0sos write,cr_list 0 0 0ldx #00 ;initialize cursor posn. 0ldy #00 . loop stx x_posn 0sty y_posn cr_ref 0sta clpr_ref 0 0sos open,co_list ;open console 0lda co_ref 0sta xy_ref ;store console refnos 0sta text_ref 0 0sos get_dev_num,dev_list ;get console devnum 0lda devnum 0sta -- ;procedure TEXTDUMP - dumps 80-col. text screen to a printer ;----------------------------------------------------------------------------- 8 0sos open,pr_list ;open printer 0lda pr_ref 0sta wr_ref ;store printer refnos 0stan DUMP2000 A SC EC SW EW O^Ct&DUMP2000 DUMP2000DUMP4000 DUMP4000DUMPBOTH DUMPBOTHTEXTDUMP TEXTDUMP ole ufa[OJA ȭL 搥 `.printer g048nT14`!    {yws@81.-+$ ?hkx{˥ˬˏ)  ˈPˬȢ̴`o.printer.console.consP 搥 `Lx ȭL 搥 `L ȭL 搥 `.printer g048nT14`!      `Ѕ`Pab(cde`_p[qWrSsOtKuGvCw?x;y7z3{/|+}'~#``PpQQ`HPh`pqrstuvw`xyz{|}~``abcde `L; ȭL 搥 `D.printerS\ dg024onwT14`}|{yxwvtkjhedcba`_^\Zwpja[) K q  ' h   ' h ' L ` T`=@NWUjr_iq`Ѕ`Pab(cde`_p[qWrSsOtKuGvCw``PpQQ`HPSMh`pqrstuvw``abcde l`  搥 l`  搥 l`  搥 l`  搥 `D.printerS\ dg024onwT14`}|{yxwvtkjhedcba`_^\Zwpja[) - S l^ V' L - S l^ V' L T`=@NWUjr_iq`Ѕ`Pab(cde`?p;q7r3s/t+u'v#w``PpQQ`HPSMh`pqrstuvw``abcde l`  搥 l` [A3/1.2]ing'sos_get_D_num ( console, con_id, retcode ); 'sos_open ( printer, WRITE_ONLY, 0, sysbuf, prt_idx, retcode ); 'sos_s_write ( prt_idx, cr_lf, 1, 2, retcode ); 'row := 0; 'repeat ,col := 0; ,repeat 1curlocat ( row, col ); 1sos_d_status ( con_id, READ_scrnchar : char; *sysbuf : char; * "begin 'cr_lf := ' '; cr_lf[1] := chr( 13 ); cr_lf[2] := chr( 10 ); 'printer := '.PRINTER'; console := '.CONSOLE'; 'fillchar ( linebuf[1], COLMAX, ' ' ); '{$R-} 'linebuf[0] := chr( COLMAX ); '{$R+} *ROWMAX = 21; {window of menumaker's do_xxx} *WRITE_ONLY = 2; " "var printer, *console : string[10]; *cr_lf : string[2]; {make console_io's public? } *linebuf : string; *prt_idx, *con_id, *row, col : integer; *the WAP contributors' disk #1, Three.Sig 1053. SOSIO is used instead of direct SOS calls, and characters have been gathered into a line buffer instead of being sent to the printer singly.} " "const READ_SCRN = 17; *COLMAX = 80; ht : integer; { window height } %cur_line : integer; { current line in the window } " " Procedure printwindow; {The printwindow procedure is modified from the textdump procedure of the module alldump, by C. M. Davidson, on esread : integer; { number of bytes read from text file } %sysbuf : char; { sos i/o buffer; not used } %in_buff : string; { input buffer for reads } %w_width : integer; { window width } %w_heig#WT = 2; { window corner coordinates } #WL = 0; #WB = 22; #WR = 79;  var header, %footer, %type_name : string; %ifd : integer; { text file; internal file descriptor } %byte print it} Procedure do_words( name : string; f_type : integer ); { a shell for processing the three kinds of wordy files } const #CM_ADVANCE = 1; { .console cursor movement constants } #CM_WRAP = 4; #CM_SCROLL = 8; i, and do_3ezp sub-procedures of a new do_words procedure to take advantage of common features of the three. (4/7/90) This change is reflected in changes to the main body, too.}  { do_words -- display the selected wordy file in the window, and maybm the textdump procedure of the module alldump, by C. M. Davidson, on the WAP contributors' disk #1, Three.Sig 1053. I used SOSIO instead of direct SOS calls, and I gathered characters into a line buffer. I have also made the procedures do_text, do_asc{3/4/90 This is modified from the Pascal MenuMaker, by Tom Bartkiewicz} { I have added a dump window facility to the reading of text, ascii, and /// E-Z Pieces WP files, to send a window at a time to .printer. The printwindow procedure is modified froSCRN, scrnchar, retcode ); 1if ord( scrnchar ) > 127 then 3scrnchar := chr( ord( scrnchar ) - 128 ); {strip hi bit} 1if ord( scrnchar ) < 32 then 1 scrnchar := chr( 32 ); {replace control character by space} 1col := col + 1; 1linebuf[col] := scrnchar ,until col = COLMAX; ,sos_s_write ( prt_idx, linebuf, 1, COLMAX, retcode ); ,sos_s_write ( prt_idx, cr_lf, 1, 2, retcode ); ,row := row + 1 'until row = ROWMAX; 'sos_close ( prt_idx, retcode ) "end; {printwindow} " "Proos_s_read( ifd, in_buff, 1, w_width, bytesread, retcode ); #while ((retcode = 0) and (not user_quits)) do &begin ){$RANGECHECK-} )in_buff[0] := chr( bytesread ); ){$RANGECHECK+} )do_line; )println( in_buff ); )sos_s_read( ifd, in_buff, 1, w_width, ead_a_line( ifd, in_buff, retcode ); &end; $finish_up end; { do_text } { do_asci -- display the selected ascii text file in the window } procedure do_asci( ascii_file : string );  begin #sos_newline( ifd, ON_VALUE, chr( RETURN_KEY ), retcode ); #s#if (retcode = 0 ) then &sos_read( ifd, page_buff, 1024, bytesread, retcode ); { read 1st page } &if (retcode = 0 ) then )read_a_line( ifd, in_buff, retcode ); #while ((retcode = 0) and (not user_quits)) do &begin )do_line; )println( in_buff ); )r, chr_cnt ); &pbuf_pos := pbuf_pos + chr_cnt; &{ set the string length } &in_buff[0] := chr( chr_cnt + spaces ); &{$RANGECHECK+} #end;  begin #pbuf_pos := 0; #sos_set_mark( ifd, 0, 1024, 0, retcode ); { advance past header page } until the max length is reached or found } &{ must use 79-spaces instead of 80 since scan counts from 0, not 1 } &{$RANGECHECK-} &chr_cnt := scan( (79-spaces), =chr(CR), page_buff[pbuf_pos] ) + 1; &moveleft( page_buff[pbuf_pos], in_buff[spaces+1][pbuf_pos] = chr(DLE)) then )begin ,spaces := ord( page_buff[pbuf_pos+1] ) - 32; ,if ((spaces > 0) and (spaces < 80)) then /fillchar( in_buff[1], spaces, chr(SPACE) ) ,else /spaces := 0; ,pbuf_pos := pbuf_pos + 2; )end; & &{ now fill out the line,if ((retcode = 0 ) and (bytesread = 1024)) then /pbuf_pos := 0 ,else /begin / retcode := 1; 2exit( read_a_line ); /end; )end; & &{ pbuf_pos now points to a valid character in a string } &{ see if we need to do DLE expansion } &if (page_buff_buff } # #begin &spaces := 0; &chr_cnt := 0; & &{ determine if we need to read in the next page from the text file } &if ((pbuf_pos = 1023) or (page_buff[pbuf_pos] = chr(NULL))) then )begin ,sos_read( ifd, page_buff, 1024, bytesread, retcode ); _buff : string; 9var retcode : integer ); 4 #const &NULL = 0; &DLE = 16; &CR = 13; &SPACE = 32; & #var &spaces : integer; { # of DLE expansion spaces added to line } &chr_cnt : integer; { number of characters xfer'd to inge_buff : two_blocks; { page buffer for text file reads } #pbuf_pos : integer; { position in the page buffer } # #{ read_a_line -- read the next line of text from a pascal text file } #procedure read_a_line( ifd : integer; var in%viewport( 1, 2, 22, 77 ); { set window to normal menu maker proportions } "end; {finish_up} { do_text -- display the selected pascal text file in the window } procedure do_text( text_file : string ); { cut up from Tom's for shell } #  var #paery; /clear_viewport; ,end; "end; {do_line} " "Procedure finish_up; " "begin " cursor_movement( CM_ADVANCE + CM_WRAP + CM_SCROLL ); %sos_close( ifd, retcode ); %if (not user_quits ) then (printquery; %close_window; ; &if ( key=chr( oap)) or ( key=chr( oabigp)) then printwindow &else if ( key=chr( ESCAPE_KEY)) then user_quits:=true "end; Procedure do_line; " "begin )cur_line := cur_line + 1; )if ( cur_line > w_height ) then ,begin /cur_line := 1; /printqucedure printquery; {mine: print?} "const oap = 240; oabigp = 208; {for trial print dump} "var key:char; "begin &repeat *get_kbd( key ) &until ( key=chr( oap)) or ( key=chr( oabigp)) or ,( key = chr( ESCAPE_KEY)) or ( key = chr( RETURN_KEY))bytesread, retcode ); &end; #finish_up; end;  { do_3ezp -- display the selected /// EZ Pieces WP file in the window } procedure do_3ezp( wp_file : string ); #  var #i : integer; { index counter } #cmd_buff : packed array [0..1] of char; { command input buffer }  begin #sos_set_mark( ifd, 0, 300, 0, retcode ); { advance past 300 byte header } #if (retcode = 0) then &sos_read( ifd, cmd_buff, 2, bytesread, retcode ); { read 1st rec } #w been promptly and accurately filled. (I'm a former member of A3GI and ATUNC, also by mail.) I recently received the WAP contributors' disk 1, Three.Sig 1053, which includes a printer dump module by C. M. Davidson. Although I had done some assembly l To: David Ottalini From: Barbara Dudman, WAP13694 90/06 I'm glad we finally joined Washington Apple Pi. I use an Apple ///, with the Titan ///+IIe cards and a CP/M card. I've found the Journal interesting, and my orders for public domain disks havee_idx := 1 /end; #viewport( 0, 0, 23, 79 ); #clear_viewport; end.  if f_type in [TEXT_TYPE,ASCI_TYPE,EZWP_TYPE] then /do_words( name,f_type ) +else if f_type = CODE_TYPE then /do_exec( name ) +else if f_type = FONT_TYPE then /do_font( name ) +else if f_type = CAT_TYPE then /begin / do_catalog( name ); 1filx := 1; #oa_char := ' '; #oa_char[2] := chr( 127 ); {open-apple symbol } #draw_main_screen; #get_blk_devices; #synch_prefix( prefix ); #do_catalog( BLANK ); #user_quits := FALSE; #while ( do_menu( file_idx )) do )with file_list[file_idx] do & % else if f_type = ASCI_TYPE then do_asci( name ) % else if f_type = EZWP_TYPE then do_3ezp( name ) "end; { do_words }   begin {main body at last} #file_type := [ CODE_TYPE, TEXT_TYPE, ASCI_TYPE, FONT_TYPE, CAT_TYPE, 2EZWP_TYPE ]; #file_idWR, header, footer ); %sos_open( name, READ_ONLY, 0, sysbuf, ifd, retcode ); %cursor_movement( CM_ADVANCE ); %in_buff := ' '; %cur_line := 0; %user_quits := FALSE; %if f_type = TEXT_TYPE then do_text( name ) r,'-P to print, for next page, '); %footer := concat( footer,' to quit.' ); %w_width := (WR - WL) + 1; %w_height := (WB - WT) + 1; %viewport( 1, 0, 23, 79 ); { set full screen width for text display } %open_window( WT, WL, WB, EXT_TYPE then type_name := 'Text' % else if f_type = ASCI_TYPE then type_name := 'ASCII' % else if f_type = EZWP_TYPE then type_name := '/// E-Z Pieces WP'; %header := concat( 'Listing ',type_name,' File: ',name ); %footer := concat( 'Press',oa_cha){ a line record was encountered, write out a blank line } )else if (ord( cmd_buff[1] ) = 208 ) then ,begin /do_line; /println( ' ' ); ,end; )sos_read( ifd, cmd_buff, 2, bytesread, retcode ); &end; #finish_up; end;   begin %if f_type = Tuff[i] ) of 81 : in_buff[i] := chr(18); { begin bold } 82 : in_buff[i] := chr(17); { end bold } 811: in_buff[i] := ' ' { sticky space } 8otherwise delete( in_buff, i, 1 ); 5end; /do_line; /println( in_buff ); ,end , buff, 1, ord(cmd_buff[0])-2, bytesread, ;retcode ); /{$RANGECHECK-} /in_buff[0] := chr( bytesread ); /{$RANGECHECK+} /{ strip out special codes in the text string } /for i := bytesread downto 1 do 2if (ord( in_buff[i] ) < 32 ) then 5case ord( in_bhile ((retcode = 0 ) and (not user_quits)) do &begin ){ a text record, get the line of text associated with this record } )if (ord( cmd_buff[1]) < 208 ) then ,begin /sos_set_mark( ifd, 2, 2, 0, retcode ); { jump ahead 2 bytes } /sos_s_read( ifd, in_anguage programming on the Apple II, I hadn't tried any on the ///. Having succeeded in modifying alldump to use the Imagewriter II, I thank Mr.(?) Davidson for giving me courage. (See Dumperdocs and Dumper on this disk, both Pascal text files.) Next, I;--------------------------------------------------------------------------- ; file gettimeasm  ; Procedure getdatetime(var datenow:datestring) type datestring = string[18] ; Returns the current system date and time in an 18 character Pascal string ; O^R,ge to do from the MenuMaker documentation. (See "timestamp.text".) Thanks for the fun! from Mr. Bartkiewicz' "get date time" the "make pretty date" formatting and from SOSIO the "sos get time" routine to fix my old "timestamp" to be quicker and nicer. I linked the assembled sos call to the Pascal timestamp program, something I gained couralldump" module and used the SOSIO unit already in Mr. Bartkiewicz' library. This makes it very easy to capture short "help" or "read me" files in print. I also clumped together the similar text/ascii-reading files. (See "Menu2.text.") Finally, I borroweded it in two ways: I added the Pascal filer to the disk to transfer long files. The most fun was adding to the MenuMaker a procedure to dump the windows produced by the text/ascii-reading files to .printer. I borrowed Mr. Davidson's "textdump" from his "a use, and removed "hexstuff" from the library. (Only "peek" was used, and that only for total system memory: The "peek" code could be linked to the program.) Second, the "print" program on the disk doesn't do all the kinds of text/ascii files, so I replac tackled Tom Bartkiewicz' Pascal MenuMaker. I do a lot of Pascal programming, but had not used SOSIO! I've learned much from this program, and have made two changes and one borrowing (so far). First, I don't need the memory map, so I saved it for future Modified from SOSIO SOSGETTIME to stand alone to be called as an ; external Pascal procedure. (To be linked to Pascal program TIMESTAMP, ; to send formatted date and time to .printer.) ; 2/15/90 B. Dudman ;------------------------------------------------------------------------------ (.macro soscall ;(service number, pointer to parmlist) (brk (.byte %1 (.word %2 (.endm  (.macro pop ; (pla ;word from eval stack (sta ACKNOWLEDGEMENTS Cleaning of disk drive heads may not be done all that frequently, but it eventually becomes a necessity. It is possible to clean these heads manually by dismantling the drive and using Q-tips dipped in Isopropyl alcohol (100%). HoweveGETDATET GETDATET LhhhhiicHH`1 <[A3/1.2]ingD GETDATET  (soscall gettime, timelist push return (rts (.end ;set string length byte (clc ;change address in zreg to (lda zreg ; point to first char pos adc #1 ; (Borrowed from SOSIO) (sta zreg (lda zreg+1 (adc #0 (sta zreg+1 ;one parm for get_time dest .byte zreg 0.byte 00 ;place for results  start pop return (pop zreg ;address of string var (lda #18. ;length of string (decimal) (ldy #0 (sta @zreg,y  .proc getdatetime, 1 ;pointer to string dest  return .equ 0 zreg .equ 0e0 ;pseudo reg for var gettime .equ 063 ;sos call number  (jmp start  ;data here timelist .byte 01 %1 ;lo, then hi pla (sta %1+1 (.endm (.macro push ; (lda %1+1 ;word onto eval stack (pha ;hi, then lo (lda %1 (pha (.endm  ( r, this is a very burdensome procedure. It is much easier to use some of the commercially available disk head cleaning disks usually made of some non-woven textile fabric to which the alcohol may or may not be applied. These disks are loaded in the drive8TIMESTAM ces into a working program. If there are any comments, modifications, improvements, etc. the writer would be glad to hear of them. John Lomartire 34 Burr School Rd. Westport, CT 06880 cation. This note recognizes the great contribution of Bob Consorti and that of some unknown contributer (perhaps ///'s Company Bulletin Board?) who provided the nucleus for the final program. What has been done is to "edit" information from several sourrive, and another external drive, an A-143, daisy-chained to drive #2. If some other arrangement is needed, just modify the SOS.DRIVER accordingly. The SOS.DRIVER on this disk does NOT contain a .PROFILE driver since it would be of no value in this applirive, which it proceeds to do in sequential order with stops between each drive selection to permit changing of the cleaning disk. It will also accept commands to clean ANY ONE disk. It will work in a system with an inboard drive, one external Disk /// don of DISK.TEXT.) This material from Bob Consorti, along with portions of an older Basic program obtained from some source not immediately remembered, were used to rewrite the DISK.CLEAN program. This program will accept commands to clean more than one dthe disk drive head. His Pascal source code is named DISK.TEXT and the invokable module is named DISK.CODE. He also provided a short Basic program, DT.BASIC to illustrate how the module could be used in Business Basic. (File DOCS is just an ASCII versi that the same part of the cleaner pad is abraded time and again. In response to a specific request, Bob Consorti put together an assembly language module, invokable from Apple /// Business Basic, to activate any disk drive, #1 through #4. It also moves series of CATALOG calls. Although this works, it is prone to give different, and in some cases very short cycle times on different drives in the system requiring an individual setting modification for each situation. Also, the drive head is not moved so and the drive is rotated to cause the fabric to wipe against the drive heads. Although this is simple, it does require some type of program to activate and shut off the drive. Some programs have been written in the past where the drive is activated by a٪ P  00'???JanFebMarAprMayJunJulAugSepOctNovDec0á   0צ???SunMonTueWedThuFriSat  : START QUIT SMST SMQU A  O^t8ort( 0, 0, 23, 79 ); #clear_viewport; end.  ,ASCI_TYPE,EZWP_TYPE] then /do_words( name,f_type ) +else if f_type = CODE_TYPE then /do_exec( name ) +else if f_type = FONT_TYPE then /do_font( name ) +else if f_type = CAT_TYPE then /begin / do_catalog( name ); 1file_idx := 1 /end; #viewp; #oa_char[2] := chr( 127 ); {open-apple symbol } #draw_main_screen; #get_blk_devices; #synch_prefix( prefix ); #do_catalog( BLANK ); #user_quits := FALSE; #while ( do_menu( file_idx )) do )with file_list[file_idx] do & if f_type in [TEXT_TYPE#wait( 15 ); { wait until download is completed } #curlocat( 2, 0 ); #clear_eol; end;  begin {main body at last} #file_type := [ CODE_TYPE, TEXT_TYPE, ASCI_TYPE, FONT_TYPE, CAT_TYPE, 2EZWP_TYPE ]; #file_idx := 1; #oa_char := ' 'error_chk( retcode ); &sos_close( ifd, retcode ); &error_chk( retcode ) #end; # begin #curlocat( 2, 0 ); #ctr_print( concat( 'Downloading Font: ', font_file ) ); #getfont( font_file ); #download_font( fontbuf ); f bytes read from font file } &sysbuf : char; { sos i/o buffer; not used } # #begin &sos_open( font_file, READ_ONLY, 0, sysbuf, ifd, retcode ); &error_chk( retcode ); &sos_read( ifd, fontbuf, sizeof( fontbuf ), bytesread, retcode ); &צ,   , PP RWPnץ)S.printerתPS"ˡ3Error in openin .printerDATESTRIZ%H% OUTFILE %p%iicHH`1 <FcHH`1 <FlAugSepOctNovDec0á   0צ???SunMonTueWedThuFriSat  : צ,   , PP RWPnץ)S.printerתPS"ˡ'||** zLhhhh{ file timestamp }  { Feb 15, 1990: modified from /bworks/newdate.text, or datetime.code,}  { and from Menu.maker, by Tom Bartkiewicz, WAP }  {The external get_date_time is mostly borrowed from SOSIO }   Program timestamp; {to be executed to sendimelist .byte 01 ;one parm for get_time dest .byte zreg 0.byte 00 ;place for results  start pop return (pop zreg ;address of string var (lda #18. ;length of string (decimal) (ldy %1 (pha (.endm  (  .proc getdatetime, 1 ;pointer to string dest  return .equ 0 zreg .equ 0e0 ;pseudo reg for var gettime .equ 063 ;sos call number  (jmp start  ;data here t(pla ;word from eval stack (sta %1 ;lo, then hi pla (sta %1+1 (.endm (.macro push ; (lda %1+1 ;word onto eval stack (pha ;hi, then lo (lda /90 B. Dudman ;------------------------------------------------------------------------------ (.macro soscall ;(service number, pointer to parmlist) (brk (.byte %1 (.word %2 (.endm  (.macro pop ; ate and time in an 18 character Pascal string ; Modified from SOSIO SOSGETTIME to stand alone to be called as an ; external Pascal procedure. (To be linked to Pascal program TIMESTAMP, ; to send formatted date and time to .printer.) ; 2/15} {Here follows the text for get_date_time: } {;--------------------------------------------------------------------------- ; file gettimeasm  ; Procedure getdatetime(var datenow:datestring) type datestring = string[18] ; Returns the current system d#{This error checking doesn't do it: if printer is off, no message, if $on but not selected, hangs, no message 2/15/90} "else %begin (get_date_time (raw); (prettify (raw, header); (writeln (outfile, header); (close (outfile) %end end. {timestampame := '.printer'; "{$IOCHECK-} "rewrite (outfile, destname); "{$IOCHECK+} "iores := IORESULT; "if iores <> 0 then %begin ({writeln ( 'Error in opening .printer' );} (write (chr(7)); (exit ( Program ) %end ,weekday := copy (DAYS, 3*num + 1, 3); ,time := copy (raw, 10, 4); ,onech := ':'; ,insert (onech, time, 3); ,header := concat (weekday,', ',month,' ',day,', ',year); ,header := concat (header,' ', time) %end; {prettify}  begin {timestamp} "destn= 10 * (ord (month[1]) - ascii_0) + ord (month[2]) - ascii_0; $ month := copy (MONTHS, 3*num + 1, 3); ,day := copy (raw, 7, 2); {DD} ,if day[1] = '0' then delete (day, 1, 1); ,onech := copy (raw, 9, 1); {W} ,num := ord (onech[1]) - ascii_0; ,month, ,weekday : string[3]; ,year : string[4]; ,time : string[5]; ,num : integer; , $begin ,header := ' '; onech := ' '; {initialize strings} ,year := copy (raw, 1, 4); {YYYY} ,month := copy (raw, 5, 2); {MM} ,num :P's Pascal Menumaker, by Tom Bartkiewicz } $ $const ,MONTHS = '???JanFebMarAprMayJunJulAugSepOctNovDec'; ,DAYS = '???SunMonTueWedThuFriSat'; {Thanks, Tom} ,ascii_0 = 48; $var ,onech : string[1]; ,day : string[2]; ternal; ${ Modified from SOSIO SOSGETTIME: returns 'YYYYMMDDWHHMMXXXXX'. } ${ XXXXX's are seconds and nanosceonds I don't need } $ $Procedure prettify (raw: datestring; var header: string); ${Modified from /bworks/newdate.text (B. Dudman) &and WA the current system date and time to .printer}  type datestring = string[18];  var outfile : text; $destname, $header : string; raw : datestring;  iores : integer;  $Procedure get_date_time (var raw: datestring); ex #0 (sta @zreg,y ;set string length byte (clc ;change address in zreg to (lda zreg ; point to first char pos adc #1 ; (Borrowed from SOSIO) (sta zreg (lda zreg+1 (adc #0 (sta zreg+1 (soscall gettime, timelist push return (rts (.end } B$(I);v:520: 500THPOS=4:I/2=I/2)I=I-1I=IBOTM THPOS=44:I/2<>I/2)I=I+1I2=-1:I=I-2:IBOTM<30THPOS=44I=IBOTM/2)*2:=+IBOTM/2)-1:CA)"PRINT.ALL": OA+P 3HA=(81+UCA)A=(81+LCA):::: OA+Q Quits 3IA=(83+LCA)A=(83+UCA)"PRINT.SHOW": OA+S 2JA=(68+LCA)A=(68+UCA)/Screen.Savers/HELLON=THPOS:B$(I);XA<8A>11540bA-7640,660,690,720l:=THPOS:ٺ1600 =Q:WW=0A=:A=21A=9&oldprefix$=40A=31410: Control C "aborts" program to Basic(:A=13770: Return Selects a file *DA=27:50: Escape to change disks/FA=324000: back out one directory level 3GA=(80+UCA)A=(80+L"BASIC 0":150A$="TEXT 0":150A$="CAT 0":150A$="FONT 0":150A$="FOTO 0":150A$(L),"BLOCKS")510*=27:=19:"FREE MEMORY AVAILABLE: ";=7:=20:"80C";A$(L);$:=5:THPOS=4:I=1:IBOTM=J-1:620Q=:=26:=21:sic; +Q Quits."r12);::"80C";a$;:+w#9,"DISKNAME.DAT":#9;DISKNAME$:#9|d$=DISKNAME$$=23:=0::"80C";d$;::12)201M=3:=14:"This /// SIG Disk is \^ 19";Р,2)", Washington Apple `, Ltd."=4:B$(1)="":B$(2)=""A$=16,B) THEN 240 #1, d$="":=10:"80C";d$ ž#1300I=0"I=I+1:#1;A$(I):290,#1 6L=I-1@j=1:same=0 J:SEG=0 Tœ2030^CT<1CT=1cCT>13000Zha$="{,|,~,}; selects; to new disk; J/2)=4:=+1:ۙ=44B$(J);:J=J+1I:1,180,22:2,280,21:2,2380,23:8A$(1000),B$(1000),C%(511),C$(20),name$(20):=10:=0UCA=128:LCA=UCA+32CT=15 IF PREFIX$= PREFIX$+MID$(B$(I),VOLUME NAME (/DISKNAME) OR DEVICE NAME (.Dx)"P12);::"80C";a$;:Zb$="CHANGING DISKS"$d=23:=0::"80C";b$;::12).n=12:=20:"MAKE A NEW MENU FOR DISK: ";N$xN$)<2110=N$ :210 I=1L(A$(I),A$))200B$0 WAP /// SIG MENU.MAKER PROGRAM (v. 6.2) =".D1"210: Coldstart (320: Warmstart &*X=11000: TEXT SLOW-DOWN LOOP ,X.1 CHANGE DISK SUBROUTINE23œ202:2200<RFa$=" YOU MAY SELECT YOUR DISK BY 0=+IBOTM/2-.5):I=IBOTM:I/2=I/2)I=I-1 œ2120B=B$(I),16)," ")-1 B$(I),"BASIC 0")850B$(I),"TEXT 0")890 B$(I),"CAT 0")1140*B$(I),"FONT 0")18504B$(I),"FOTO 0")1930>B$(I),"PASTXT 0")2070H540R\A$="RUNNING "+B$(I),16,B)f"79C";A$;:=0pB$(I),16,B) z::SEG=1".D1/SEG.T"t=+B$(I),16,B) yCT=CT+1~240:=24:=0:"@ ..... "DATE.TIME.LINE" ....JM=Ҡ,4,2))BTM1630,1640,1650,R",220(204::"79A";""; 2D=1:F=1 <#4;a$ FD=D+1 P#5;a$ZD=60#5;12)dD=60D=1nF=F+1::d$;::Y=1100:Y x13402  CATCH PASCAL TEXT FILES 202 :F*=08:"78C";"SORRY BUT MENU.MAKER CAN'T R".D1/MENU.MAKER",220 d$="" A$="PRINTING "+B$(I),16,B)=01:=0::"80C";A$;:#3,B$(I),16,B)Z=1#3;b$:"78A";b$Z=Z+1:Z=18:1290 1260 #4,B$(I),16,B)#5,".PRINTER"+ž#4#5;12):::".D1/MENU.MAKE30C$="N"C$="n"1160;:=23:=0::"79C";"PRESS ANY KEY TO HALT LISTING": $1020.202 8::Z=1B::=23:=0::"79C";"WOULD YOU LIKE A PRINTED COPY?":1C$:C$<>"Y"C$<>"y"C$<>"N"C$<>"n"1170*C$="N"C$="n"79C";"PRESS ANY KEY TO HALT LISTING"::202 1020#2,B$(I),16,B)ž#242:::1160Z=1#2;A$:"78A";A$Z=Z+1:Z>1842:::Z=1980*:=23:=0::"79C";"CONTINUE...?":1C$:C$<>"Y"C$<>"y"C$<>"N"C$<>"n"10 MENU.MAKER TEXT MODULESEG=0"MENU.MAKER"890&*X=11000: TEXT SLOW-DOWN LOOP ,X.1,180,22:2,280,21:2,2380,23:z:A$="LISTING "+B$(I),16,B)$=01:=0::"80C";A$;::12)>=23:=0::"a$,1)="/"5060:s=s-1 5030=a$240 MENU.MAKER 6.2 * Thanks to C.M.Davidson for his help!el; G$:::320H: Error Routine 202:U=11:"79C";"BAD PATH ERROR (NO DISK IN DISK DRIVE OR DESIRED FILE NOT FOUND.)"X=11000:X:::210Z a$="{,|,~,}; selects; back 1 lev 1600 &:WW=1:0 :SEG=1;".D1/S EG.F" SEG=1".D1/SEG.G"diskname$=3802  CATCH PASCAL TEXT FILES 202 :F*=08:"78C";"SORRY BUT MENU.MAKER CAN'T READ PASCAL TEXT FILES."04=10:"M$="NOVEMBER":1750M$="DECEMBER":1750826);"-";M$;" ";Ѡ,2));", ";"19";Р,2);" ";/П,2))=>13П,2))-12;џ,6);:1780$П,2))=0"12";џ,6);:ٟ;$П,2))=>12" PM-":" AM-" 1830WW=1530 =26:=211660,1670,1680,1690,1700,1710,1720,1730,1740^M$="JANUARY":1750hM$="FEBRUARY":1750rM$="MARCH":1750|M$="APRIL":1750M$="MAY":1750M$="JUNE":1750M$="JULY":1750M$="AUGUST":1750M$="SEPTEMBER":1750M$="OCTOBER":1750EAD PASCAL TEXT FILES."04=10:"78C";"ANY KEY RETURNS TO THE MENU."!>G$:::".D1/MENU.MAKER",320 and the drive is rotated to cause the fabric to wipe against the drive heads. Although this is simple, it does require some type of program to activate and shut off the drive. Some programs have been written in the past where the drive is activated by a:"13";::" ELONGATED CHARACTERS ON"=6,:"14";::" ELONGATED CHARACTERS OFF"=6.:"15";::" SMALL PROPORTIONAL SPACING"=6.0:"16";::" LARGE PROPORTIONAL SPACING"b=6=1:=24::">";=242\=6::"TYPE NUMBER, ";::" 8 PRINTED LINES PER INCH"z =6, :" 8";::" SET SPECIAL LINE SPACING" =6:" 9";::" SLASH ZEROS"B=6"t:"10";::" NO SLASH ZEROS"=6!:"11";::" BOLD PRINT ON" =6"<:"12";::" BOLD PRINT OFF"n=6+" 10 CHARACTERS PER INCH (PICA)" =62 :" 3";::" 12 CHARACTERS PER INCH (ELITE)" =6* :" 4";::" 15 CHARACTERS PER INCH"N =6* :" 5";::" 17 CHARACTERS PER INCH" =6, :" 6";::" 6 PRINTED LINES PER INCH" =6,H :" 7'zSU$=" ": SETS SET UP STRING TO NUL/" APPLE PRINTER CONTROL PROGRAM "`  =4#( " NO. PRINTER OPTIONS"0 "----------------------------------------"; =6) :" 1";::" 9 CHARACTERS PER INCH"" =61T :" 2";::-----".x"TURN ON YOUR PRINTER, INSERT PAPER, AND"%" PRESS RETURN WHEN READY".@"YOU WILL THEN SEE YOUR PRINTING OPTIONS"J."---------------------------------------" 11400=16lK$ v11400: RE-ENTRY POINTœces into a working program. If there are any comments, modifications, improvements, etc. the writer would be glad to hear of them. John Lomartire 34 Burr School Rd. Westport, CT 06880 cation. This note recognizes the great contribution of Bob Consorti and that of some unknown contributer (perhaps ///'s Company Bulletin Board?) who provided the nucleus for the final program. What has been done is to "edit" information from several sourrive, and another external drive, an A-143, daisy-chained to drive #2. If some other arrangement is needed, just modify the SOS.DRIVER accordingly. The SOS.DRIVER on this disk does NOT contain a .PROFILE driver since it would be of no value in this applirive, which it proceeds to do in sequential order with stops between each drive selection to permit changing of the cleaning disk. It will also accept commands to clean ANY ONE disk. It will work in a system with an inboard drive, one external Disk /// don of DISK.TEXT.) This material from Bob Consorti, along with portions of an older Basic program obtained from some source not immediately remembered, were used to rewrite the DISK.CLEAN program. This program will accept commands to clean more than one dthe disk drive head. His Pascal source code is named DISK.TEXT and the invokable module is named DISK.CODE. He also provided a short Basic program, DT.BASIC to illustrate how the module could be used in Business Basic. (File DOCS is just an ASCII versi that the same part of the cleaner pad is abraded time and again. In response to a specific request, Bob Consorti put together an assembly language module, invokable from Apple /// Business Basic, to activate any disk drive, #1 through #4. It also moves series of CATALOG calls. Although this works, it is prone to give different, and in some cases very short cycle times on different drives in the system requiring an individual setting modification for each situation. Also, the drive head is not moved soPRESS RETURN (0 ENDS)";: u=24:=2 " ";AN$11400: SOUND(ANS=AN$)): CONVERTS TO INT VAL,$ANS<0ANS>162000: GOES BACK TO MENUANS=010200: GOES TO ENDANS=16900PANS=27000ANS=37100ANS=47200|ANS=57300ANS=67400DANS=77500ANS=87600 ANS=98000pANS=108100ANS=1182008ANS=128300ANS=138400ANS=148500ANS=159700,ANS=169800$^2000: TRAPS ANY OTHER RESPONSE -------------- SET UP STRINGSMAGEWRITER PRINTER"O!O" VERSION 1.0"O=23-O" COPYRIGHT (C) 1983 BY PRO/PAC, INC." O11400RROGRAM ":: N*N=4/4N" PRINTER CONTROL PROGRAM " N=8:=15LO"#### #### #### TM"QO=15VO"# # # # #"[O=15`O"#### # ####"eO=15jO"# # #"oO=15tO"# #### #"O=16.O" APPLE /// TO APPLE IOUND ROUTINE". ----------------------------.|.------------------------6 ON ERR HANDLING HERE 6 BRANCH BACK WITH GOTO 2000: ------------------: HEADER SUB ROUTINE: ------------------?::=1:=1::" APPLE PRINTER CONTROL P(5)=344-COUNT%(6)=409-COUNT%(7)=243 -TIME%=1 -S=17-#2;MODE%);VOL%);>-#2;COUNT%(S)-256*COUNT%(S)/256));COUNT%(S)/256));2-#2;TIME%-256*TIME%/256));TIME%/256));-S"- ----------------------------.: END OF S0250 (2000 (::".D1/MENU.MAKER"!, --------------------------- , SOUND SUB ROUTINE FOR AIII P- --------------------------Z-#2,".AUDIO" d-MODE%=128 n-VOL%=63x-COUNT%(1)=289-COUNT%(2)=325-COUNT%(3)=364-COUNT%(4)=386-COUNT%--------' PRINTER ROUTINE$' ---------------.'#1,".PRINTER":#1:SU$:#1 8'2000' -----------' END ROUTINE' -----------Q':=12:=3:" PRESS ";::"Y";::" TO END, ";::"RETURN";::" TO CONTINUE"(K$(K$)=89K$)=1211 LONGER IN ELONGATED PRINT MODE"+13)+10):10000]%SU$=27)+80)+"THE PRINTER IS NOW SET TO SMALL PROPORTIONAL SPACING"+13)+10):10000^H&SU$=27)+112)+"THE PRINTER IS NOW SET TO LARGE PROPORTIONAL SPACING"+13)+10):10000&' ------- TO BOLD PRINT MODE"+13)+10):10000Tl SU$=27)+34)+"THE PRINTER IS NO LONGER IN BOLD PRINT MODE"+27)+10):10000e SU$=14)+"THE PRINTER IS NOW SET TO"+13)+10)+"PRINT ELONGATED CHARACTERS"+13)+10):10000S4!SU$=15)+"THE PRINTER IS NO----h@SU$=27)+"D"+"21"+"THE PRINTER WILL NOW PRINT A SLASH IN ALL ZEROS 101010101010"+13)+10):10000kSU$=27)+90)+"SW"+"THE PRINTER WILL NOW PRINT ZEROS WITHOUT A SLASH 101010101010"+13)+10):10000P SU$=27)+"!"+"THE PRINTER IS NOW SETONVERTS TO INT VAL N$=N)NP=(144/N)%NP$=NP)): CONVERTS TO STRINGiSU$=27)+"T"+NP$+"THE PRINTER IS NOW "+13)+10)+"SET TO "+N$+" LINES PER INCH"+13)+10):10000 ------------------- MORE SET UP STRINGS ---------------0.=23:" (PRESS 'RETURN' FOR MAIN MENU)"4=16:"(CHOOSE 2,3,4,5,6,7 OR 8 LINES PER INCH)"0=10:"TYPE IN THE NUMBER OF LINES PER INCH"/"YOU WISH TO SPACE YOUR OUTPUT.......";LN$ 11400LN$)<2LN$)>87600%N=LN$)): CG"+13)+10):10000kSU$=27)+"A"+"THE PRINTER IS NOW SET TO"+13)+10)+"NORMAL 1/6 INCH LINE SPACING"+13)+10):10000wLSU$=27)+"B"+"THE PRINTER IS NOW SET TO"+13)+10)+"CLOSER THAN NORMAL 1/8 INCH LINE SPACING"+13)+10):10000 1500ET TO 12 CHARACTERS PER INCH ELITE SPACING"+13)+10):10000m SU$=27)+113)+"THE PRINTER IS NOW SET TO 15 CHARACTERS PER INCH COMPRESSED SPACING"+13)+10):10000jSU$=27)+"Q"+"THE PRINTER IS NOW SET TO 17 CHARACTERS PER INCH COMPRESSED SPACIN --------------aSU$=27)+110)+"THE PRINTER IS NOW SET TO 9 CHARACTERS PER INCH SPACING"+13)+10):10000fXSU$=27)+"N"+"THE PRINTER IS SET TO NORMAL 10 CHARACTER PER INCH PICA SPACING"+13)+10):10000eSU$=27)+"E"+"THE PRINTER IS NOW S