LnSOS BOOT 1.1 SOS.KERNEL SOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUND%INVALID KERNEL FILE: xةw,@  ȱlmi8#)!)O^ ?PSCL.CURSOR.LIBk  /PSCL.MOUSE.TEXTr  /PRINT.SCRN.TEXT~  ALPHB k1GUESS.NUMBERS 1 -FONT.CAP.TEXT=/VIEWPRTPOS.TEXTS   -READ.ME.FIRST`78BAYA.1o888%+READ.ME.EZP 77r78PASCAL.UTILSc III.PCL.20ES.1u' ,CRT.LIB.TEXT /CURSOR.LIB.TEXT /WINDOW.BOR.TEXT /PAS.WINDOW.TEXT   .PSCL.SCRN.TEXT1-/WINDOWUTIL.TEXTF >dLԡm#i㰼m#iЕOLԡȱfg hi !dLԡ憦  Ljmkm l y`2 Lԡ8(Je稽)ʈ@L '()O^ cedure clear_EOS; { Clear characters to end of screen } const xclear_EOS = 29; begin send_code(xclear_EOS); end; procedure clear_LIN; { Clear current line } const xclear_LIN = 30; begin send_code(xclear_LIN); procedure crt_off; { Turn screen off } const xcrt_off = 14; begin send_code(xcrt_off); end; procedure crt_reset; { Reset to full screen viewport } const xcrt_reset = 1; begin send_code(xcrt_reset); end; proacter write } begin { routine. } unitwrite(1,code,1,,12); end; procedure crt_on; { Turn screen on } const xcrt_on = 15; begin send_code(xcrt_on); end; Shift viewport contents right N } procedure vwport_left_shift(n:integer); { Shift viewport contents left N } IMPLEMENTATION procedure send_code(code: integer); { Common control charx,y:integer); { Set top of viewport to x,y } procedure vwport_bot(x,y:integer); { Set bottom of viewport to x,y } procedure vwport_restore; { Restore viewport to last CRT_RESET} procedure vwport_right_shift(n:integer); {procedure clear_LIN; { Clear current line } procedure clear_EOL; { Clear to end of current line } procedure vwport_clear; { Clear current viewport } procedure vwport_top( { Turn screen off } procedure crt_reset; { Reset full screen viewport } procedure clear_EOS; { clear to the end of screen } -----------------------------------------------------------} INTERFACE procedure crt_on; { Turn screen on } procedure crt_off; } { Created and uploaded to Computserve DL7 section by E.J. Fournier. } { To control cursor functions use interfaces in CURSOR_LIB. } { } {---------------UNIT CRT_LIB; INTRINSIC CODE 54; {--------------------------------------------------------------------------} { } { Pascal screen control library utility routines for Apple ///. 12*+O^b r_left; { move cursor left } const c_left = 8; begin send_code(c_left); end; procedure cur_up; { move cursor up } const c_up = 11; begin send_code(c_up); end; mmon send procedure } begin { for all control functions } unitwrite(1,code,1,,12); end; procedure cur_right; { move cursor right } const c_right = 9; begin send_code(c_right); end; procedure cu } procedure gotox(x:integer); { Move cursor to x position } procedure gotoy(y:integer); { Move cursor to y position } IMPLEMENTATION procedure send_code(code: integer); { Coprocedure cur_off; { Turn cursor off } procedure cur_inverse; { Set cursor display inverse } procedure cur_normal; { Set cursor display normal } procedure cur_home; { Move cursor home eft } procedure cur_down; { Move cursor down } procedure cur_up; { Move cursor up } procedure cur_on; { Turn cursor on } --------------------------------------------------------------} INTERFACE procedure cur_right; { Move cursor right } procedure cur_left; { Move cursor l } { Created and uploaded to Computserve DL7 section by E.J. Fournier } { To control screen/viewport functions use interfaces in CRT.LIB } { } {------------UNIT CURSOR_LIB; INTRINSIC CODE 58; {--------------------------------------------------------------------------} { } { Pascal cursor control library utility routines for Apple ///.  !"#$%&9:;O^ite(chr(3),chr(28),chr(12)); gotoxy(1,0); for counter:=1 to box_len do write(chr(140)); { display special overline char. } for counter:=0 to box_height+1 do begin gotoxy(top_X-1,top_Y-1); { E. Fournier [70116,1642] } write(chr(2)); { set viewport top } gotoxy(box_len+1,box_height+1); { set viewport bottom, clear viewport, home cursor } wr################ procedure info_box; { Rewrite of info_box, shortens code } var counter:integer; { and uses only one special character } begin { to display viewport box. } inverse:=false; <-------- existing line +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Then in the PROCEDURE.TEXT file replace the INFO_BOX shown below. ############################################################# } data : packed array [0..9] of 0..255; { E.Fournier [70116,1642] } begin data[0] := 1; data[1] := 140; data[2] := 127; for id := 3 to 9 do data[id] := 0; unitstatus(1,data,70); end; begin line_over; first and last lines shown. {------------------- main program -----------------} <------ existing line procedure line_over; { Character definition routine } var id: integer; { sets top row of bits. but the border created using standard characters and this one special character is really sufficient. E.Fournier [70116,1642] The code shown immediately below needs to be placed in the FORM.TEXT program between the The code shown below was created as a result of not having the "chr()" character definitions for the characters used in the FORM program in the XA7 library. The routine could be expanded to include other character shapes to make a more interesting border { I started writing a few more programming utilities and came across } { the controls to save and restore the screen. I decided to experiment } { and the result is the code shown below. I realize the experiment } { itself is of no real use end; procedure clear_EOL; { Clear to end of current line } const xclear_EOL = 31; begin send_code(xclear_EOL); end; procedure vwport_clear; { Clear current viewport } const xvwprt_clr = 28; begin send_code(xvwpr for } ichr := ord(achr) mod 128; { arrow keys } case ichr of 10 : begin indx1 := 27; incr := +1; end; 11 : begin indx1 := 27; incr := -1; end; 21 : begi vwport_clear; writeln; writeln(' Hi'); writeln; write(' there'); sv_scrn_status(b_buf_1); { Save the window status and contents } vwport_save(b_buf_2); repeat unitread(1,achr,1); { Read a character and checkor i:= 1 to 20 do writeln(' This is a test. This is a test. This is a test. This is a test.'); sv_scrn_status(a_buf_1); { Save screen status and contents } vwport_save(a_buf_2); vwport_top(5,5); vwport_bot(6,4); { product of viewport height } end; { times width plus 3. } procedure vwport_rstr(var buffer: bytestream);{ Same comment as vwport_save } begin unitstatus(1,buffer,74); end; begin fs(1,status_buf,6); { calling program to at least 90 char's. } end; procedure vwport_save(var buffer: bytestream);{ Buffer must be packed array } begin { of char dimensioned as the } unitstatus(1,buffer,72); status_buf[0] := chr(90); { calling program to at least 90 char's. } unitstatus(1,status_buf,4); end; procedure rs_scrn_status(var status_buf:bytestream); begin { status buffer must be declared in the } unitstatu { screen location. } for indx := 1 to n do send_code(ord(ch)); end; procedure sv_scrn_status(var status_buf:bytestream); begin { status buffer must be declared in the } ne. } unitwrite(1,code,1,,12); end; procedure rept_char(ch:char; n:integer); { Display the character CH, } var indx : integer; { N times starting at current } begin a_buf_2, b_buf_2 : packed array[0..2000] of char; ichr, incr, indx1, i:integer; achr, ua, da, ra, la, esc : char; procedure send_code(code: integer); { Common control character write } begin { routi{ If anyone uses this how about some reaction. i.e. drop me a note. } { } { E. Fournier [70116,1642] } { } program test; uses cursor_lib, crt_lib; var a_buf_1, b_buf_1 : packed array[0..89] of char; restoring the entire screen and the small window as you move about} { By the way, your expected to have the CURSOR and CRT libraries in the } { SYSTEM.LIBRARY } { } o the screen. } { Consider there use in the FORM program (those of you that have down- } { loaded it). Anyway, compile this and use the cursor keys to move the } { window around. Use ESC to quit. Consider as you use the arrows that } { your but it demonstrates some of the speed with } { which you can manipulate the screen and some of the possibilities that } { exist for window manipulation. You can save screens in memory and } { instantaneously display them rather than write them tt_clr); end; procedure vwport_top; { Set top of viewport to x,y } const xvwprt_top = 2; begin gotoxy(x,y); send_code(xvwprt_top); end; procedure vwport_bot; { Set bottom of viewport to x,y } const xvwprt_bot = 3; begin gotoxy(x,y); send_code(xvwprt_bot); end; procedure vwport_restore; { Restore viewport to last CRT_RESET } const xvwprt_res = 4; begin send_code(xvwprt_res); end; procedure vwport_right_shift; { Here are a few more screen utilities for those of you that do some PASCAL programming. I really started to do a window function that was going to save window in dynamicly allocated memory with restoration by utilization of a window number. Unfortunatel,./0345678ABCDO^ { re-set viewport top } gotoxy(box_len,box_height); write(chr(3),chr(12)); { re-set viewport bottom, home cursor } end; ); { display "|" character } end; gotoxy(1,box_height+1); for counter:=1 to box_len do write(chr(95)); { display underline charcter } gotoxy(1,1); write(chr(2)); gotoxy(0,counter); { move to left side of viewport and } write(chr(124)); { display "|" character } gotoxy(box_len+1,counter); { now go to right side and } write(chr(124)Shift contents of viewport right } const xvwprt_rs = 23; begin send_code(xvwprt_rs); send_code(n); end; procedure vwport_left_shift; { Shift contents of viewport left } begin vwport_right_shift(-n); end; begin end. y it just didn't work out and since I had no use for it other than the thought that it would really be a neat feature, I quit the effort. If anyone thinks they can do it ( I was planning on having a varient subrecord to conserve memory), let me know how you make out. All the parts are here. E. Fournier [70116,1642] P.S. You may want to combine these library routines. I did them seperate thinking they wouldn't all get loaded if only one was used. procedure sv_scrn_status; begin { status buffer must be declared in the } status_buf[0] := chr(90); { calling program to at least 90 char's. } unitstatus(1,status_buf,4); end; procedure rs_scrn_status; begin { Display the character CH, } var indx : integer; { N times starting at current } begin { screen location. } for indx := 1 to n do send_code(ord(ch)); end; N procedure send_code(code: integer); { Common control character write } begin { routine. } unitwrite(1,code,1,,12); end; procedure rept_char; chars:bytestream; xtop, yleft, length, height:integer); { Create viewport border and set window to fall inside } IMPLEMENTATIOprocedure vwport_save(var buffer: bytestream); { Save viewport contents } procedure vwport_rstr(var buffer: bytestream); { Restore viewport contents } procedure sound_bell; { Ring the bell } procedure win_border(var stream); { Save screen status } procedure rs_scrn_status(var status_buf:bytestream); { Restore screen status } -------------------------} INTERFACE USES cursor_lib, crt_lib; procedure rept_char(ch:char; n:integer); { Display CH, N times } procedure sv_scrn_status(var status_buf:bytetions use interfaces in CURSOR_LIB. } { To control screen viewport functions use interfaces in CRT_LIB. } { } {-------------------------------------------------{ } { Pascal screen control library utility routines for Apple ///. } { Created and uploaded to Computserve DL7 section by E.J. Fournier. } { To control cursor func const c_horz = 24; begin send_code(c_horz); send_code(x); end; procedure goto_y; { move cursor to y position } const c_vert = 25; begin send_code(c_vert); send_code(y); end; begin end. r normal } const c_normal = 17; begin send_code(c_normal); end; procedure cur_home; { move cursor to home pos. } const c_home = 12; begin send_code(c_home); end; procedure goto_x; { move cursor to x position } { turn cursor off } const c_off = 6; begin send_code(c_off); end; procedure cur_inverse; { set cursor inverse } const c_inverse = 18; begin send_code(c_inverse); end; procedure cur_normal; { set cursoprocedure cur_down; { move cursor down } const c_down = 10; begin send_code(c_down); end; procedure cur_on; { turn cursor on } const c_on = 5; begin send_code(c_on); end; procedure cur_off; --------------------------------------------------------------------------- UNIT SCRN_UTILS; INTRINSIC CODE 53; {--------------------------------------------------------------------------} { status buffer must be declared in the } unitstatus(1,status_buf,6); { calling program to at least 90 char's. } end; procedure vwport_save; { Buffer must be packed array } begin { of char dimensioned as the } unitstatus(1,buffer,72); { product of viewport height } end; { times width plus 3. } procedure vwport_rstr; { Same commPROGRAM FONTCAPTURE; VAR driverfile, fontfile: FILE; $dbuf: PACKED ARRAY[0..1534] OF CHAR; $fbuf: PACKED ARRAY[0..1023] OF CHAR; $inputname, outputname: STRING; $ BEGIN $WRITELN(CHR(28)); $WRITELN('FONTCAPTURE PROGRAM'); $WRITELN; $WRITELN('This p<>?@O^ vwport_rstr(a_buf_2); { then the window } rs_scrn_status(b_buf_1); vwport_rstr(b_buf_2); end; until ichr = 27; end. ndx1] := chr((ord(b_buf_1[indx1]) mod 128) + incr); b_buf_1[indx1+1] := chr((ord(b_buf_1[indx1+1]) mod 128) + incr); rs_scrn_status(a_buf_1); { Restore original screen and } n indx1 := 25; incr := +1; end; 8 : begin indx1 := 25; incr := -1; end; end; if ichr in [8,10,11,21] then begin { adjust position status data } b_buf_1[ient as vwport_save } begin unitstatus(1,buffer,74); end; procedure sound_bell; { Ring the bell } const bell_c = 7; begin send_code(bell_c); end; rogram will extract FONT character data from a SOS.DRIVER'); $WRITELN('file and then store the data in a new file for use by you.'); $WRITELN; $WRITELN('If you plan to use the new FONT file with Business Basic,'); $WRITELN('use the PASCAL FILER to change the FONT storage file type from'); $WRITELN('a PASCAL data file to a FONTFILE...'); $WRITELN; $WRITELN; $WRITE('Input driver file name: '); $READLN(inputname); $WRITELN; $WRITE('Input output file name: '); $READLN(outputname); $RESET (driverfilEGHIJKLMNOPQO^=faults } send_code(13); cur_home; end; begin end. unitwrite(1,chars[7],1,,12); vwport_top(1,1); { Reset the viewport to fall inside } vwport_bot(length-2,height-2); { the border. } send_code(cur_ctrl); { Reset cursor movement to dehars[4],1,,12); end; gotoxy(0,length); unitwrite(1,chars[5],1,,12); { and finally the bottom using chars[5,6,7] } rept_char(chars[6],length-1); send_code(cur_ctrl); { Turn cursor movement off } send_code(0); 1); { Draw the top line using chars[0,1,2] } unitwrite(1,chars[2],1,,12); for i := 1 to height-1 do begin gotoxy(0,i); unitwrite(1,chars[3],1,,12); { draw the side lines using chars[3,4] } gotox(length); unitwrite(1,cvwport_top(xtop, yleft); vwport_bot(length, height); { chars[3] chars[4] } vwport_clear; cur_home; { chars[5] chars[6] chars[7] } unitwrite(1,chars[0],1,,12); rept_char(chars[1],length-procedure win_border; { Create a viewport border using chars. } const cur_ctrl = 21; { The order is as shown below } var i : integer; begin { chars[0] chars[1] chars[2] } e,inputname); $IF BLOCKREAD (driverfile,dbuf,3) <> 3 THEN EXIT (PROGRAM); $MOVELEFT (dbuf[28],fbuf[0],1024); $REWRITE(fontfile,outputname); $IF BLOCKWRITE(fontfile,fbuf,2) <> 2 THEN EXIT (PROGRAM); $CLOSE(fontfile,LOCK); $CLOSE(driverfile); END. { I started writing a few more programming utilities and came across } { the controls to save and restore the screen. I decided to experiment } { and the result is the code shown below. I realize the experiment n indx1 := 25; incr := +1; end; 8 : begin indx1 := 25; incr := -1; end; end; if ichr in [8,10,11,21] then begin { adjust position status data } b_buf_1[i for } ichr := ord(achr) mod 128; { arrow keys } case ichr of 10 : begin indx1 := 27; incr := +1; end; 11 : begin indx1 := 27; incr := -1; end; 21 : begi vwport_clear; writeln; writeln(' Hi'); writeln; write(' there'); sv_scrn_status(b_buf_1); { Save the window status and contents } vwport_save(b_buf_2); repeat unitread(1,achr,1); { Read a character and checkor i:= 1 to 20 do writeln(' This is a test. This is a test. This is a test. This is a test.'); sv_scrn_status(a_buf_1); { Save screen status and contents } vwport_save(a_buf_2); vwport_top(5,5); vwport_bot(6,4); { product of viewport height } end; { times width plus 3. } procedure vwport_rstr(var buffer: bytestream);{ Same comment as vwport_save } begin unitstatus(1,buffer,74); end; begin fs(1,status_buf,6); { calling program to at least 90 char's. } end; procedure vwport_save(var buffer: bytestream);{ Buffer must be packed array } begin { of char dimensioned as the } unitstatus(1,buffer,72); status_buf[0] := chr(90); { calling program to at least 90 char's. } unitstatus(1,status_buf,4); end; procedure rs_scrn_status(var status_buf:bytestream); begin { status buffer must be declared in the } unitstatu { screen location. } for indx := 1 to n do send_code(ord(ch)); end; procedure sv_scrn_status(var status_buf:bytestream); begin { status buffer must be declared in the } routine. } unitwrite(1,code,1,,12); end; procedure rept_char(ch:char; n:integer); { Display the character CH, } var indx : integer; { N times starting at current } begin r; a_buf_2, b_buf_2 : packed array[0..2000] of char; ichr, incr, indx1, i:integer; achr, ua, da, ra, la, esc : char; procedure send_code(code: integer); { Common control character write } begin { { } { If anyone uses this how about some reaction. i.e. drop me a note. } { } { E. Fournier [70116,1642] } { } program test; uses cursor_lib, crt_lib; var a_buf_1, b_buf_1 : packed array[0..89] of chaou use the arrows that } { your restoring the entire screen and the small window as you move about} { By the way, your expected to have the CURSOR and CRT libraries in the } { SYSTEM.LIBRARY } play them rather than write them to the screen. } { Consider there use in the FORM program (those of you that have down- } { loaded it). Anyway, compile this and use the cursor keys to move the } { window around. Use ESC to quit. Consider as y } { itself is of no real use but it demonstrates some of the speed with } { which you can manipulate the screen and some of the possibilities that } { exist for window manipulation. You can save screens in memory and } { instantaneously disndx1] := chr((ord(b_buf_1[indx1]) mod 128) + incr); b_buf_1[indx1+1] := chr((ord(b_buf_1[indx1+1]) mod 128) + incr); rs_scrn_status(a_buf_1); { Restore original screen and } vwport_rstr(a_buf_2); { then the window } rs_scrn_status(b_buf_1); vwport_rstr(b_buf_2); end; until ichr = 27; end. procedure delay(j:integer); var k :integer; begin j := j*60; for k := 1 to j do scrnsync; end; procedure homecur; begin uwrt(12); end; procedure resetvp; begin uwrt(1); end; procedure vptop; begin uwrt(2); end; procedure vpbot; begin uwrt(end; procedure uwrt(j:integer); begin g[0] := j; unitwrite(1,g,1,,12); end; { uwrt} procedure scrnsync; begin uwrt(22); end; {1/60th sec} var g: packed array[0..20] of 0..255; {used in unitwrite} req: packed record {used in unitstatus } channel:0..1; stat_or_ctrl:0..1; request_num:0..255; reserved:0..63; 8/85 - Freeware? } {note the "req" record in the VAR section below is needed for : fndsiz fndcurpos boxvp clrbug All the other procedures will work without this } {This a collection Pascal procedures used as screen utilities on the Apple ///. Also included are a few others such as one to clear the input buffer. Submitted by Harry Baya, 72135,1667, 6/8/85 } program vpstuff; {by Harry Baya 72135,1667, 6/RTUVWXYZ[\]^O^GG3); end; procedure dfvp (ulx,uly,lrx,lry : integer); {secton to define a viewport} begin resetvp; gotoxy(lrx,lry); vpbot; gotoxy(ulx,uly); vptop; gotoxy(0,0) end; {end of dfvp} procedure clearvp; begin uwrt(28);end; procedure clflscr; begin dfvp(0,0,79,23); clearvp; end; procedure normcha; begin uwrt(17); end; /// /// /// /// /// /// /// /// /// /// /// /// /// /// /// /// SIG, Washington Apple Pi 12022 Parklawn Drive Rockville, MD. 20852 (301)-984-0300 p; gotoxy(10,10); writeln('Thats all folks .........: Harry Baya, 72135,1667 '); end. nd; begin boxvp; writeln('this is the current Viewport '); writeln('press any key to continue : '); rdalph; dfvp(10,10,60,20); boxvp; writeln('This is a smaller box '); write('Press any key to continue : '); rdalph; showboxes; dfvp(0,0,79,23); clearv dfvp(18,20,45,40); boxvp; dfvp(45,16,79,23); boxvp; for i := 1 to 10 do begin x := 14 + 3* i; y := 3 + i; dfvp(x,y,x+20,y+9); boxvp; write(chr(7)); end; delay(4); e do writeln; if xrel > 0 then for i := 1 to xrel do curright; end; {gorelin} procedure rdalph; var alpha : char; begin read(alpha); end; procedure showboxes; var i,x,y : integer; begin dfvp(0,5,15,28); boxvp; teger); var i,xloc,yloc : integer; begin fndcurpos(xloc,yloc); gotoxy( (xloc +xrel), (yloc+yrel)); end; {gorel} procedure gorelin( xrel,yrel : integer); var i,xloc,yloc : integer; begin if yrel > 0 then for i := 1 to yrel; end; procedure curright; begin uwrt(9); end; procedure curdown; begin uwrt(10); end; procedure curup; begin uwrt(11); end; {procedure homecur; begin uwrt(12); end; [used earlier] } procedure retrncur; begin uwrt(13); end; procedure gorel( xrel,yrel : in clearvp; dfvp(ulx+1,uly+1,lrx-1, lry-1); normcha; clearvp; dfvp(ulx+2,uly+2, lrx-2,lry-1); end; {boxvp} {*15 cursor stuff } procedure curleft; begin uwrt(8) req.request_num := 5; req.stat_or_ctrl := 1; unitstatus(1, i,req); end; {clrbuf} procedure boxvp; var ulx, uly, lrx,lry : integer; begin fndsiz(ulx,uly, lrx, lry); invercha; uly); lrx := lrx + ulx; lry := lry + uly; dfvp(ulx,uly,lrx,lry); gotoxy(ix,iy); end; {fndsiz} procedure clrbuf; {this clears the key input buffer, same as pressing control-6 } var i : integer; begin sary[1]; ypos := posary[2]; end;{fndcurpos} procedure fndsiz( var ulx, uly, lrx, lry : integer); var ix,iy :integer; begin fndcurpos(ix,iy); gotoxy(79,23); fndcurpos(lrx,lry); homecur; resetvp; fndcurpos(ulx,procedure fndcurpos(var xpos,ypos :integer ); type numbyte = 0..255; var posary : packed array[1..2] of numbyte; begin req.request_num := 16; req.stat_or_ctrl := 0; unitstatus(1,posary,req); xpos := po procedure invercha; begin uwrt(18); end; procedure clrtoend; begin uwrt(29);end; procedure clearln; begin uwrt(30);end; procedure clrendln; begin uwrt(31);end; WAP /// SIG PD PDS NAME: PASCAL MODULES FOR DEVELOPERS DISK ID#: 3PCL-20 BOOTABLE? Not Bootable - requires Pascal This disk includes a number of Pascal Modules you can use to help you as a developer. Below is a list of each file and a short descripti_abcdefghijklmno the screen. Consider their use in the FORM program (those of you that have down- loaded it). Anyway, compile this and use the cursor keys to move the window around. Use ESC to quit. Consider as you use the arrows that your restoring the entire of no real use but it demonstrates some of the speed with which you can manipulate the screen and some of the possibilities that exist for window manipulation. You can save screens in memory and instantaneously display them rather than write them tBy E.J. Fournier WINDOWUTIL.TEXT I started writing a few more programming utilities and came across the controls to save and restore the screen. I decided to experiment and the result is the code shown below. I realize the experiment itself isanning on having a varient subrecord to conserve memory), let me know how you make out. All the parts are here. P.S. You may want to combine these library routines. I did them seperate thinking they wouldn't all get loaded if only one was used. y with restoration by utilization of a window number. Unfortunately it just didn't work out and since I had no use for it other than the thought that it would really be a neat feature, I quit the effort. If anyone thinks they can do it ( I was plM.LIBRARY By E.J. Fournier PSCL.SCRN.TEXT Here are a few more screen utilities for those of you that do some PASCAL programming. I really started to do a window function that was going to save window in dynamicly allocated memor the cursor keys to move the window around. Use ESC to quit. Consider as you use the arrows that your restoring the entire screen and the small window as you move about By the way, you're expected to have the CURSOR and CRT libraries in the SYSTEhat exist for window manipulation. You can save screens in memory and instantaneously display them rather than write them to the screen. Consider their use in the FORM program (those of you that have down- loaded it). Anyway, compile this and useand restore the screen. I decided to experiment and the result is the code shown below. I realize the experiment itself is of no real use but it demonstrates some of the speed with which you can manipulate the screen and some of the possibilities tre interesting border but the border created using standard characters and this one special character is really sufficient. By E.J. Fournier PAS.WINDOW.TEXT I started writing a few more programming utilities and came across the controls to save urnier WINDOW.BOR.TEXT The code was created as a result of not having the "chr()" character definitions for the characters used in the FORM program in the XA7 library. The routine could be expanded to include other character shapes to make a moontrol cursor functions use interfaces in CURSOR_LIB. By E.J. Fournier CURSOR.LIB.TEXT Pascal cursor control library utility routines for Apple ///. Created to control screen/viewport functions use interfaces in CRT.LIB. By E.J. Foon of what each one does. IF you use any of these to develop a program for the Apple /// we hope you'll share it with the rest of the /// Community! SIDE ONE: CRT.LIB.TEXT Pascal screen control library utility routines for Apple ///. Created to c screen and the small window as you move about By the way, your expected to have the CURSOR and CRT libraries in the SYSTEM.LIBRARY. By E.J. Fournier FONT.CAP.TEXT This program will extract FONT character data from a SOS.DRIVER file and then store the data in a new file for use by you. If you plan to use the new FONT file with Business Basic, use the PASCAL FILER to change the FONT storage file type from a PASCAL data file to a FONTFILE... VIEWPRTPOS.TEXT This BAYA.1v88'  'ALIB2.TEXTA8!8%oALIB2IN.TEXT5h8!8%oGETLIB2.TEXT8"8"oong integer conversion, SOS time and date, unitstatus calls and more. Source included. GENUTIL3.TEXT; SOSTIME.TEXT; TGENUTIL3.TEXT; TGENUTIL3.LIB; SOSTIME.CODE; TGENUTIL3.CODE eryone can use them. This program uses the CRT.LIB that is in the data base so upload that first to use this program. TODD BLACKLEY [72426.206] SIDE TWO An assortment of PASCAL utilities and input routines. Included are text input routines, lyou press BOTH APPLES and the ENTER key (not the return key) It would not be too much trouble to add a on-line notepad / calandar / and other routines that would use a special keys. If someone writes some of these routines, Please upload them so ev routine that will print the buffer that contains the screens contents. I have also added a GET_KBD_BYTE routine that will return the first byte from the keyboard. if you use this routine in your program you will always have the PRTSCR routine if Meanwhile enjoy playing Mouser for awhile. It's not quite a MAC and thats a pleasing thought. By: David Bixby 16 Mar 85 PRINT.SCRN.TEXT This program was taken in part from the window demo program by E.Fournier. I have added a Print Screenprogram hang up every time I tried to write to the Mouse I decided to forego it at this point. The net effect is that the Mouse will jump to a new position when the Open-Apple X or Y command is terminated. Not a major problem but still annoying. Quits the Program The Open-Apple X and Y commands are nice for plotting strictly horizon- tal or vertical lines. One note is that these two commands stay in effect until another key is pressed (i.e. the spacebar). Since I had the onstant Open-Apple Y Keeps Y-Value Constant Open-Apple C Clears the Screen Open-Apple S Switch Between Screens Open-Apple Q COMMANDS: EFFECT: Click the Mouse Plot a Point Hold the Mouse Button Down Draws solid lines Open-Apple X Keeps X-Value Crun the BW 280 graphics mode. It allows the user to do freehand drawing. The program will plot a point by pressing the mouse button and by holding it down it will draw lines as fast as you move it, but the faster you do the more jagged it becomes. ech reference manual package. I only use it to get the SOS device number of the Mouse Driver. The procedure Pnum then translates this into the Pascal Unit number needed by the Unitstatus, Unitread, and Unitwrite commands. The program is setup to show how the Mouse can be used in Programming on the Apple ///. This program requires that Applestuff, Pgraf, and Psosio be located in the system library. Psosio is an implemen- tation of SOS Commands straight from Pascal. It is part of the Pascal Tis a collection of Pascal procedures used as screen utilities on the Apple ///. Also included are a few others such as one to clear the input buffer. Submitted by Harry Baya, 72135,1667, 6/8/85 PSCL.MOUSE.TEXT This is a little graphics demo to  A C D B E F G Y J X >VodWoWooWO^e Quits the Program } { The Open-Apple X and Y commands are nice for plotting strictly horizon- } { tal or vertical lines. One note is that these two commands stay in effect } { until another key is pressed (i.e. the spaceba Keeps Y-Value Constant } { Open-Apple C Clears the Screen } { Open-Apple S Switch Between Screens } { Open-Apple Q { Click the Mouse Plot a Point } { Hold the Mouse Button Down Draws solid lines } { Open-Apple X Keeps X-Value Constant } { Open-Apple Ybutton and by holding it down it will draw lines as fast as you move it, but} { the faster you do the more jagged it becomes. } { COMMANDS: EFFECT: } ascal Unit } { number needed by the Unitstatus, Unitread, and Unitwrite commands. } { The program is setup to run the BW 280 graphics mode. It allows the user } { to do freehand drawing. The program will plot a point by pressing the mouse } { ry. Psosio is an implemen- } { tation of SOS Commands straight from Pascal. It is part of the Pascal Tech } { reference manual package. I only use it to get the SOS device number of the } { Mouse Driver. The procedure Pnum then translates this into the P { MOUSE.PAS By: David Bixby 16 Mar 85 } { This is a little graphics demo to show how the Mouse can be used in } { Programming on the Apple ///. This program requires that Applestuff, } { Pgraf, and Psosio be located in the system libraqstuvwxyz{|O^"r). Since I had the program } { hang up every time I tried to write to the Mouse I decided to forego it at } { this point. The net effect is that the Mouse will jump to a new position } { when the Open-Apple X or Y command is terminated. Not a major problem but } { still annoying. } { Meanwhile enjoy playing Mouser for awhile. It's not quite a MAC and } { thats a pleasi}O^[0,1] := On; Cursor[0,2] := On; Cursor[1,0] := On; Cursor[1,1] := On; Cursor[2,0] := On; Cursor[2,2] := On; Cursor[3,3] := On; Mode := 1; GRAFIXMODE (BW280,Mode); INITGRAFIX; FILLCOLOR (BLACK); FILLPORT; X := 50; Y := UNITSTATUS (U_Num, D_Buf, 35); M_Buf[1] := 139; M_Buf[2] := 0; M_Buf[3] := 96; M_Buf[4] := 0; M_Buf[5] := 0; FOR Row := 0 TO 3 DO Begin FOR Col := 0 TO 3 DO Cursor[Row,Col] := Off; End; Cursor[0,0] := On; Cursor] := 0; D_Buf[4] := 0; UNITSTATUS (U_Num, D_Buf, 5); D_Buf[1] := 0; D_Buf[2] := 0; D_Buf[3] := 23; D_Buf[4] := 1; UNITSTATUS (U_Num, D_Buf, 31); D_Buf[1] := 0; D_Buf[2] := 0; D_Buf[3] := 192; D_Buf[4] := 0; gin REWRITE(GScreen,'GRAPHIC:'); DevName := '.MOUSE'; RESET (M_File, DevName); SOS_Get_D_Num ( DevName, D_Numb, Code ); SOS_D_Info ( D_Numb, DevName, D_List, Code ); U_Num := PNum ( D_Numb ); D_Buf[1] := 0; D_Buf[2] := 0; D_Buf[3; PasNum := SCAN(41,=CHR(D_Numb),Data)+1; IF PasNum = 42 THEN Begin PasNum := 0; END ELSE IF PasNum > 20 THEN Begin PasNum := PasNum + 107; END; END; PNum := PasNum; END; Be RegularUnits : PACKED ARRAY [1..20] OF BYTE; UserUnits : PACKED ARRAY [128..147] OF BYTE; END; Begin IF D_Numb = 0 THEN Begin PasNum := 0; END ELSE Begin UnitStatus(0,Data,0)RRAY [0..10] OF 0..255; Cursor : PACKED ARRAY [0..3, 0..3] OF BOOLEAN; FUNCTION PNum (D_Numb:INTEGER): INTEGER; TYPE Byte = 0..255; VAR PasNum : INTEGER; Data : PACKED RECORD DevName : STRING; X, Y, Click, Mode, D_Numb, U_Num, Row, Col, Code : INTEGER; M_File : INTERACTIVE; GScreen : INTERACTIVE; M_Buf : PACKED ARRAY [1..5] OF 0..255; D_Buf : PACKED ARRAY [1..4] OF 0..255; D_List : PACKED Ang thought. } { } PROGRAM MOUSETEST; USES APPLESTUFF, PGRAF, PSOSIO; CONST On = TRUE; Off = FALSE; VAR Ch : Char; { This program was taken in part from the window demo program by } { E.Fournier. I have added a Print Screen routine that will print the } { buffer that contains the screens contents. I have also added a } { GET_KBD_BYTE routine tha89] of char; CRT_buf, Temp_Buf : Packed array[0..2000] of char; P_Device : STring; begin sv_scrn_status(CRT_buf_Status); { Save screen status } vwport_save(CRT_buf); { Save screen contents } Temp_B { times width plus 3. } procedure vwport_rstr(var buffer: bytestream);{ Same as vwport_save } begin unitstatus(1,buffer,74); end; procedure Prt_Screen; var x,x2,x3 :Integer; CRT_Buf_Status : Packed array[0..procedure vwport_save(var buffer: bytestream);{ Buffer must be packed array } begin { of char dimensioned as the } unitstatus(1,buffer,72); { product of viewport height } end; rocedure rs_scrn_status(var status_buf:bytestream); begin { status buffer must be declared in the } unitstatus(1,status_buf,6); { calling program to at least 90 char's. } end; e,1,,12); end; procedure sv_scrn_status(var status_buf:bytestream); begin { status buffer must be declared in the } status_buf[0] := chr(90); { calling program to at least 90 char's. } unitstatus(1,status_buf,4); end; p IMPLEMENTATION Procedure Send_Code(Code:integer); { Common control char write } begin { routine. } unitwrite(1,cod { Get routine that dumps } { the screen on a keypress } { of Both-apples & Enter } DATA 47; INTERFACE USES {$USING crtlib.code } CRT_Lib; VAR D_File : Text; Procedure Prt_Screen; { Screen dump. } Procedure Get_KBD_Byte(var first_Byte,second_byte:Char); } { Plain key = 65 } { Number pad = 193 } { } { The Get_KBD_Byte procedure will call the Prt_Screen procedure when } { BOTH Apple keys AND the ENTER key is pressed. } { } { } UNIT SCREEN_DUMP; INTRINSIC CODE 46 | 77 | 75 |} { Open Apple | 89 | 81 |113 | 85 | 83 |} { Closed Apple |105 |113 | 97 |101 | 99 |} { Control | 77 | 85 |101 | 69 | 71 |} { Shift | 75 | 83 | 99 | 71 | 67 |} {{ The values listed below are only for 1 or two key combinations. You } { can use all of the (modifier) keys to return different numbers. } { } { Alpha Open Closed Control Shift } { Alpha lock | 73 | 89 |105 first to use this program. } { } { Have fun. TODD BLACKLEY [72426.206] } { { Value of the 2nd byte from the Get_Kbd_Byte procedure. } ne notepad / calandar / } { and other routines that would use a special keys. If someone writes } { some of these routines, Please upload them so everyone can use them. } { This program uses the CRT.LIB that is in the data base so upload that } { t will return the first byte from the keyboard.} { if you use this routine in your program you will always have the PRTSCR} { routine if you press BOTH APPLES and the ENTER key (not the return key)} { } { It would not be too much trouble to add a on-liuf:=CRT_Buf; vwport_top(0,21); vwport_bot(79,2); vwport_clear; gotoxy(0,0); for x:=1 to 80 do write('_'); gotoxy(1,1); write('Enter Device :'); repeat { Get device name to print} gotoxy(15,1); readln(P_Device); {$IOCheck-} rewrite(D_File,P_Device); {$IOCheck+} until (io_result=0) or (P_Device=''); if P_Device<>'' then begin for x2:=0 to 2000 do begin { Change ORD(byte) to < 128 } if ord(CRT_Buf[x2])>128 t.request_num:0..255; reserved:0..63; .end; . )wraprec : record )case recform of ,1 : (gint : packed array[0..2] of 0..255); ,2 : (galph : packed array[0..2] of char); ,end; ) )tscr1on,tscr2on,tscr3on, {these tscr.. are for use in getcha etc.} for building underlines, uses 234 bytes, 1/30/84} * $ )g: packed array[0..20] of 0..255; {used in unitwrite, unitread} ) )chary : packed array[0..20] of char;  )req: packed record {used in unitstatus } .channel:0..1; stat_or_ctrl:0..1; (datetyp = array[1..3] of integer;  (keysett = (kshft, kctrl, kalock, kopen, kclosed, kspec); (maxstrt = string[233]; * " 5 $var outprint : text; )scrfil : file of screct; )scrpth : string; {for scrfil, intialized} ) )maxstr : maxstrt; {array[0..2000] of 0..255; ;ulx,uly,lrx,lry,xpos,ypos,stackrec,prior, ;next : integer); 52 : ( nextrec, newrec, startrec : integer); 6end; 6 (diagset = set of 0..255; (shortstr = string[40]; (stralib6 = string[6]; ( ) )boxtype = (norm, wide, high, big, rvp, lvp, rvp2, lvp2, fullvp); ) )ptrtyps = (epson, lqp, typeptr1,typeptr2,typeptr3,typeptr4,typeptr5); ) )recform = 1..10; ) # screct = record {for scrpg} 1case recform of 1 1 : ( fulscrn : packed ' interface ' uses realmodes, transcend, applestuff, %{$using .profile/hb/share1.code} share1; $ $type numry = array[0..40] of real; {used in Mstrnum} )boolary = array[0..40] of boolean;{used in Mstrnum & colcal2} ) )wraptype = (on,off,resetw); unit alib2; intrinsic code 25 data 26;  { Jan 16, 1986 - modified "uses..", no change to interface "last update :4/06/84 } { uses - $include .profile/hb/alib2in.text 0scrpth := '.profile/hb/fxdscrns.data'; 0.profile/hb/share1.code } p end; Procedure Get_KBD_Byte; { (Var first_Byte,second_Byte:Char); } var Key_Count : Integer; In_chr, sn_chr, Two_Byte_Mode, One_byte_mode : Char; begin in_chr:=chr(00); sn_chr:=chr(00); First_Byte:=chr(00); ile,CRT_Buf[(x2*80)+(x3+40)+3]); end; writeln(D_File,''); end; Close(D_file); end; rs_scrn_status(CRT_buf_Status); { Restore original screen and } vwport_rstr(TEMP_buf); { then the window }hen CRT_Buf[x2]:=chr(ord(CRT_Buf[x2])-128) else CRT_Buf[x2]:=chr(00); end; for x2:=0 to 23 do begin { Print screen buffer } for x3:=0 to 39 do begin write(D_File,CRT_Buf[(x2*80)+(x3)+3]); write(D_F)hold72nd : integer; { to hold 72nd of lines set before underline} , ){turned on and off, or assigned values by procedures in alib } 1wrap,wrap2, boxon, inveron, 1emphon, cndnseon, underon, enlargeon: boolean; 1 1vspc72nd : integer; {current setting, initialized to -1} 1linesinpage, vprefskip : integer; & .{note : rf1 .. rf5 are not used in alib- are available} )jiolib, nxtrec, nxtrecz, rf1, rf2, rf3, rf4, rf5, jdum : integer; ) ) )alalib : char; ) )stac 96; PENCOLOR(WHITE); XFROPTION (2); GRAFIXON; REPEAT XFROPTION(0); IF Click = 128 THEN LINETO(X,Y) ELSE MOVETO(X,Y); XFROPTION(2); DRAWIMAGE (Cursor, 2, 0, 0, 4, 4); UNITREAD (U_Num, M_Buf, 5, 1cedure wrsp(nspace : integer); % %procedure delay(j:integer); %procedure keywait; % %procedure readcha(var scrncha:char ); {from screen} %function rlim(val,max,min : real ) : boolean; %function ilim(val,max,min : integer): boolean; % %function % {*10 utility stuff - non print } %procedure normcha; %procedure invercha; % %procedure cutstr(maxl:integer; var str80:string); % %procedure telltrue(test:boolean); %procedure teltru2( vbooly : boolean); ! %procedure bl( nline : integer); %proocedure boxrl(boxrlsz : boxtype ); %procedure boxmsg2; %procedure qboxmsg( iloc : integer; beeper:boolean; msgstr1, msgstr2 : string); % {*9 wait stuff } %procedure waiter(msgw :shortstr); %procedure waitscr1(msgw:shortstr); %procedure waitoff; % ocedure msg1b(ulx,uly,lrx,lry : integer); %procedure bmsg(msg :string; rec : integer); %procedure qmsgb( msgstr1, msgstr2 : string); % % {*8 box message stuff } %procedure boxmsg1( scrx, scry : integer; boxsize : boxtype); %procedure boxmsgvp; %pr( var ulx, uly, lrx, lry : integer); % % % {*6 screen save/recall stuff } %function scrpush( recn :integer):integer; %procedure scrpg( pg : integer; var recscr2x : integer); % % {*7 message stuff - non box } %procedure msg1; %procedure msg2; %pr%procedure clearvp; %procedure clflscr; %procedure clrbuf; %procedure clrbuforce; % %procedure clrtoend; %procedure clearln; %procedure clrendln; % % {*5 find location stuff } %procedure fndcurpos(var xpos,ypos :integer ); %procedure fndsiz (ulx,uly,lrx,lry : integer); %procedure resetvp; %procedure boxvp; % %procedure restorvp; %procedure vptop; %procedure vpbot; %procedure stdvps( boxsize : boxtype); % %procedure shiftscr(i:integer); % % {*4 clear stuff } dure getany2; %function yesf : boolean; %procedure alphago; %function igetrng ( max, min : real; var ival:integer):boolean; %function pick1ofn( numchoices : integer {1 to 9 } ): integer; % % % % {*3 vp (viewport ) stuff } %procedure dfvp getcha(wrkset : diagset; var ordgcha:integer; var onechar :char); %procedure unget1key( ch:char ); %procedure getcha2(wrkset : diagset;var ordgcha:integer; var onechar :char); %procedure getany(var ordofcha : integer; var onechar : char ); %proce%procedure hlp2set( he1,he2,he3, he4,he5 : integer); %function helper(whichelp : integer): boolean; % % {*2 user enter stuff } %function getord: integer; %function ordnumf(ordfa:integer): integer; %procedure getkey (var c1 : char); %procedure)keyset : set of keysett; , ){for buffread } )secondchar : char; )buffcha1,buffcha2 : char; )buffinuse : boolean; % {*1 help stuff } %procedure hlpavail; %procedure nohelp; %procedure hlp1set( he1,he2,he3, he4,he5 : integer); on, hlpinuse, escyesf, waitb : boolean; ) )noshiftlk:boolean; {used to indicate cndenseon during =emphasize } ) )clkyr, clkmos, clkday , clkdayofwk, clkhr, 6clkmin, clksec, clkthou : integer; G )ptrtype : ptrtyps; * * )memkeyset : keysett; * kry : array[0..100] of integer; { [0] is next unused slot} ) )dfboolry : boolary; { colcalc2 } ) $ diag, alibset : diagset; ) )glprior, glnext, calchlp, modhlp, ghlp1, ghlp2, ghlp3 : integer; )heli : array[1..20] of integer; ) )help1on, help22); IF Ch <> CHR(216) THEN X := M_Buf[1] + 256 * ORD(ODD(M_Buf[2]) AND ODD(1)) ELSE X := X; IF Ch <> CHR(217) THEN Y := 191-M_Buf[3] ELSE Y := Y; IF Y < 0 THEN Y:= 0; Click := ORD(ODD(M_Buf[5]) AND ODD(128)); IF KEYPRESS THEN READ (Ch); DRAWIMAGE (Cursor, 2, 0, 0, 4, 4); IF Ch = CHR(195) THEN Begin XFROPTION(0); FILLPORT; Ch := CHR(5); END; IF Ch = CHR(21escriptionFof what each one does. IF you use any of these to develop a programDfor the Apple /// we hope you'll share it with the rest of the /// Community! SIDE ONE:CRT.LIB.TEXTL Pascal screen control library utility routineWAP /// SIG PD DISK 3PCL- PASCAL MODULES FOR DEVELOPERS GThis disk includes a number of Pascal Modules you can use to help youGas a developer. Below is a list of each file and a short dHO=====|====|====|====|====|====|====|====|====|====|====|====|====|====|====|===.G g;  to continue: chr=chr(241))) or { B-Apple-ENTER } ((in_chr=chr(141)) and (sn_chr=chr(249)))) then Prt_Screen Else begin First_Byte:=in_chr; second_Byte:=sn_chr; end; unitstatus(1,One_Byte_Mode,14); { Set KBD for 1 byte mode } end; beg, key_count, 21); { Check if byte in KBd buffer } until (key_Count<>0); unitread(2, in_chr, 1, 12); { Get first byte of keypress } unitread(2, sn_chr, 1, 12); { Get 2nd byte of keypress } if (((in_chr=chr(141)) and (sn_ second_Byte:=chr(00); Two_Byte_Mode:=chr(128); { 2 byte mode =$80 } One_Byte_mode:=chr(00); { 1 byte mode =$00 } unitstatus(1,Two_Byte_Mode,14); { Set KBD for 2 byte mode } repeat key_count := 0; unitstatus(21) THEN Begin IF Mode = 1 THEN Mode :=2 ELSE Mode := 1; GRAFIXMODE(BW280,Mode); GRAFIXON; Ch := CHR(5); END; UNTIL Ch = CHR(209); END. Key to continue: s for Apple ///. : Created to control cursor functions use interfaces in ) CURSOR_LIB. By E.J. FournierCURSOR.LIB.TEXTA Pascal cursor control library utility routines for Apple ///.4 Created to control screen/viewport functions use2 interfaces in CRT.LIB. By E.J. Fournier WINDOW.BOR.TEXT> The code was created as a result of not having the "chr()"H character definitions for the characters used in the FORM program inN the XA7 libraryVIEWPRTPOS.TEXTM This is a collection of Pascal procedures used as screen utilities on theG Apple ///. Also included are a few others such as one to clear the? input buffer. Submitted by Harry Baya, 72135,1667, 6/8/85 }PSCL.MOUSE.TEXm a SOS.DRIVER> file and then store the data in a new file for use by you.= If you plan to use the new FONT file with Business Basic,B use the PASCAL FILER to change the FONT storage file type from) a PASCAL data file to a FONTFILE... d the small window as you move aboutK By the way, your expected to have the CURSOR and CRT libraries in the = SYSTEM.LIBRARY. By E.J. FournierFONT.CAP.TEXTC This program will extract FONT character data fror their use in the FORM program (those of you that have down-K loaded it). Anyway, compile this and use the cursor keys to move the K window around. Use ESC to quit. Consider as you use the arrows that K your restoring the entire screen aneed with K which you can manipulate the screen and some of the possibilities that K exist for window manipulation. You can save screens in memory and K instantaneously display them rather than write them to the screen. H Consideamming utilities and came across K the controls to save and restore the screen. I decided to experiment K and the result is the code shown below. I realize the experiment K itself is of no real use but it demonstrates some of the spAll the parts are here.M P.S. You may want to combine these library routines. I did them seperate? thinking they wouldn't all get loaded if only one was used. By E.J. FournierWINDOWUTIL.TEXTK I started writing a few more progre IK had no use for it other than the thought that it would really be a neatH feature, I quit the effort. If anyone thinks they can do it ( I wasK planning on having a varient subrecord to conserve memory), let me know. how you make out. of you that do some PASCALL programming. I really started to do a window function that was going toM save window in dynamicly allocated memory with restoration by utilizationJ of a window number. Unfortunately it just didn't work out and since screen and the small window as you move aboutK By the way, you're expected to have the CURSOR and CRT libraries in the5 SYSTEM.LIBRARY By E.J. FournierPSCL.SCRN.TEXTM Here are a few more screen utilities for those n.H Consider their use in the FORM program (those of you that have down-I loaded it). Anyway, compile this and use the cursor keys to move theI window around. Use ESC to quit. Consider as you use the arrows thatK your restoring the entirit demonstrates some of the speed withJ which you can manipulate the screen and some of the possibilities thatF exist for window manipulation. You can save screens in memory andF instantaneously display them rather than write them to the screeTF I started writing a few more programming utilities and came acrossI the controls to save and restore the screen. I decided to experimentE and the result is the code shown below. I realize the experimentG itself is of no real use but . The routine could be expanded to include other characterI shapes to make a more interesting border but the border created usingL standard characters and this one special character is really sufficient. By E.J. FournierPAS.WINDOW.TEXTO This is a little graphics demo to show how the Mouse can be used in N Programming on the Apple ///. This program requires that Applestuff, P Pgraf, and Psosio be located in the system library. Psosio is an implemen- P tation of SOS Commands straight from Pascal. It is part of the Pascal Tech P reference manual package. I only use it to get the SOS device number of the P Mouse Driver. The procedure Pnum then translates this into the Pascal Unit P number needed %procedure wryesno( boolin : boolean); % %procedure mknotes; % % % {*11 utility stuff - printer } % %procedure blp(nlines : integer); %procedure prsp( nspace : integer ); %procedure scrnprnt(hb,vb,he,ve : integer); %{procedure printime;} %prtatus%calls and more. Source included.KGENUTIL3.TEXT; SOSTIME.TEXT; TGENUTIL3.TEXT; TGENUTIL3.LIB; SOSTIME.CODE;TGENUTIL3.CODEbase so upload that first to use this program. TODD BLACKLEY [72426.206] SIDE TWOLAn assortment of PASCAL utilities and input routines. Included are textLinput routines, long integer conversion, SOS time and date, unitso much trouble to add a on-line notepad / calandar /H and other routines that would use a special keys. If someone writesH some of these routines, Please upload them so everyone can use them.I This program uses the CRT.LIB that is in the data GET_KBD_BYTE routine that will return the first byte from the keyboard.K if you use this routine in your program you will always have the PRTSCRK routine if you press BOTH APPLES and the ENTER key (not the return key)J It would not be tod Bixby 16 Mar 85 PRINT.SCRN.TEXTB This program was taken in part from the window demo program byH E.Fournier. I have added a Print Screen routine that will print theC buffer that contains the screens contents. I have also added aK still annoying. O Meanwhile enjoy playing Mouser for awhile. It's not quite a MAC and P thats a pleasing thought. ! By: Daviam P hang up every time I tried to write to the Mouse I decided to forego it at P this point. The net effect is that the Mouse will jump to a new position P when the Open-Apple X or Y command is terminated. Not a major problem but P gram O The Open-Apple X and Y commands are nice for plotting strictly horizon- P tal or vertical lines. One note is that these two commands stay in effect P until another key is pressed (i.e. the spacebar). Since I had the progrKeeps Y-Value Constant O Open-Apple C Clears the Screen O Open-Apple S Switch Between Screens O Open-Apple Q Quits the Pro Plot a Point O Hold the Mouse Button Down Draws solid lines O Open-Apple X Keeps X-Value Constant O Open-Apple Y down it will draw lines as fast as you move it, P but the faster you do the more jagged it becomes. O COMMANDS: EFFECT: O Click the Mouse by the Unitstatus, Unitread, and Unitwrite commands. O The program is setup to run the BW 280 graphics mode. It allows the user P to do freehand drawing. The program will plot a point by pressing the mouse M button and by holding it ocedure prfixstr(targlength : integer; instr : string); {print} %procedure pryesno( boolin : boolean); %procedure disptime; %procedure fillspace( used, full : integer); %procedure setprefskip( lines : integer ); %procedure setvlines( lines : integer ); %procedure condense; %procedure uncondense; %procedure emphasize; %procedure demphasize; %procedure setlnfeed( space72nd :integer); % %procedure setunderon( old72nd:integer); %procedure desetunderon; %procedure underline( nspace:integer); %%{ heli[1..5] set up by hlp1set and available if help1on is true, 'heli[6..10] set up by hlp2set and available if help2on is true, 'heli[11..15] must be set explicitly and may be used anytime %} ,var i, ordnumx,scrhld, helpscr, ix,iy, jx, jy, curscr :e2; 'if he3 > -1 then heli[8] := he3; 'if he4 > -1 then heli[9] := he4; 'if he5 > -1 then heli[10] := he5; 'end; {hlp2set} ' ' ' % function helper; {(whichelp : integer): boolean; } li[5] := he5; 'end; {hlp1set} ' ' "procedure hlp2set; {( he1,he2,he3, he4,he5 : integer); } ' {resets heli[6..10] if he val not negative, turns on help2on} 'begin 'help2on := true; 'if he1 > -1 then heli[6] := he1; 'if he2 > -1 then heli[7] := h);} ' {resets heli[1..5] if he val not negative, turns on help1on} 'begin 'help1on := true; 'if he1 > -1 then heli[1] := he1; 'if he2 > -1 then heli[2] := he2; 'if he3 > -1 then heli[3] := he3; 'if he4 > -1 then heli[4] := he4; 'if he5 > -1 then he%end;{hlpavail} % / "procedure nohelp; 'begin 'boxmsg1(10,10,norm); 'gotoxy(5,3); 'writeln( ' - n o h e l p - '); 'delay(2); 'jdum := -abs(jdum); 'scrpg(10,jdum); 'end; {nohelp} "procedure hlp1set; {( he1,he2,he3, he4,he5 : integeriteln; %writeln(' "apple" means press open apple key'); %writeln(' together with indicated key.'); %end; %alibset := [13,27, 16, 18,32 ]; %getcha2(alibset, i, alalib); %jdum := -abs(jdum); %scrpg(10,jdum); %hlpinuse := false; en writeln('apple-?'); %if (heli[3] > 0 ) then writeln(' !'); %if (heli[4] > 0 ) then writeln('apple-!'); %writeln; %writeln; %for i := 6 to 14 do if (heli[i] > 0 ) then )writeln('apple-',(i-5) ); %if heli[15] > 0 then writeln('apple-0'); %wr; "if not avail then /begin /writeln('No help screens available,'); /writeln; /writeln('Try later.'); /end %else %begin %writeln('Help screens are available using : '); %writeln; %if (heli[1] > 0 ) then writeln('apple-h'); %if (heli[2] > 0 ) th%procedure abspos(i,k:integer);  implementation  {*1 help stuff}  procedure hlpavail; $var i : integer; $avail : boolean; "begin "hlpinuse := true; "boxmsg1(0,1,high); "avail := false; "for i := 1 to 15 do if heli[i] > 0 then avail := truediag4( diag4s1,diag4s2 : string); %procedure memdiag; %procedure diagp; %function diagx(diagnum:integer):boolean; * % {*17 misc. stuff } %procedure uwrt(j:integer); %procedure uwrtarg(j,i,k:integer); %procedure scrnsync; %procedure curdown; %procedure curup; %procedure homecur; %procedure retrncur; %procedure gorel( xrel,yrel : integer); %procedure gorelin( xrel,yrel : integer); % % {*16 diag stuff} %PROCEDURE qdiag(diagnum : integer; wstr:string); %procedure bigboop; %procedure bup; %procedure uhoh; %procedure yae; % % {*14 wrap stuff} %procedure wrapon; %procedure wrapoff; %procedure wraptmp( onoff : wraptype); %procedure setwrap; {*15 cursor stuff } %procedure curleft; %procedure curright; {*12 time stuff} %procedure mkstamp( var dry: datetyp); %procedure usestamp( dry:datetyp); %procedure fillclock; %procedure showtime; %procedure printime; ) ( {*13 sound stuff} %procedure beep; %procedure boop; %procedure softboop; %procedure procedure numstomaxstr(num1space,numunder,num2space:integer); %procedure strtomaxstr (undstr: string ); %procedure usemaxstr; %procedure wrstrunder(astr:string; space72nd:integer ); % %procedure enlarge; %procedure unenlarge; $  % integer; ,begin ,if not hlpinuse then ,begin ,hlpinuse := true; ,helper := false; ,helpscr := 0; , 3{help1on : >1 : ?, 2:apple-?, 3:!, 4:apple-! >5 : other use 4help2on : >6:apple 1; 7:apple-2; 8:apple-3 >9,10 : also. 4} / ,if (whichelp > 0 ) and (whichelp < 6 ) and help1on then / helpscr := heli[whichelp]; ,if (whichelp > 5 ) and (whichelp < 11) and help2on then / helpscr := heli[whichelp]; ,if (whichelp > 10 ) and (whichelp < 16 ) then 3helpscr := heli[whichelp]; 2 1 6else if ordgcha = 244 then disptime {apple t } 6else if ordgcha = 215 then mknotes {apple W } 6else if (ordgcha = 93) {closed apple ] } >and (kclosed in keyset ) >then shownum 6else charcommands := false; 6end; {charcommands} 6  * * * prkclosed in keyset ) and (ordgcha = 122) ) E{closed apple z } 9or (ordgcha = 254 ) {apple ~ } then diagp 6else if ordgcha = 209 then exit (program) {apple Q } 6else if ordgcha = 208 then page(outprint) {apple P } :showtime; :bl(2); :writeln('next screen slot will be ',nxtrec); :writeln; :writeln('nxtrecz is ',nxtrecz); :msg2; :end; {shownum} : 6 6begin 6charcommands := true; 6 6if ordgcha = 240 then scrnprnt(0,0, 79,23) {apple p} 6else if ( (nuse and (ihlp > 0 ) Fthen if not helper(ihlp) then nohelp; 6end {if in help set} 6 6else chahelp := false; 6 /end; {chahelp} / / function charcommands (ordgcha : integer):boolean; 6 6procedure shownum; :begin :boxmsg1(5,5,wide); :fillclock;5if ordgcha = 33 {!} then ihlp := 3 else ?case ordgcha of K{apl ?}191 : ihlp := 2; H{apl ! } 161 : ihlp := 4; B{apl 1..9 } B177,178,179,180,181, B182,183,184,185 : ihlp := ordgcha - 171; I{apl 0} 176 : ihlp := 15; Jend; {case} 6if not hlpihlpavail; 4ihlp := 0; 4 4if 4 in diag then Abegin Aboxmsg1(0,0,wide); Awriteln('in getcha help section '); Awriteln('ordgcha is ', ordgcha); Aboxmsg2; Aend; 4 5if ordgcha = 31 {apl h} then ihlp := 1 else {second case} *ordnumf := ordfa; &end; {ordnumf} / function chahelp ( ordgcha : integer ): boolean; 0var ihlp : integer; 0begin 0if ordgcha in [ 31, 191, 33, 161, 176..185, 189] then 4begin {help section} 4chahelp := true; 4if ordgcha = 189 then .case ordfa of {200-256} 5{apl j} 234 : ordfa := 29; 5{apl c} 227 : ordfa := 15; 5{apl z} 250 : ordfa := 30; 5{apl h} 232 : ordfa := 31; 5{apl \} 220 : ordfa := 20; 5{apl l} 236 : ordfa := 4; 5{apl n} 238 : ordfa := 17; 5end;3{apl } 136 : ordfa := 14; 3{apl } 149 : ordfa := 26; 3{apl } 139 : ordfa := 2; 3{apl } 138 : ordfa := 3; 6{apl- } 141 : ordfa := 16; 6{apl- } 155 : ordfa := 18; 7end; {case} - (if (ordfa > 199 ) then '{ 'unitread(2,alalib,1,,12); '} 'getord := ord(alalib); 'end; {getord} ' %  function ordnumf{ (ordfa:integer): integer} ; %begin '{note ordf2 removed from colcalc2} ) )if (ordfa > 99) and (ordfa <200) then /case ordfa of {100 - 199} in [13, 27, 16, 18, 32 ]; 6 6scrpg(6,scrhld); : /end; {if helpscr > 0 } /hlpinuse := false; /end; {if not hlpinuse} , (end; {helper} " " " {*2 user enter stuff}  function getord; {: integer; } 'begin 'alalib := ' '; 'getkey(alalib);a2(alibset, ordnumx, alalib); 9 5case ordnumx of @11 : begin Fclearvp; Fcurscr := glprior; Fscrpg(2,glprior); Fend; @ @10 : begin Fclearvp; Fglprior := curscr; Fcurscr := glnext; Fscrpg(2,glnext); Fend; @end;{case} > > :until ordnumx:fndsiz(ix,iy,jx,jy); ? :if glprior >0 then begin Mgotoxy(jx-ix-5, iy); Mwrite('[more]'); Malibset := alibset + [11]; Mend; ; ;if glnext > 0 then begin Ngotoxy( jx-ix-5, jy); Nwrite('[more]'); Nalibset := alibset + [10]; Nend; N N N 5getch1if helpscr > 0 then 4begin 4 4scrpg(5,scrhld); 4scrhld := -scrhld; , 4scrpg(2,helpscr); 4curscr := helpscr; 4 4helper := true; 4 2 5repeat {until esc, return, space, @or apple-esc, apple-return} :alibset := [13, 27, 32, 16, 18 ]; : ocedure getkey; { (var c1 : char); } *{12/15/83 IAC Tech Notes, page 6150.009.02 7/12/82} " $var i,status: integer; (c2 : char;  $function maskchar(c:char; position:integer):boolean; )begin )maskchar := odd(ord(c) div position ); )end; {maskchar} ( $begin{getkey} ' 'if buffinuse then ,begin ' c1 := buffcha1; ,c2 := buffcha2; ,{buffinuse := false, set later, in getcha }; ,end 'else ,begin ,status := 128; ,unitstatus(2,status,15); ,read(keyboard,c1); ,if eoln(keyboard) then c1 :(repeat {until goodcha} + +onechar := ' '; +getkey(onechar); +clrbuf; + +ordgcha := ord(onechar) ; +ordgcha := ordnumf(ordgcha); +goodcha := ordgcha in wrkset; + +if buffinuse then 1begin 1if (not goodcha ) then beep ; 1end +else if charctrue; 'buffcha1 := ch; 'buffcha2 := secondchar; 'end; {unget1key} . ( %  procedure getcha2; { (wrkset : diagset; var ordgcha : integer; Dvar onechar :char)} 1var goodcha: boolean ; ({like getcha but without help section } (begin ( = false; + (end; {getcha} ( ( "procedure unget1key; {( ch:char ); } &{should be used before any other use of getcha, in 'order for secondchar to be correct , could be 'modified to permit "ungetting" more than one character} 'begin 'buffinuse := ; + +if buffinuse then 1begin 1if (not goodcha ) then beep ; 1end ,else if chahelp(ordgcha) then goodcha := false , 5else if charcommands(ordgcha) then goodcha := false 7 ;else if (not goodcha) then beep; / +until goodcha; ( (buffinuse :(begin {**** getcha ****** } ( (repeat {until goodcha} + +onechar := ' '; +getkey(onechar); +clrbuf; +ordgcha := ord(onechar) ; +oldcha := ordgcha; +ordgcha := ordnumf(ordgcha); +goodcha := ordgcha in wrkset; + +if 220 in diag then diagcha : write(' ctrl '); :kalock : write(' alock '); :kopen : write(' open apple '); :kclosed : write(' closed apple '); :kspec : write(' special '); :end; .writeln; .read( dumchar); .scrpg(10,jdum); .end; {diagcha} 8 ( 2on is '); telltrue(help2on); .write('goodcha is '); telltrue(goodcha); .write('wrap is '); telltrue(wrap); .writeln; .for memkeyset := kshft to kspec do if memkeyset in keyset then 6case memkeyset of . kshft : write('shift '); :kctrl a in [32..126] then writeln('char is ',chr(ordgcha)) 1else writeln('char is not printable '); .writeln; .write('hlpinuse is '); telltrue(hlpinuse) ; .write('buffinuse is '); telltrue(buffinuse); .write('help1on is '); telltrue(help1on); .write('help8iold := i; 8if space > 57 then Bbegin Bwriteln; Bspace := 0; Bend; 8end; {if i in wrkset.. } 4end; {for i := ... } 4if i = 255 then writeln(' 255'); .writeln; .writeln; .writeln('ord of cha entered is ',oldcha,' became ',ordgcha); .if ordgchi in wrkset then 8begin 8if i = 255 then dodot := false ;else dodot := (i = (iold + 1) ) and J( ( i + 1 ) in wrkset); G 8if dodot then =begin =write('.'); =space := space + 1; =end 8else =begin =space := space + 4; =write(i:4); =end; diagcha; .var i, j,iold : integer; 2space : integer; 2dodot : boolean; 2dumchar : char; ( begin -boxmsg1(0,0,fullvp); -writeln('diag 220 in getcha/alib2, wrkset contains : '); - -space := 0; -iold := -2; -for i := 0 to 255 do 3begin 3if yset + [kclosed ]; 'if maskchar(c2,128) then keyset := keyset + [kspec ]; & &end; {getkey} % * * * %  procedure getcha; { (wrkset : diagset; var ordgcha : integer; Dvar onechar :char)} 1var goodcha: boolean ; 5oldcha : integer; 5 (procedure'if maskchar(c2,2) then keyset := keyset + [kshft]; 'if maskchar(c2,4) then keyset := keyset + [kctrl ]; 'if maskchar(c2,8) then keyset := keyset + [kalock ]; 'if maskchar(c2,16) then keyset := keyset + [kopen ]; 'if maskchar(c2,32) then keyset := ke= chr(13); ,read(keyboard,c2); ,secondchar := c2; {global, used by buffread } ' -{ -dropped to get correct ord -unitread(2,c1,1,,12); -unitread(2,c2,1,,12); -} ' ,status := 0; ,unitstatus(2,status, 15 ); ,end; {else.. } % 'keyset := []; ommands(ordgcha) then goodcha := false 5else if (not goodcha) then beep +else if not goodcha then beep; + +until goodcha; + (end; {getcha2} ( ( ( procedure getany; {( var ordofcha : integer; var onechar : char);} 'var tset : diagset; 'begin 'tset := [0..255]; 'getcha2(tset, ordofcha, onechar); 'end; '  procedure getany2; &begin &getkey(alalib); &end; {getany2} # function yesf; { : boolean;} %{y, n or apple esc, .apple esc returns 'y' with escyesf set to true} 'var j : integer;*if i < 0 then i := 256+i; *uwrtarg(23,i,0); *end; $ $ $ {$include .profile/hb/alib2in.text} ){*4 clear stuff } ){*5 find location stuff } ){*6 screen save/get (scrpg) } ){*7 message stuff non-box} ){*8 box message stuff } ){*9 wait stuff) # $if (scrx > (79- boxw + 1)) then scrx := (79 - boxw + 1); $ $if (scry > (23- boxht +1)) then scry := (23- boxht +1) ; $ $dfvp(scrx,scry, (scrx + boxw -1), (scry + boxht - 1) ); $ $end; {stdvps} $  procedure shiftscr{i:integer}; *begin : begin boxw := 44; boxht := 22; end; )rvp2 : begin boxw := 44; boxht := 20; end; )lvp : begin boxw := 36; boxht := 22; end; )lvp2 : begin boxw := 36; boxht := 20; end; )fullvp: begin boxw := 79; boxht := 24; end; ) )end; {case} scry := 0; end; 4end; {of case} - $case boxsize of )norm : begin boxw := 44; boxht := 10; end; )wide : begin boxw := 66; boxht := 10; end; )high : begin boxw := 44; boxht := 22; end; )big : begin boxw := 66; boxht := 22; end; )rvp $ $if boxsize > big then +case boxsize of 4rvp : begin scrx := 36; scry := 0; end; 4rvp2: begin scrx := 36; scry := 2; end; 4lvp : begin scrx := 0; scry := 0; end; 4lvp2: begin scrx := 0; scry := 2; end; 0otherwise begin scrx := 0; rocedure stdvps; {( boxsize : boxtype);} 2{ assumes cursor in upper left corner screen position x, y} 2{ except with rvp .. fullvp - which select their own} 3 $var i, boxw, boxht, scrx, scry : integer; $begin $ $resetvp; $fndcurpos(scrx, scry); (ulx+1,uly+1,lrx-1, lry-1); )normcha; )clearvp; ) )dfvp(ulx+2,uly+2, lrx-2,lry-1); ) )boxon := true; $end; {boxvp} procedure restorvp; begin uwrt(4); end;  procedure vptop; begin uwrt(2); end; procedure vpbot; begin uwrt(3); end; ( ( ( (  p,lry); vpbot; )gotoxy(ulx,uly); vptop; % gotoxy(0,0) )end; {end of dfvp} #   procedure resetvp; begin uwrt(1); end; procedure boxvp; $var ulx, uly, lrx,lry : integer; $begin )fndsiz(ulx,uly, lrx, lry); ) )invercha; )clearvp; ) )dfvp'if ordofcha in [16,13, 18,27] then pick1ofn := 0 ,else pick1ofn := ordofcha - 48; 'end; {pick1ofn} ' " ' {*3 vp (viewport) stuff }   procedure dfvp {ulx,uly,lrx,lry : integer}; {secton to define a viewport} %begin )resetvp; )gotoxy(lrx: integer; } '{returns "0" if no choice } 'var ordofcha : integer; ' 'begin 'if numchoices > 9 then numchoices := 9; 'if numchoices < 1 then numchoices := 1; ' 'getcha([16,13, 18,27, 49..(48 + numchoices)], ordofcha, alalib); ' rue; 'ival:= 0; 'readln(astr); 'rnum := strtonum(astr,0); 'if (rnum <= max) and (rnum >= min) ) and (abs(rnum) < maxint) then ival := round(rnum) +else igetrng := false; 'end; {igetrng} '  function pick1ofn; {( numchoices : integer [1 to 9 ] )alibset := [ 32, 120 ]; /getcha2(alibset, j, alalib); /writeln; /if alalib = 'x' then exit(program); ,end; {alphago} , function igetrng; { ( max, min : real; var ival:integer):boolean; } & 'var astr :string; +rnum : real; 'begin 'igetrng := t1else if alalib = 'n' then write ('no') 6else begin ;escyesf := true; ;write('esc'); ;end; *hlpinuse := false; &end; {yesf} " ' ' procedure alphago; %var j: integer; ,begin /writeln; /writeln('type space to continue, "x" to exit :'); / +xloc, yloc : integer; 'begin *fndcurpos(xloc,yloc); *escyesf := false; *hlpinuse := true; *alibset := [ 110, 121, 18 ]; *getcha(alibset, j, alalib); *yesf := (j <> 110); *gotoxy(xloc, yloc); * *if (alalib = 'y') then write ('yes') } ){*10 utility stuff - non print } ){*11 utility stuff - printer }  $  {*12 time stuff} procedure mkstamp; {( var dry: datetyp);} $begin $dry[1] := (clkyr-1900)*100 + clkmos; $dry[2] := (clkday*100) + clkhr; $dry[3] := clkmin; $end; {mktime} $ procedure usestamp; {( dry:datetyp); } #begin #clkyr := round(dry[1]/100.0)+1900; #clkmos := dry[1]- (clkyr-1900) * 100; #clkday := round(dry[2]/100.0); #clkhr := dry[2] - clkday*100; #clkmin := dry[3]; #end; {usestamp} $ $  procedureprocedure diag4; {(diag4s1,diag4s2 : string);} (begin (if 4 in diag then qboxmsg(1,false,diag4s1,diag4s2); (end;{diag4} ( procedure memdiag; (begin (if 5 in diag then +begin +msg1; +writeln('memory available in bytes : ',(2*memavail) ); +msg2; (diagnum : integer; wstr:string); } *BEGIN *if diagnum in diag then 0begin 0boxmsg1(0,10,wide); 0writeln(' Switch # : ',diagnum); 0writeln; 0writeln(wstr); 0writeln; 0fillclock; 0showtime; 0msg2; 0end; *END;{qdiag} * * % ; {gorel}  procedure gorelin; {( xrel,yrel : integer);} $var i,xloc,yloc : integer; $begin $if yrel > 0 then for i := 1 to yrel do writeln; $if xrel > 0 then for i := 1 to xrel do curright; $end; {gorelin} ! {*16 diag stuff } PROCEDURE qdiag; {urup; begin uwrt(11); end; procedure homecur; begin uwrt(12); end; procedure retrncur; begin uwrt(13); end; procedure gorel; {( xrel,yrel : integer);} $var i,xloc,yloc : integer; $begin $fndcurpos(xloc,yloc); $gotoxy( (xloc +xrel), (yloc+yrel)); $end&write('Wrap? : yes = on, no = off : '); &if yesf then wrapon else wrapoff; &writeln; &end; {*15 cursor stuff } ( procedure curleft; begin uwrt(8); end; procedure curright; begin uwrt(9); end; procedure curdown; begin uwrt(10); end; procedure cen if wrap2 then wrapon else wrapoff; +end; {end} + &end; {wraptmp} & procedure setwrap; $begin %if wrap then writeln('screen wrap is ON') +else writeln('screen wrap is OFF'); &writeln(' normal is OFF '); aprec.gint,2,,12); %wrap := false; %end; ) procedure wraptmp; {( onoff : wraptype); } ${(on, off or resetw ) } &begin &if onoff <> resetw then wrap2 := wrap; &case onoff of +on : wrapon; +off : wrapoff; +resetw : if (wrap2 <> wrap) 4th % %begin %wraprec.gint[0] := 21; %wraprec.galph[1] := '='; %unitwrite(1,wraprec.gint,2,,12); %wrap := true; %end;  procedure wrapoff; %{turns off both wrap and scroll } %begin %wraprec.gint[0] := 21; %wraprec.galph[1] := '1'; %unitwrite(1,wr$sound(20, 16, 20); $end;{uhoh} $ procedure yae; $begin $sound(20,12,20); $sound(0, 2, 10); $sound(40,20,40); $end; "  {*14 wrap stuff } % procedure wrapon; {initialized off} "{ atomatic wrap > vp if #writeln = vp width, turns on scroll }6,30); %end; % procedure softboop; %begin %sound(35,4,20); %end; % procedure bigboop; %begin %sound(40,10,45); %end; % procedure bup; $begin $sound(20, 2, 55); $end;{bup} $ procedure uhoh; $begin $sound(30, 8, 30); $sound(0, 2, 10); rintime}  procedure disptime; {display time - used with apple t } %begin %fillclock; %msg1; %gotoxy(3,6); %showtime; %msg2; %end; {disptime} $ 2 {*13 sound stuff } procedure beep; begin uwrt(7); end;  procedure boop; %begin %sound(40,-1900):2) *else if (clkyr-2000 ) < 10 then 2begin 2write(outprint,'0',(clkyr-2000)) 2end *else write(outprint,(clkyr-2000):2); &write(outprint,' ',clkhr:2,':'); &if clkmin > 9 then write(outprint,clkmin) else write(outprint,'0',clkmin); &end; {p*else write(clkyr-1900); &write(' ',clkhr,':'); &if clkmin > 9 then write(clkmin) else write('0',clkmin); &end; {showtime}  procedure printime; &begin &write( outprint,clkmos:3,'/',clkday:2,'/'); &if (clkyr-1900) < 100 then write(outprint,(clkyr fillclock; &begin &clockinfo (clkyr, clkmos, clkday , clkdayofwk, clkhr, 1clkmin, clksec, clkthou); &end;{fillclock} ! procedure showtime; &begin &write(clkmos,'/',clkday,'/'); &if (clkyr-1900) < 10 then write('0',(clkyr-1900) ) +end; 'end;{memdiag} % procedure diagp; # #{ 1 for scrpg , out to printer &2 for ? &3 for write out years and values, no stored screens &4 for most detail *and calcmod selected, parm and str values &5 for detail about memory available &6 ucalc &8 leadv # &25 - special - sets wrap (yes or no ) #} # #var j, j2,iscrn, itempscrn, ipos : integer; # # #procedure showset; # begin 'clearvp; 'gotoxy(0,0); 'writeln('These "switches" are turned on : : '); 'writeln; 'ipos!if 4 in diag then qboxmsg(1,false,'made it to end of init section ', ;'of alib'); !emphon := false; cndnseon := false; enlargeon := false; !buffinuse := false; help1on := false; help2on := false; hlpinuse := false; !vspc72nd := -1; linesinpagf not (alalib = 'c' ) then exit(program); )end else 'begin '{match makesr5} 'nxtrec := scrfil^.startrec; {global variable, next record in scr file} 'nxtrecz := nxtrec; 'stackry[0] := 1; {next available slot in stackry} 'end; !fillclock; eln(scrpth,' is bad, ioerror is ' , jiolib, 1' WRITE THIS DOWN!!! '); )writeln; )if jiolib = 10 then writeln(scrpth,', this file was not found '); )writeln; )writeln('press "c" to continue ( mkscr5 can create this file) '); )beep; )getany2; )i scrpth := '.profile/hb/fxdscrns.data'; !{$iocheck-} reset(scrfil, scrpth); jiolib := ioresult; if jiolib = 12 Then 1begin 1close(scrfil,lock); 1reset(scrfil,scrpth); 1jiolib := ioresult; 1end; "{$iocheck+} " if jiolib <> 0 then )begin )writ escyesf := false; boxon := false; waitb := false; ! !jdum := 0; for rf1 := 1 to 20 do heli[rf1] := 0; !wrapon; normcha;  req.channel := 0; req.reserved := 0; {needed for screen commands } rewrite(outprint,'.printer'); ! {section re scrpg } scrnsync; begin uwrt(22); end; {1/60th sec} % &  procedure abspos{i,k:integer}; begin uwrtarg(26,i,k);end; %{seems to do exactly same thing as gotoxy} &  begin {initialization} " diag := []; !help1on := false; help2on := false; 1,,12); ,end; { uwrt} '  procedure uwrtarg{j,i,k:integer}; (var i2 : integer; (begin % for i2 := 1 to 20 do g[i2] := 0; (g[0] := j; (g[1] := i; (g[2] := k; (unitwrite(1,g,3,,12); % for i2 := 1 to 20 do g[i2] := 0; (end; { uwrt} procedure 0diagx := true; 0dfvp(0,0,79,23); 0boxmsgvp; 0write ('Switch # ',diagnum, ', '); 0showtime; 0writeln; 0end *else diagx := false; *end; {diagx} + & & {*17 misc. stuff } & procedure uwrt{j:integer}; ,begin , ,g[0] := j; ,unitwrite(1,g,1if (206 in diag ) then setlnfeed(9); {8/inch} 1end; ' (iscrn := -abs(iscrn); (scrpg(6,iscrn); (scrpg(16,itempscrn); {2/11/84 - reset pointer } (end; {diagp} # function diagx; {(diagnum:integer):boolean;} *begin *if diagnum in diag then 0begin := typeptr1; (if (156 in diag ) then ptrtype := epson; (if ptrtype = epson ,then begin 1if (203 in diag ) then condense; 1if (204 in diag ) then uncondense; 1if (205 in diag ) then setlnfeed(12);{6/inch} .j2 := abs(j); .if j <> 0 then 4 4begin 4 4{wrap} 4if j2 = 25 then setwrap; 4 4if j < 0 then diag := diag - [j2]; 4if j > 0 then diag := diag + [j2]; 4 4end; {<> 0} 4 /end; {valid number} ( (until j2 = 0; ( (if (155 in diag ) then ptrtype -1 to -255 to remove a number '); 'writeln; 'writeln(' 0 to exit '); ' 'gotoxy(40,17); ' 'if not igetrng(255,-255,j ) then .begin .beep ; .writeln; .writeln('not a valid number '); .delay(2); .end 'else .begin #scrpg(15,itempscrn); {2/11/84- put current pointer to file} #scrpg(5,iscrn); #dfvp(0,0,79,23); #boxvp; # # #repeat {until j = 0} 'showset; ' 'gotoxy(0,13); 'writeln(' enter 1 to 255 to add a number '); 'writeln; 'writeln(' := 0; 'for j := 1 to 255 do +if j in diag then 3begin 3ipos := ipos + 4; 3if ipos > 64 then @begin @writeln; @ipos := 4; @end; 3write(j:4); 3end; 'writeln; 'end; {showset} ' #begin {******* diagp ******** } e := -1; vprefskip := -1; ! !{pressing "D" while programs are initially loading will call ,up the switch menu } !if keypress then -begin -read(alalib); -clrbuf; -if alalib = 'D' then diagp; -end; !end.{alib2} ); %procedure teltru2( vbooly : boolean); ! %procedure bl( nline : integer); %procedure wrsp(nspace : integer); % %procedure delay(j:integer); %procedure keywait; % %procedure readcha(var scrncha:char ); [from screen] %function rlim(val,max,mie waiter(msgw :shortstr); %procedure waitscr1(msgw:shortstr); %procedure waitoff; % [*10 utility stuff - non print ] %procedure normcha; %procedure invercha; % %procedure cutstr(maxl:integer; var str80:string); % %procedure telltrue(test:boolean%procedure boxmsg1( scrx, scry : integer; boxsize : boxtype); %procedure boxmsgvp; %procedure boxrl(boxrlsz : boxtype ); %procedure boxmsg2; %procedure qboxmsg( iloc : integer; beeper:boolean; msgstr1, msgstr2 : string); % [*9 wait stuff ] %procedurg1; %procedure msg2; %procedure msg1b(ulx,uly,lrx,lry : integer); %procedure bmsg(msg :string; rec : integer); %procedure qmsgb( msgstr1, msgstr2 : string); % % [*8 box message stuff ] integer ); %procedure fndsiz( var ulx, uly, lrx, lry : integer); % % [*6 screen save/recall stuff ] %function scrpush( recn :integer):integer; %procedure scrpg( pg : integer; var recscr2x : integer); % % [*7 message stuff - non box ] %procedure msnter  [*4 clear stuff ] %procedure clearvp; %procedure clflscr; %procedure clrbuf; %procedure clrbuforce; % %procedure clrtoend; %procedure clearln; %procedure clrendln; % % [*5 find location stuff ] %procedure fndcurpos(var xpos,ypos :{ /p/p1/com/alib2in.text 3/28/84 ! includes: )*4 clear stuff )*5 find location stuff )*6 screen save/get (scrpg) )*7 message stuff non-box )*8 box message stuff )*9 wait stuff )*10 utility stuff - non print )*11 utility stuff - pri B A C D PPRSO^n : real ) : boolean; %function ilim(val,max,min : integer): boolean; % %function rtoitr(rval:real; var ival:integer ):boolean; %function rtoiro(rval: real; var ival:integer):boolean; % %procedure addi(var ival:integer; addval:integer); %procedure addr(var rval:real; addval:real ); % % %procedure fixstr( var wrkstr : string;  0 ) and (i < nxtrec) then ry := lry + uly; #dfvp(ulx,uly,lrx,lry); #gotoxy(ix,iy); #end; {fndsiz} ' $ $ $ $ {*6 screen save/get (scrpg) } function scrpush; {( recn :integer):integer; } ({stackry[0] contains subsript of next unused stackry slot} ({used to store slot numbpos := posary[2]; )end;{fndcurpos}  " procedure fndsiz; { var ulx, uly, lrx, lry : integer} "var ix,iy :integer; "begin #fndcurpos(ix,iy); #gotoxy(79,23); #fndcurpos(lrx,lry); #homecur; #resetvp; #fndcurpos(ulx,uly); #lrx := lrx + ulx; #l{*5 find location stuff } procedure fndcurpos{var xpos,ypos :integer }; &type numbyte = 0..255; &var posary : packed array[1..2] of numbyte; &begin )req.request_num := 16; )req.stat_or_ctrl := 0; )unitstatus(1,posary,req); )xpos := posary[1]; )ygin &req.request_num := 5; &req.stat_or_ctrl := 1; &unitstatus(1, i,req); &end; {clrbuforce}  procedure clrtoend; begin uwrt(29);end; procedure clearln; begin uwrt(30);end; procedure clrendln; begin uwrt(31);end; % %  79,23); 'clearvp; 'end; / procedure clrbuf; &var i : integer; &begin )if not (53 in diag ) then 0begin 0req.request_num := 5; 0req.stat_or_ctrl := 1; 0unitstatus(1, i,req); 0end; &end; {clrbuf}  procedure clrbuforce; &var i : integer; &bedstr: string ); %procedure usemaxstr; %procedure wrstrunder(astr:string; space72nd:integer ); % %procedure enlarge; %procedure unenlarge; % % } {*4 clear stuff } procedure clearvp; begin uwrt(28);end;  procedure clflscr; 'begin 'dfvp(0,0,%procedure setunderon( old72nd:integer); %procedure desetunderon; %procedure underline( nspace:integer); %procedure wrstrunder(astr:string; space72nd:integer ); %procedure numstomaxstr(num1space,numunder,num2space:integer); %procedure strtomaxstr (untprefskip( lines : integer ); %procedure setvlines( lines : integer ); %procedure condense; %procedure uncondense; %procedure emphasize; %procedure demphasize; %procedure setlnfeed( space72nd :integer); % edure scrnprnt(hb,vb,he,ve : integer); %[procedure printime;] %procedure prfixstr(targlength : integer; instr : string); [print] %procedure pryesno( boolin : boolean); %procedure disptime; %procedure fillspace( used, full : integer); %procedure se; %procedure wrfixstr(targlength : integer; instr : string); [write] %procedure wryesno( boolin : boolean); % %procedure mknotes; % % [*11 utility stuff - printer ] % %procedure blp(nlines : integer); %procedure prsp( nspace : integer ); %procpreset vp $15 - store current scrfil 16 - fill current scrfil from rescr2x )on disk ) )[15 and 16 do not relate to current screen, rather they (work directly with the scrfil record pointer ] ( } @ % *var xp,yp, xp2,yp2, recnum, ipop : integer; 3full, saved, puts, gets: boolean; #procedure scrdiag; # (begin (writeln(outprint); (writeln(outprint,'Switch 1 in alibin '); (writeln(outprint,' in scrpg pg = ',pg,' ipop = ',ipop ); (writel, 8scrfil^.lry); 0 0if pg = 4 then begin msg1; :writeln(' option 4 in scrpg not available '); :msg2; end; : : 0req.stat_or_ctrl := 1; 0req.request_num := 18; 0unitstatus(1,scrfil^.fulscrn,req); 0 0if full then dfvp(scrfil^.ulx, scrfil^.uly, et(scrfil); 9if 1 in diag then scrdiag; 9end; 0xp := scrfil^.xpos; 0yp := scrfil^.ypos; 0glprior := scrfil^.prior; 0glnext := scrfil^.next; 0 0 0if pg <> 11 then 8if full then dfvp(0,0, 79,23) else 8dfvp(scrfil^.ulx, scrfil^.uly, scrfil^.lrx3if full then dfvp(scrfil^.ulx, scrfil^.uly, scrfil^.lrx, Fscrfil^.lry); {added 2/13/84} 8 /end { puts section} + + +{get section} +else if gets then 0begin 0if saved then 9begin 9recscr2x := scrpush(recscr2x); 9seek(scrfil, recscr2x); 9g to clean up arrays '); 5writeln(' recnum = ',recnum); 5writeln(' pg = ',pg); 5writeln('nxtrecz = ',nxtrecz); 5writeln('nxtrec = ',nxtrec); 5msg2; 5end; {if recnum > 500} 3if 1 in diag then scrdiag; 3end; {if saved} 3 ; /if saved then 3begin 3if (pg = 3 ) then recnum := recscr2x Aelse recnum := scrpop; 3recscr2x := recnum; 3seek(scrfil, recnum); 3put(scrfil); 3if ( recnum > 100 ) then 5begin 5msg1; 5writeln('WARNING - please save this asset '); 5writeln(' from mkscrn5} /begin /scrfil^.xpos := xp2; /scrfil^.ypos := yp2; /fndsiz(scrfil^.ulx, scrfil^.uly, scrfil^.lrx, 6scrfil^.lry); / /req.stat_or_ctrl := 0; /req.request_num := 18; / /if full then dfvp(0,0, 79,23); /unitstatus(1,scrfil^.fulscrn,req)'if pg = 0 then begin {release this slot, no other action} 6recscr2x := 0 - (abs(recscr2x)); 6recscr2x := scrpush(recscr2x); 6if 1 in diag then scrdiag; 6end; 6 ' '{section to put screen in a file } (if puts then /{implicit scrfil^prior, next := pg in [ 5, 6, 9, 10 ]; 'saved := pg in [ 1, 2, 3, 4, 5, 6, 11 ]; 'puts := pg in [1, 3, 5, 7, 9 ]; 'gets := pg in [ 2, 6, 8, 10, 11 ]; 2 2 'fndcurpos(xp2,yp2); ' ecscr2x); 1get(scrfil); 1end; *end; {pointerstuff} ' 3 #begin {********************** main part of scrpg } ' ' "if pg in [15,16] then pointerstuff else 'begin 'recnum := -888; 'ipop := -999; 6{ 1 2 3 4 5 6 7 8 9 10 11 } 'full in 1recnum := scrpop; {gets next available slot # } 1recscr2x := recnum; 1seek(scrfil,recnum); 1put(scrfil); 1end +else if pg = 16 then 1{get from file, put in pointer} 1begin 1recscr2x := scrpush(recscr2x); {frees slot if minus } 1seek(scrfil,r.nxtrec := nxtrec + 1; .if 10 in diag then 0begin 0msg1; 0writeln('in scrpop - new screen record # ', (nxtrec-1)); 0msg2; 0end; ,end; +end;{scrpop} ' procedure pointerstuff; +begin + +if pg = 15 then 1{put current pointer out to file } 1beg1if 10 in diag then 4begin 4msg1; 4writeln( 4'in scrpop- ipop,nxtrec :',ipop:5, nxtrec:5); 4writeln('nxtrec used due to bad ipop '); 4msg2; 4end; 1scrpop := nxtrec; 1nxtrec := nxtrec +1 ; 1end; .end +else .begin .scrpop := nxtrec; tprint,' recscr2x = ', recscr2x); (end; {scrdiag} + $ $ $function scrpop: integer; ( +begin +if stackry[0] > 1 then .begin .ipop := stackry[ (stackry[0]-1) ] ; .stackry[0] := stackry[0]-1; .if ipop < nxtrec then scrpop := ipop 1else 1begin n(outprint,' nxtrec = ',nxtrec,' nxtrecz = ',nxtrecz); (writeln(outprint,' recnum = ', recnum,' stackry[0] = ',stackry[0]); (if stackry[0] > 1 then writeln(outprint, 1'stackry[',(stackry[0]-1),'] = ',stackry[ (stackry[0]-1) ] ); (writeln(ou>scrfil^.lrx,scrfil^.lry); 0gotoxy(xp,yp); 0end { gets } 0 0else {not puts, not gets} if pg <> 0 then 5begin 5writeln('pg = ', pg, <' (unacceptable) in call to scrpg'); 5alphago; 5end; 'end; {if pointer stuff... else begin } "end; {scrpg}   {*7 message stuff non-box} procedure msg1; "begin "msg1b(15,2,79,23); "end;  procedure msg2; "var j, ulx,uly,lrx,lry : integer; "begin "fndsiz(ulx,uly,lrx,lry); "gotoxy( (lrx-ulx-19), (lry-uly-1) ); "write(' to cont; var str80:string}; &begin &if (length(str80) > maxl) then str80 := copy(str80,1,maxl); &end; {cutstr} " "  procedure telltrue{test:boolean}; 'begin 'if test then writeln('true') else writeln('false'); 'end; {telltrue} "  procedure teltru2; {&writeln('[ ',msgw,' ]'); &end;{waitscr1} ' {*10 utility stuff - non print }   procedure normcha; begin 3uwrt(17); 3inveron := false; 3end; procedure invercha; begin 4uwrt(18); 4inveron := true; 4end; $   procedure cutstr{maxl:integer&end;{waiter} & procedure waitoff; &begin &waitb := false; &jdum := -abs(jdum); &scrpg(10,jdum); &end; {waitoff} & % procedure waitscr1; {(msgw :shortstr);} &begin &scrpg(9,jdum); &jdum := -jdum; &dfvp( 36,19,79,23); &clearvp; &gotoxy(1,2); " " {*9 wait stuff } % procedure waiter; {(msgw :shortstr);} &begin & &if not waitb then -begin -scrpg(9,jdum); -jdum := -jdum; -waitb := true; -end; - &dfvp( 32,19,79,23); &clearvp; &gotoxy(8,2); &writeln('[ ',msgw,' ]'); ; iy := 0; end; (3 : begin ix := 0; iy := 14;end; (4 : begin ix :=36; iy := 14;end; (end; {case} & &boxmsg1( ix, iy, norm); & &gotoxy(0,1); &writeln(msgstr1); &gotoxy(0,3); &writeln(msgstr2); & &if beeper then beep; &boxmsg2; &end; {qboxmsg} m); "boxon := false; "end; {boxmsg2} " procedure qboxmsg; {( iloc : integer; beeper : boolean; 5msgstr1, msgstr2 : string);} &var ix, iy : integer; &begin &ix := 19; &iy := 5; &case iloc of (1 : begin ix := 0; iy := 0; end; (2 : begin ix :=36procedure boxmsg2; "var j, ulx,uly,lrx,lry : integer; "begin "fndsiz(ulx,uly,lrx,lry); "gotoxy( (lrx-ulx-22), (lry-uly) ); "write(' to continue : '); " "alibset := [ 32 ]; "getcha2(alibset, j, alalib); " "jdum := -abs(jdum); "scrpg(10,jdut needed } 'boxvp; 'end;{boxmsgvp} ' ! !procedure boxrl; {(boxrlsz : boxtype );} '{l : x= 0; r x=36, 1:y=0, 2:y=2} 'var scrx, scry : integer; 'begin 'scrpg(9,jdum); 'jdum := -jdum; 'stdvps(boxrlsz); 'boxvp; 'end; {boxrl} - " vps(boxsize); 'boxvp; 'end;{boxmsg1} ' '  procedure boxmsgvp; 'var rf1, rf2, rf3, rf4 : integer; 'begin 'fndsiz(rf1,rf2,rf3,rf4); {probably not needed} 'scrpg(9,jdum); 'jdum := -jdum; {probalbly not needed } 'dfvp(rf1,rf2,rf3,rf4);{probalbly no boxmsg1; {( scrx, scry : integer; boxsize : boxtype);} 2 3{scrx or scry > possible will put box at edge of screen} 3{ boxsize rvp..fullvp select their own scrx and scry} 'begin 'scrpg(9,jdum); 'jdum := -jdum; 'resetvp; 'gotoxy(scrx,scry); 'std)scrpg(2,iscr2); )scrpg(2,iscr1); )end;{bmsg} )   procedure qmsgb; {( msgstr1, msgstr2 : string); } $begin $beep; $msg1; $writeln(msgstr1); $writeln; $writeln(msgstr2); $msg2; $end; {qmsgb} $ " "   {*8 box messages } $ $ procedure: integer; ) )begin )iscr1 := 0; )iscr2 := 0; )scrpg(1,iscr1); )iscr1 := -iscr1; )dfvp(0,0,79,5); )scrpg(1,iscr2); )iscr2 := iscr2; )clearvp; )writeln(msg,rec); )writeln; )writeln('any key to continue '); )getany(rf1,alalib); j : integer; "begin "scrpg(9,jdum); "jdum := -jdum; "dfvp(ulx,uly,lrx,lry); "clearvp; "gotoxy(0,0); "for j := 1 to (lrx-ulx) do write('_'); "gotoxy(0,2); "end; {msg1b} " " "  procedure bmsg; {(msg :string; rec : integer)} (var iscr1, iscr2 inue'); "gotoxy(0, (lry-uly) ); "for j := 1 to (lrx-ulx) do write('_'); "curleft; ' "alibset := [ 32 ]; "getcha2(alibset, j, alalib); "jdum := -abs(jdum); "scrpg(10,jdum); "end;{msg2} "  procedure msg1b; { (ulx,uly,lrx,lry : integer); } "var ( vbooly : boolean);} begin #if vbooly then write('true ') else write ('false '); #end; {teltru2} !  procedure bl; {( nline : integer); } #var i :integer; #begin #if nline > 0 then for i := 1 to nline do writeln; #end; {bl} # # procedure wrsp; {(nspace : integer);} #var i : integer; #begin #if (nspace > 80 ) then nspace := 80; #while (nspace >= 10 ) do *begin *write(' '); *nspace := nspace - 10; *end; {while} #if nspace >= 5 then *begin *write(' '); *nspno}  $ {*11 utility stuff - printer } "procedure blp; {(nlines : integer); } (var i : integer; (begin (if (nlines > 0 ) then for i := 1 to nlines do writeln(outprint); (end; {blp} " " "procedure prsp; {( nspace : integer );} ,var i : integeg); } {write} %{see prfixstr also} %begin %fixstr(instr, ,targlength, ,true, ,true, ,true); %write(instr); %end; {wrfixstr} % procedure wryesno; {( boolin : boolean);} *begin *if boolin then write('yes ') else 8write('no '); *end; {wryesprocedure fullstr; {(var instr:string; targlength : integer); } %{remove leading blanks, but fill trailing blanks to full size } &begin &fixstr(instr, targlength, false,true,true); &end; * % procedure wrfixstr; {(targlength : integer; instr : strintr),1); % %{fill trailing blanks if appropriate } %if filltrblnk and (length(wrkstr) < targlength ) then +while(length(wrkstr) < targlength ) do wrkstr := concat(wrkstr,' '); %end; {fixstr} % + (wrkstr[length(wrkstr)] = ' ') then Adelete(wrkstr,length(wrkstr),1) 8else done := true; 8end /else done := true; /until done; 3 *end; {if length > 0 } * %{reduce size if needed } %while length(wrkstr) > targlength do delete(wrkstr,length(wrks> 0 ) then 8begin 8if (wrkstr[1] = ' ') then delete(wrkstr,1,1) ;else done := true; 8end /else done := true; /until done; * *{remove trailing blanks } *done := false; *if not trblnkok then /repeat /if (length(wrkstr) > 0 ) then 8begin 8if Aif the targlength is not set <= the Adefined maximum length of the input string } 'var done : boolean; 'begin 'done := false; ' 'if length(wrkstr) > 0 then *begin * *{remove leading blanks } *if not ldblnkok then /repeat /if (length(wrkstr) r wrkstr : string; .targlength : integer; .ldblnkok : boolean; .trblnkok : boolean; .filltrblnk : boolean );} . '{$varstring-} {warning : this permits inappropriately changing Avalues beyond the end of the input string, (end; {rtoiro} # procedure addi; {(var ival:integer; addval:integer); } )begin )ival := ival + addval; )end; {addi}  procedure addr; {(var rval:real; addval:real );} )begin )rval := rval + addval; )end; {addr} # procedure fixstr; {( vainteger, round, true if in range } function rtoiro; {(rval: real; var ival:integer):boolean;} (begin (if rlim(rval, maxint, (-maxint ) ) then -begin -rtoiro := true; -ival := round(rval); -end )else -begin -rtoiro := false; -ival := 0; -end; function rtoitr; {(rval:real; var ival:integer ):boolean;} (begin (if rlim(rval, maxint, (-maxint ) ) then -begin -rtoitr := true; -ival := trunc(rval); -end )else -begin -rtoitr := false; -ival := 0; -end; (end; {rtoitr} - ( #{real to ax ) and (val >= min ); &end; {rlim}  function ilim; {(val,max,min : integer): boolean; } &begin &ilim := (val <= max ) and (val >= min ); &end; {ilim}  #{real to integer, truncate, true if in range } press; %end; {keywait} procedure readcha{var scrncha:char }; {from screen} &begin )req.request_num := 17; )req.stat_or_ctrl := 0; )unitstatus(1,scrncha,req) &end; $ function rlim; {(val,max,min : real ) : boolean; } &begin &rlim := (val <= mace := nspace - 5; *end; {if} #if nspace > 0 then for i := 1 to nspace do write(' '); #end; {wrsp} # #  procedure delay{j:integer}; var k :integer; begin j := j*60; *for k := 1 to j do scrnsync; end;  procedure keywait; %begin %repeat until keyr; ,begin ,if nspace > 0 then for i := 1 to nspace do write(outprint,' '); ,end;{prsp} " "procedure scrnprnt{hb,vb,he,ve : integer }; +{procedure to print screen} # # var astr,bstr : string[80]; $scrncha : char; $i,j,k,xpos,ypos : integer; $inchs,done : boolean; # begin #fndcurpos(xpos,ypos); #resetvp; #for j := hb to he do write(outprint,'|'); #writeln(outprint); # #bstr := 'x'; #for j := vb to ve do )begin )astr := ''; )gotoxy(he,j); )k := 0; )ie = epson ) and ( not (154 in diag ) ) then /begin /noshiftlk := cndnseon; /uncondense; /emphon := true; /write(outprint, /chr(27 + 128 ), {escape} /chr(69 + 128) ); /end; +end; {emphasize}  procedure demphasize; +begin +if ptrtype = epson the+begin +if ptrtype = epson then /begin /if diagx(42) then 6begin 6writeln('uncondense, done in alib '); 6msg2; 6end; /cndnseon := false; /write(outprint, chr(18 + 128) ); + end; +end; {uncondense} + procedure emphasize; +begin +if (ptrtyp procedure condense; +begin +if ptrtype = epson then /begin /if diagx(42) then 6begin 6writeln('condense , turned on in alib '); 6msg2; 6end; /cndnseon := true; /write(outprint,chr(15 + 128) ); /end; +end; {condense} + procedure uncondense; r(lines + 128) ); 5linesinpage := lines; /if diagx(42) then 5begin 5writeln('setvlines in alib, '); 5writeln('done with chr(27), chr(67) '); 5writeln('lines /page set at ',lines); 5msg2; 5end; 5 /end; / *end; {setvlines} * * * ip} ) ) procedure setvlines; {( lines : integer ); } *begin * *if ptrtype = epson then /begin /if (lines < 1 ) or (lines > 127 ) then lines := 88; /write(outprint, 5chr(27 + 128), {escape} 5chr(67 + 128), {"C" control vertical form size } 5ch2write(outprint, 2chr(27 + 128), {escape} 2chr(78 + 128), {"N"} 2chr(lines + 128) ) ; 2end; /vprefskip := lines; /if diagx(42) then 3begin 3writeln('in alib2, setprefskip '); 3writeln(' lines = ',lines ); 3msg2; 3end; /end; *end; {setprefskprocedure setprefskip; {( lines : integer ); } *begin *if ptrtype = epson then /begin /if not ilim(lines,127,1) then lines := 0; /if lines = 0 then 3begin 3write(outprint, 3chr(27 + 128), {escape} 3chr(79 + 128) ); {"O"} 3end /else 2begin  *end; {pryesno} *  procedure fillspace; {( used, full : integer); } /var i : integer; /begin /if used <= full then 2begin 2for i := 1 to (full - used ) do write(outprint,' '); 2end; /end; {fillspace} % $ ) ee wrfixstr also} %begin %fixstr(instr, ,targlength, ,true, ,true, ,true); %write(outprint,instr); %end; {prfixstr} %  procedure pryesno; {( boolin : boolean);} *begin *if boolin then write(outprint,' yes ') else 8write(outprint, ' no ');th = 0 } $ readln(wrkstr); *writeln(outprint,wrkstr); *until length(wrkstr) = 0; * $scrpg(10,recscr); $iscrn := -abs(iscrn); $scrpg(16,iscrn); $end; {mknotes} " $ ? procedure prfixstr; {(targlength : integer; instr : string); } {print} %{s$var wrkstr:string; (recscr,iscrn : integer; $begin $scrpg(15,iscrn); $scrpg(9,recscr); $dfvp(0,0,79,23); $clearvp; $writeln('Enter Lines to be written to printer, '); $writeln(' enter empty line to exit '); $writeln; $ $repeat {until lenghen done := true; /until done; 2 / )writeln(outprint,astr); )end; {for j} ) for j := hb to he do write(outprint,'|'); for j := 1 to 3 do writeln(outprint); !  restorvp; gotoxy(xpos,ypos);  end; {scrnprnt} procedure mknotes; {apple W} str[1] := '@'; 3 3astr := concat(bstr,astr); 3inchs := true; 3end; /end; {for i} / 2 )done := false; )if length(astr) > 0 then /repeat /if ( astr[length(astr)] = ' ' ) then delete(astr,length(astr),1) 3else done := true; /if length(astr) = 0 tnchs := false; )for i := hb to he do /begin /k := k + 1; /readcha(scrncha); /if i < he then curleft; /if inchs or (scrncha <> ' ') then 3begin 3bstr[1] := scrncha; 3 3 {handle apple symbol, replace with '@' } 3 3if ord(bstr[1]) = 127 then bn /begin /emphon := false; /if noshiftlk then 7begin 7condense; 7noshiftlk := false; 7end; /write(outprint, /chr(27 + 128), {escape} /chr(70 + 128) ); + end; +end; {demphasize} procedure setlnfeed; { ( space72nd :integer); } ({argument is # of 1/72 nds of inch per line advance, *12 for 6 lines/inch, 9 for 8 lines per inch)} * *begin *if ptrtype = epson then 0begin 0if diagx(42) then 9begin 9writeln(' inside setlnfeed '); 9writeln('space72nd = ',space72nd); 9writel A C D B E F G H J K EEECC0^O^ee(outprint, chr(20 + 128) ); + end; +end; {unenlarge} 0 ) ( 4 2 ( $ {wrstrunder} + 4 procedure enlarge; +begin +if ptrtype = epson then /begin /enlargeon := true; /write(outprint, chr(14 + 128) ); /end; +end; {enlarge}  procedure unenlarge; +begin +if ptrtype = epson then /begin /enlargeon := false; /writ(begin (writeln(outprint,maxstr); (desetunderon; (maxstr := ''; (end; 2 "procedure wrstrunder; {(astr:string; space72nd:integer ); } (begin (setunderon(space72nd); (writeln(outprint,astr); (maxstr := ''; (strtomaxstr(astr); (usemaxstr; (end; ,var i : integer; , ,begin , ,if length(undstr) > 0 then 1begin 1for i := 1 to length(undstr) do 7if (ord(undstr[i]) <> 32 ) then undstr[i] := '_'; 1maxstr := concat(maxstr,undstr); 1end; , ,end; {strtomaxstr} 3 2 2 procedure usemaxstr; at(maxstr,' '); (if numunder > 0 then for i := 1 to numunder do /maxstr := concat(maxstr,'_'); (if num2space > 0 then for i := 1 to num2space do /maxstr := concat(maxstr,' '); (end; {numstomaxstr} ) procedure strtomaxstr; { (undstr: string ); } &; )if nspace > 0 then for i := 1 to nspace do write(outprint,'_'); )end; {underline} ) !procedure numstomaxstr; {(num1space,numunder,num2space:integer); } (var i : integer; (begin (if num1space > 0 then for i := 1 to num1space do /maxstr := conc0if nspace >= 20 then 6begin 6write(outprint,'____________________'); 6nspace := nspace - 20; 6end; 0until nspace < 20; )repeat {until < 5 } 0if nspace >= 5 then 6begin 6write(outprint,'_____'); 6nspace := nspace - 5; 6end; 0until nspace < 5 = epson then ) begin -underon := false; -setlnfeed(hold72nd); -end; )end; {desetunderon} ) ) procedure underline; {( nspace:integer); } )var i : integer; )begin )if nspace > 160 then nspace := 160; ) )repeat {until < 20 } } 0end; *end; {setlnfeed} ) procedure setunderon; {( old72nd:integer); } ) )begin )if ptrtype = epson then ) begin ,hold72nd := old72nd; ,underon := true; ,setlnfeed(1); ,end; )end; {setunderon} ) procedure desetunderon; )begin )if ptrtypen('defaults to 12 if not in (1..85)'); 9msg2; 0if not ilim(space72nd,85,1) then space72nd := 12; 0write(outprint, 9chr(27 + 128), 9chr(65 + 128), 9chr(space72nd + 128) ); 0vspc72nd := space72nd; {current setting, intialized to 0} 9end; {if diagx