IMD 1.16: 29/05/2007 8:05:32 FOG/CPM.001 --FOGCPM001CAL2-EX COMa CAL2-EX PAS.CALENDARDOC FINANCESCOMX !"FINANCESDOC#FINANCESPAS&$%&'(LISTER22COM)*+,-./012345678LISTER22COM9:;<=>?@ABCDEFGHLISTER22COMIJK-10-00 85 -CPM001 DOCLISTER22PASlLMNOPQRSTUVWXYEDIT INC~Z[\]^_`abcdefghiFILTER INCjLETTERS DATAklmnopqrsLISTER 1 }tuvwxyz{|}~LISTER21DOC'PRTPRO PASPRTPRO PASVIXENMM COMYVIXENMM DOCVIXENMM PASThis is the disk name. FINANCESDOC#FINANCESPAS&$%&'(LISTER22COM)*+,-./012345678LISTER22COM9:;<=>?@ABCDEFGHLISTER22COMIJKCHEKLISTBAKLISTER22PASlLMNOPQRSTUVWXYEDIT INC~Z[\]^_`abcdefghiFILTER INCjLETTERS DATAklmnopqrsLISTER 1 }tuvwxyz{|}~LISTER21DOC'PRTPRO PASPRTPRO PASCHEKLISTCRCVIXENMM COMYVIXENMM DOCVIXENMM PAS--FOGCPM001ͫCopyright (C) 1984 BORLAND IncA Osborne 1al selectedP)(= ERT()~7#~=% o&ͦoͦܐԩͣ}!!"8~#(}:$= +*!Z!*B!!:(=2!Z: <2!!!:O::O:!*B! !45(!.+/ 0y0( d!kZ!{Z͈͈o&  :(y ͠|( *"x2y( >28!?"9!!>2 :D]SXN]D [ (!e}̈́A8Q0G: x@!\w# (   yV. V!h6# (*(.(!8}(*(̈́w#>?> w#a{ |͒}͛Ɛ'@'7||}>"C"6# ""͐ͩ*B"[R5*"^#V#^#V#N#FO/o&9O/o&9!9(> (G!9 w#E͊w}8uRB0 >R@RR!+ͨ z R!+ͨ z <!+ͨ z <!+ͨ z <!#ͨ z <!+ͨ z T]KB!z> S>))0 = |JJDMgo>jB0 7?= H\<z5+)+<z {0Gɯgo||H}||/g}/o#}o&K[xAJSJDM!b"!6J"DM'ͬͬdͬ ͬ} wͦWͧ _}8(8J`9{T]=o`9y w >uJ u` }>(; xQ }} ˸T}ٕ(0D=C ,= ( [ 0%D , 7 ͏ ?(8u x O - ; 8˸x X ,-xG}; }م 9; .>#n0[ D = - nx P ,-(-˸G,-; }ٕ? 9.>͏ 8u ?= u+-(>O 0u O 8͏ ?x P , 78ƀ8ƀ8ox٨!دoGOW_gɷɷ|لg{ً_zيWyىOxوG|ٔg{ٛ_zٚWyٙOx٘Gxٸyٹzٺ{ٻ|ټx٨ xx(ͼ ?}ٽÏ }ց; <(; 7D = |٤g{٣_z٢Wy١Ox٠GD u J }x>uu}ƀ/ƀo; -J }0W-J W,}l˸ͨ 8 ; ` x( -ͨ 8J -ͨ 8,J }l8;*!` ! >u` ` u--- J ,,,-xGg?+2n*8t z~,->uxua}.; OJ , ; !U >,k- o&0%,` }g; }؉}颋.:}8c~I$I~L*kٷx˸; }0G,͙<},-(-J ! >0 a` o8 Oþ >um.`1pF,t6|!wS<.z}[|%FXc~ur1}Oٯx(<˸ͨ 8; !~Jͨ 0O!><ͨ 8 =  7 <` O ; 7 0 W-J OT0 j oD,:j !I}袋.}8c~I$I~L!>u` ` 77 ` = O nf^VNF!DLT\I!!53!r1!\!> x #-= o˸xO(- }(x>8(C ,C `iM!>u|; |J>| )=|(DMbo˸ͦ88ͦx(0 8> Mx(>-Ͳ{(ay(Ͱͦ \z(>.Ͳ (Ͱ ~ͦ{>EͲ>+|(|Dg>-Ͳ|/ 0:p# ~# +>0w#,-  60#J˸}րogM| .(C = ~> x0w#xG%P %P ZJDM%P = _~65i+~hìx-Sx9?+{Η@}|C C gZJDM0D ,7}o˸  #yO!@9i&   # w# /w# w#!9! E9!!9~(+F͊!"9!(#>2*Ͳ"|>" :( ͆ *6#w*6#6 !\$![ (̈́( #:~CONTRMKBDLSTAUXUSR>2$*#~ Ͷ$*:> >w###6  #6++p>2S-$Ͷ:*6###ww#w$w#w: ##N#F*B> w#w#[s#r>2S$Ͷ$*6 #-Nw#Fwq#p#6#w#w#w* :( ͒: *^ F* < >26"~͟*-w#ww#͟"~ <@*Ͳ!\  <ʮ!\$> >2*|>! * \$\<(!: [1Á\!(f"> 2:!<"F( #~#6e>!["N>!~8>O6*"w (=(&("( :(N 8y(~#x+% (6*#~[*#~ *~(h#"b=  8 J= B== ͯ}8= ͵}/ͭ !*###~-_~(4Q6*>2>*##w:>*##~*#~(E[ ( ( ( !][ ( ( ((w#(6!]~-#8~>7  [>OkͼMs #rkͼpX á[ [ (( #w(q*#~[ (  *##~6͜O$*#~(08ʦ=ʦ==ʩ=ʬò+###~-_q46͡> *:4^q}Ò*|(M|( M6-#͐ͦ[R8 (G> ͒C~͒#*ͦC!h !lTRUEFALSEͦ!9^#(~#(G~͒#> ͒> Ò "F![(#RR0*4#4> RR *4 #4(>>2$*V(/˖:(#~+ x y2!͵( =( X:(R*:(###~-_-͌X> :("͟"*^˞*V˖0 SRѷR8A* N#F#s#r$ 0})jS\*###w* N#FB ͟r+s> !T]>)j)0 0= UR!#U*^#V#N#F#^#V>">!2DM"~x(L* :O(o:" C}=( ?*-N#Fp+qq#p! * F+N+++V+^Bq#p>>> SRѷR* s#r$ s#r"S"! N#FB(^x * 6#[<(H*! Kq#p##K[! *! 4 #4! x *$ *>w""{_!"*nf}(HR0nf" ^VMDnfutqp*s#r*s#r"* 5KB!>u~#fo{_"*R0RnfR0KqputsrNF( ^VNF^V*SutKqp R*R(~w~wnf ut"6# * *!""*NFy(* "*B0Cnf* [R*"*RS[s#r^#VS>O"w2x2!"" @*>2"!"""!\Ͳ*: !~6go(\R*s#r_2x( s x(T]DMR0 -a%}̈́o*!~6o&͠|ͣ}%^C User break1:% I/O% Run-time% error ͒%, PC=[R"͍% Program aborted*1!͍! 1Ͳ 0!!5zT }2l!!L5zI }2m*!*l&+)))))))*m&+!_s*m&# *l&#!!5z }2l!!5zʵ }2m**l&+)))))))! *m&+!|s*m&#u *l&#` #!!5z!}2m*m&*! !R!**m&!͇E&!*m&R!b*m&! !R!R!*m&*R!b*m&! !R! R!*m&*R!b*m&! !R!R!*m&*R!b*m&# !*R}2l!**l&R5zv"}2m*l&!}2l*m&! !R!*m&!ͯEk"*l&R!b*m&#"!#*R}2l*l&*ͯE#!**l&R5z#}2m*l&!}2l*m&! !R!*l&R!!/b*m&#î"!!Ŕ(RETURN to quit)͐b!!ŔMONTH: b!q+.b!!5zʘ#}2m!q*m&!q*m&n&(s*m&#c#!!Ŕ | b!!Ŕ | b!q \E#&$!q !!5!uͲ!u JAN\E4$!"!"%!u FEB\EX$!"!"%!u MAR\E|$!"!"%!u APR\Eʠ$!"!"%!u MAY\E$!"!"%!u JUN\E$!"!"%!u JUL\E %!"!"%!u AUG\E0%!"!"%!u SEP\ET%!"!"%!u OCT\Ex%!"!"%!u NOV\Eʜ%!"!"%!u DEC\E%!"!"%#!u .DTA!dͲ !!d <b!5!N}2*&E&!͝}oE&!8!m!l!y ._b!*m&+))))))))*l&+)))!y  *m&! ! R*l&!*m&+))))))))*l&+))) R!qb&!!d <b!b!!5z'}2m!!5zʵ'}2l!*m&+))))))))*l&+))) oEʪ'![*m&!! *l&!! !*m&+))))))))*l&+))) !q͐b*l&#'*m&#&!b!!!u R!qb!}2n!}2m!}2l*m&! ! R*n&*l&!8!pb*p&aRB)*n&! ͯE)*n&!*m&+))))))))*l&+))) m͛E) !*n&!*m&+))))))))*l&+))) mR5!*m&+))))))))*l&+)))! *n&!}2n!*m&+))))))))*l&+)))*n&!ͽ*p&e.!*m&+))))))))*l&+)))*n& R!*m&+))))))))*l&+))) *n&! 5!qb/ R9**n&! ͯE**n&!}2n6**m&!ͯE6**m&!}2m!}2n/R˜**n&!͛Ej**n&!R}2nÕ**m&!͛Eʕ**m&!R}2m! }2n/R**l&!͛E**l&!R}2l!}2n/R* R+*l&!ͯE+*l&!}2l!}2n/RD+*m&!ͯEA+*m&!}2m!}2n/R‘+*n&!N*m&!͛}oEʇ+*m&!R}2mÎ+!}2n/R+*l&!ͯEʿ+*l&!}2l+!}2l!}2n/R,*l&!͛E,*l&!R}2l,!}2l!}2n/R,!*m&+))))))))*l&+)))!! ͽ*m&! ! R*l&Ŕ b!}2n/Rd-*n&!*m&+))))))))*l&+))) mͯEa-!*m&+))))))))*l&+)))*n&!!ͽR!*m&+))))))))*l&+))) *n&!! 5!q! b/RR.*n&!͛EO.!*m&+))))))))*l&+)))*n&!ͽR!!*m&+))))))))*l&+))) *n&!*m&+))))))))*l&+))) m*n&R5!q! b*n&!R}2n/Rb. 0/R/!8!ob*o&(}2o*o&SRʟ.R°.!}2m!}2n/DR.R.!}2m!}2n/ER.R.!}2l!}2n/XR/R/!}2l!}2n*p&! NE'!!Ŕ^K b!!!8!pb*p&(}2p*p&SRʂ/R—/R!Sb&' 0DRʫ/R½/R!Db& 0XR/R/R!Xb&!qͲ 0QR0R0 0'c!!5zʀ0}2m!!5zu0}2l!*m&+))))))))*l&+))) *l&#-0*m&#0ŔI SUN MON TUE WED THU FRI SATbU !q oE0'!q \E 0c SUN MON TUE WED THU FRI SATbU !q oEo'!q \E!*m&+))))))))*l&+)))*n&!ͽR!!*m&+))))))))*l&+))) *n&!*m&+))))))))*l&+))) m*n&R5!q! b*n&!R}2n/Rb. 0/R/!8!ob*o&(}2o*o&SRʟ.R°.!}2m!}2n/DR.R.!}2m!}2n/ER.R.!}2l!}2n/XR/R/!}2l!}2n*p&! NE'!!Ŕ^K b!!!8!pb*p&(}2p*p&SRʂ/R—/R!Sb&' 0DRʫ/R½/R!Db& 0XR/R/R!Xb&!qͲ 0QR0R0 0'c!!5zʀ0}2m!!5zu0}2l!*m&+))))))))*l&+))) *l&#-0*m&#0ŔI SUN MON TUE WED THU FRI SATbU !q oE0'!q \Eprogram CALENDAR; (* written in TURBO PASCAL Jan '85 by Doug Cox for the Osborne 1 *) { Updated for the Osborne EXECUTIVE by Mike Pillers Mar '85 } { by merely changing the value of ScreenTop to $C000. } const ScreenTop: integer= $C000; type Days= 1..7; Rows= 1..24; TotalRows= 1..32; TotalCols= 1..128; PointerType= ^ScreenPointer; ScreenPointer= array[TotalRows, TotalCols] of byte; var pointerVar: PointerType ABSOLUTE Screentop; entry: array [Days, Rows] of string[10]; note: string[10]; mon, mo: string[3]; ch, nextCh: char; p, x, y: byte; fileName: string[7]; fv: Text; procedure HorizLines; begin for y:= 1 to 4 do for x:= 1 to 76 do pointerVar^[5*y, x]:= 95; end; procedure VertLines; begin for y:= 1 to 24 do for x:= 1 to 6 do pointerVar^[y, 11*x]:= 124; end; procedure DiskInfo; label B, E; var spaces, len: integer; ok: boolean; procedure Dates; begin for x:= 1 to 7 do  begin GotoXY(((x+spaces)*11)-2, 1); if (spaces+x) <= 7 then write (x); GotoXY((x*11)-2, 6); write (7+(x-spaces)); GotoXY((x*11)-2, 11); write (14+(x-spaces)); GotoXY((x*11)-2, 16); write (21+(x-spaces)); end; y:= 28-spaces; for x:= 1 to (len-y) do begin y:= y+1; GotoXY((x*11)-2, 21); if x < 8 then write (y); end; y:= 35-spaces; if y < len then for x:= 1 to (len-y) do begin y:= y+1; GotoXY((x*11)-5, 21); write (y,'/'); end; end; begin (* procedure DiskInfo *) B:GotoXY(1,3); writeln ('(RETURN to quit)'); GotoXY(1,2); write ('MONTH: '); read (mo); for x:= 1 to 3 do mo[x]:= UpCase(mo[x]); GotoXY(1,2); write (' | '); GotoXY(1,3); write (' | '); if mo= '' then goto E else mon:= Copy(mo,1,3); if mon= 'JAN' then begin spaces:= 2; len:= 31; end else if mon= 'FEB' then begin spaces:= 5; len:= 28; end else if mon= 'MAR' then begin spaces:= 5; len:= 31; end else if mon= 'APR' then begin spaces:= 1; len:= 30; end else if mon= 'MAY' then begin spaces:= 3; len:= 31; end else if mon= 'JUN' then begin spaces:= 6; len:= 30; end else if mon= 'JUL' then begin spaces:= 1; len:= 31; end else if mon= 'AUG' then begin spaces:= 4; len:= 31; end else if mon= 'SEP' then begin spaces:= 0; len:= 30; end else if mon= 'OCT' then begin spaces:= 2; len:= 31; end else if mon= 'NOV' then begin spaces:= 5; len:= 30; end else if mon= 'DEC' then begin spaces:= 0; len:= 31; end else goto B; fileName:= mon+'.DTA'; Dates; Assign (fv,fileName); {$I-} Reset (fv) {$I+}; ok:= (IOresult= 0); if ok then while not Eof (fv) do begin readln (fv, x, y, note); entry[x,y]:= note; GotoXY((x*11)-10, y); write (entry[x,y]); end; E:end; procedure Save; begin Assign (fv,fileName); Rewrite (fv); for x:= 1 to 7 do for y:= 1 to 24 do if entry[x,y] <> '' then writeln (fv, x,' ',y,' ',entry[x,y]); Close (fv); end; procedure Entries; label B, E; const Len= 10; Blanks= ' '; begin B:GotoXY(1,1); write (mon); p:= 0; x:= 1; y:= 2; repeat GotoXY(((x*11)-10)+p, y); read (Kbd, ch); case ch of #31..#127: if p < Len then begin if p > Length(entry[x,y]) then Insert (Copy(Blanks, 1, p-Length(entry[x,y])), entry[x,y],1); p:= p+1; Delete (entry[x,y], p, 1); Insert (ch, entry[x,y],p); write (Copy(entry[x,y], p, Len)); end; ^D : if p < Len then p:= p+1 else if x < 7 then begin x:= x+1; p:= 0; end; ^S : if p > 0 then p:= p-1 else if x > 1 then begin x:= x-1; p:= 9; end; ^E : if y > 1 then begin y:= y-1; p:= 0; end; ^X,^M: begin if y < 24 then y:= y+1; p:= 0; end; ^F : if x < 7 then begin x:= x+1; p:= 0; end; ^A : begin if (p= 0) and (x > 1) then x:= x-1 else p:= 0; end; ^C : begin if y < 20 then y:= y+5 else y:= 24; p:= 0; end; ^R : begin if y > 5 then y:= y-5 else y:= 1; p:= 0; end; ^Y : begin Delete (entry[x,y], 1,Len); GotoXY((x*11)-10, y); write (Blanks); p:= 0; end; ^G : if p < Length(entry[x,y]) then begin Delete(entry[x,y], p+1, 1); write (Copy(entry[x,y], p+1, Len), ' '); end; ^H : if p > 0 then begin Delete(entry[x,y], p, 1); write (^H, Copy(entry[x,y], p, Length(entry[x,y])-p),' '); p:= p-1; end; ^[ : Goto E; ^Q : begin read (Kbd, nextCh); nextCh:= UpCase(nextCh); case nextCh of 'S',^S: begin x:= 1; p:= 0; end; 'D',^D: begin x:= 7; p:= 0; end; 'E',^E: begin y:= 1; p:= 0; end; 'X',^X: begin y:= 24; p:= 0; end; end; end; end; until ch= ^K; GotoXY(1,1); write ('^K '); GotoXY(3,1); read (Kbd, ch); ch:= UpCase(ch); case ch of 'S',^S : begin write ('S'); Save; Goto B; end; 'D',^D : begin write ('D'); Save; end; 'X',^X : begin write ('X'); Save; mo:= ''; end; 'Q',^Q : begin end; else Goto B; end; E:end; begin (* MAIN PART *) repeat ClrScr; for x:= 1 to 7 do for y:= 1 to 24 do entry[x,y]:= ''; write (' SUN MON TUE WED THU FRI SAT'); HorizLines; VertLines; DiskInfo; if mo <> '' then Entries; until mo= ''; ClrScr; end. read (Kbd, nextCh); nextCh:= UpCase(nextCh); case nextCh of 'S',^S: begin x:= 1; p:= 0; end; 'D',^D: begin x:= 7; p:= 0; end; 'E',^E: begin y:= 1; p:= 0; end; 'X',^X: beAn appointment calendar, written in TURBO PASCAL for an 80-column Osborne 1. After typing "CALENDAR" at the "A>" prompt, enter a month, using it's first 3 letters (e.g. OCT). Exit (as in WordStar) with: Ctrl-K and then D to quit month and save data Ctrl-K and then Q to quit month without saving data Ctrl-K and then X to quit program Ctrl-K and then S will save the data without an exit Pressing the space bar instead of the letter following the Ctrl-K will cancel the command. Move cursor (as in WordStar) with Arrow Keys or: Ctrl-F = right 1 day Ctrl-A = left 1 day or to beginning of entry line Ctrl-C = down 1 day Ctrl-R = up 1 day Return or Ctrl-X or Ctrl-J = next entry line Ctrl-E or Ctrl-K = previous entry line Ctrl-D or Ctrl-L = right 1 character Ctrl-S = left 1 character Ctrl-H = backspace & erase 1 character (but only within an entry line) Ctrl-G = erase character at cursor position Ctrl-Y = erase entry & go to beginning of entry A data file will be created on the current drive for the month entered (e.g. OCT.DTA). The months are only good for 1985. Copyright (c) by Doug Cox, Jan '85, for non-commercial use in the Public Domain.d save data Ctrl-K and then Q to quit month without saving data Ctrl-K and then X to quit program Ctrl-K and then S will save the data without an exit Pressing the space bar instead of the letter following the Ctrl-K will cancel the command. Move cursor (as in WordStar) with Arrow Keys or: Ctrl-F = right 1 day Ctrl-A = left 1 day or to beginning of entry line Ctrl-C = down 1 day Ctrl-R = up 1 day Return or Ctrl-X or Ctrl-J = next entry line Ctrl-E or Ctrl-K = previous entry line Ctrl-D or Ctrl-L = right 1 character Ctrl-S = left 1 character Ctrl-H = backspace & erase 1 character (but only within an entry line) Ctrl-G = erase character at cursor position Ctrl-Y = erase entry & go to beginning of entry ͫCopyright (C) 1984 BORLAND IncA Osborne 1al selected)(= ERT()~7#~=% o&ͦoͦܐԩͣ}!!"8~#(}:$= +*!Z!*B!!:(=2!Z: <2!!!:O::O:!*B! !45(!.+/ 0y0( d!kZ!{Z͈͈o&  :(y ͠|( *"x2y( >28!?"9!!>2 :D]SXN]D [ (!e}̈́A8Q0G: x@!\w# (   yV. V!h6# (*(.(!8}(*(̈́w#>?> w#a{ |͒}͛Ɛ'@'7||}>"C"6# ""͐ͩ*B"[R5*"^#V#^#V#N#FO/o&9O/o&9!9(> (G!9 w#E͊w}8uRB0 >R@RR!+ͨ z R!+ͨ z <!+ͨ z <!+ͨ z <!#ͨ z <!+ͨ z T]KB!z> S>))0 = |JJDMgo>jB0 7?= H\<z5+)+<z {0Gɯgo||H}||/g}/o#}o&K[xAJSJDM!b"!6J"DM'ͬͬdͬ ͬ} wͦWͧ _}8(8J`9{T]=o`9y w >uJ u` }>(; xQ }} ˸T}ٕ(0D=C ,= ( [ 0%D , 7 ͏ ?(8u x O - ; 8˸x X ,-xG}; }م 9; .>#n0[ D = - nx P ,-(-˸G,-; }ٕ? 9.>͏ 8u ?= u+-(>O 0u O 8͏ ?x P , 78ƀ8ƀ8ox٨!دoGOW_gɷɷ|لg{ً_zيWyىOxوG|ٔg{ٛ_zٚWyٙOx٘Gxٸyٹzٺ{ٻ|ټx٨ xx(ͼ ?}ٽÏ }ց; <(; 7D = |٤g{٣_z٢Wy١Ox٠GD u J }x>uu}ƀ/ƀo; -J }0W-J W,}l˸ͨ 8 ; ` x( -ͨ 8J -ͨ 8,J }l8;*!` ! >u` ` u--- J ,,,-xGg?+2n*8t z~,->uxua}.; OJ , ; !U >,k- o&0%,` }g; }؉}颋.:}8c~I$I~L*kٷx˸; }0G,͙<},-(-J ! >0 a` o8 Oþ >um.`1pF,t6|!wS<.z}[|%FXc~ur1}Oٯx(<˸ͨ 8; !~Jͨ 0O!><ͨ 8 =  7 <` O ; 7 0 W-J OT0 j oD,:j !I}袋.}8c~I$I~L!>u` ` 77 ` = O nf^VNF!DLT\I!!53!r1!\!> x #-= o˸xO(- }(x>8(C ,C `iM!>u|; |J>| )=|(DMbo˸ͦ88ͦx(0 8> Mx(>-Ͳ{(ay(Ͱͦ \z(>.Ͳ (Ͱ ~ͦ{>EͲ>+|(|Dg>-Ͳ|/ 0:p# ~# +>0w#,-  60#J˸}րogM| .(C = ~> x0w#xG%P %P ZJDM%P = _~65i+~hìx-Sx9?+{Η@}|C C gZJDM0D ,7}o˸  #yO!@9i&   # w# /w# w#!9! E9!!9~(+F͊!"9!(#>2*Ͳ"|>" :( ͆ *6#w*6#6 !\$![ (̈́( #:~CONTRMKBDLSTAUXUSR>2$*#~ Ͷ$*:> >w###6  #6++p>2S-$Ͷ:*6###ww#w$w#w: ##N#F*B> w#w#[s#r>2S$Ͷ$*6 #-Nw#Fwq#p#6#w#w#w* :( ͒: *^ F* < >26"~͟*-w#ww#͟"~ <@*Ͳ!\  <ʮ!\$> >2*|>! * \$\<(!: [1Á\!(f"> 2:!<"F( #~#6e>!["N>!~8>O6*"w (=(&("( :(N 8y(~#x+% (6*#~[*#~ *~(h#"b=  8 J= B== ͯ}8= ͵}/ͭ !*###~-_~(4Q6*>2>*##w:>*##~*#~(E[ ( ( ( !][ ( ( ((w#(6!]~-#8~>7  [>OkͼMs #rkͼpX á[ [ (( #w(q*#~[ (  *##~6͜O$*#~(08ʦ=ʦ==ʩ=ʬò+###~-_q46͡> *:4^q}Ò*|( M|( M6-#͐ͦ[R8 (G> ͒C~͒#*ͦC!h !lTRUEFALSEͦ!9^#(~#(G~͒#> ͒> Ò "F![(#RR0*4#4> RR *4 #4(>>2$*V(/˖:(#~+ x y2!͵( =( X:(R*:(###~-_-͌X> :("͟"*^˞*V˖0 SRѷR8A* N#F#s#r$ 0})jS\*###w* N#FB ͟r+s> !T]>)j)0 0= UR!#U*^#V#N#F#^#V>">!2DM"~x(L* :O(o:" C}=( ?*-N#Fp+qq#p! * F+N+++V+^Bq#p>>> SRѷR* s#r$ s#r"S"! N#FB(^x * 6#[<(H*! Kq#p##K[! *! 4 #4! x *$ *>w""{_!"*nf}(HR0nf" ^VMDnfutqp*s#r*s#r"* 5KB!>u~#fo{_"*R0RnfR0KqputsrNF( ^VNF^V*SutKqp R*R(~w~wnf ut"6# * *!""*NFy(* "*B0Cnf* [R*"*RS[s#r^#VS>O"w2x2!"" @*>2"!"""!\Ͳ*: !~6go(\R*s#r_2x( s x(T]DMR0 -a%}̈́o*!~6o&͠|ͣ}%^C User break1:% I/O% Run-time% error ͒%, PC=[R"͍% Program aborted*1!͍!,ZͲ)!͡!!!! s!,e.!! m!R ! R!qb!! Ŕ b!! !+b! ! Ŕ b! ! !+bR!%b!! !͡!! Ŕ b!! !+b!!ͳ !͡*&!@ !z͡!!!ͳ *& !   !ͼ !ͳ ! !͡!!!!ͥE!! "!R!!@b!!!8!b*&(ARi"!! Ŕ b!! !+b #IR"! ! Ŕ b! ! !+b!! !͡R!%b #YR #!! Ŕ b!! !+b*&(!QNE !*! Ŕ b!*! !+b!%! Ŕ b!%! !+bR!%b!!  !zp= # !͡!"! Ŕ b!"! !+b!!p͡!!j͡!%!Ŕ (Calculating)b!%!!*&5zM%}2!! 5zʤ$}2!!pͳ !!p ͳ !p͡*&#R$!p!!  *& ͼ !j͡!j!33333 !j͡!j!!  *& ͳ !p͡*&#=$Ŕ b!%!!p!ͥEʘ%!pñ%!pR!!@b!"!Ŕ b!"!!j!ͥE%!j&!jR!!@b!!!8!b*&(ARu&!*! Ŕ b!*! !+b'IR&!%! Ŕ b!%! !+b!! !͡R!%b'YR'!"! Ŕ b!"! !+b*&(!QNE#!>! ͽ!`+b!@! ͽ!Z+bR!%b!Z!zp= # !Z͡!<! ͽ!+b!`!͡!B!ͽ!*&5z (}2!!Z! ͳ !͡*&#'!!ͥE5(!N(!R!!@b!!!8!b*&(AR”(!>! ͽ!`+b )IR(!@! ͽ!Z+b!Z!zp= # !Z͡R!%b )YR )!<! ͽ!+b*&(!QNEʢ'cŔ SELECT: ͐bŔ(A)mortization͐bŔ (S)avings͐bŔ (I)nflation͐bŔ(Q)uit programb!!Ŕ AMORTIZATION͐bR͐bŔLoan Amount: $͐bŔ Interest: %͐bŔYears: ͐bR͐bŔMonthly Payment: $b!!ŔSAVINGSb!! ŔAmount/Month: $b!! Ŕ Interest: %b!! ŔYears: b!!Ŕ Savings: $b!!ŔGain: $b!!Ŕ(after 30% annual taxes)b!5!Ŕ INFLATIONb!5! Ŕ Amount: $b!5! ŔInflation: %b!5! ŔYears: b!5!Ŕ Equivalent: $b!!Ŕ CHANGES TO SELECTION:͐bŔ(A)mount͐bŔ(I)nterest (or inflation)͐bŔ(Y)ears͐bŔ(Q)uit selectionb! !!8!b*&(}2*&AR|,C Ù,SRŒ,#Ù,IR™,+'*&!QNEC,cQ)uit selectionb! !!8!b*&(}2*&ARAC t,S FINANCES.DOC written in Turbo Pascal by Doug Cox Mar '85 for use in the Public Domain At the "A>" prompt, type "finances" to run. In the program, at the "SELECT:" prompt, type either "A", "S", "I", or "Q". "CHANGES TO SELECTION:" works the same way. The Pascal source file is included (Finances.Pas). You might want to look at it to verify my formulas. And if you have a pascal compiler (Turbo is best!), then you may want to amplify it, or at least change your tax effect on your savings gain. Send any remarks to Doug Cox 488 University Ave #611 Palo Alto, Ca. 94301program FINANCES; var ans, sel: char; month, year, years: byte; interest, amount: real; procedure InsertComma (quantity: real); var number: string[10]; begin Str (quantity:00:00, number); Insert(',', number, Length(number)-2); write (number); end; procedure Amort; var principal, payments, a,b: real; begin GotoXY(15,10); write (' '); GotoXY(15,10); read (principal); GotoXY(11,11); write (' '); GotoXY(11,11); read (interest); write ('%'); interest:= interest/1200; GotoXY(8,12); write (' '); GotoXY(8,12); read (years); repeat a:= 1.0+interest; b:= years*12.0; payments:= ((interest/((exp(ln(interest+1)*years*12))-1))+interest)*principal; GotoXY(19,14); if payments > 999 then InsertComma (payments) else write (payments:5:2); GotoXY(25,19); read (Kbd,ans); case UpCase(ans) of 'A': begin GotoXY(15,10); write (' '); GotoXY(15,10); read (principal); end; 'I': begin GotoXY(11,11); write (' '); GotoXY(11,11); read (interest); interest:= interest/1200; write ('%'); end; 'Y': begin GotoXY(8,12); write (' '); GotoXY(8,12); read (years); end; end; until UpCase(ans)= 'Q'; end; procedure Savings; var savings, gain: real; begin GotoXY(42,10); write (' '); GotoXY(42,10); read (amount); GotoXY(37,11); write (' '); GotoXY(37,11); read (interest); write ('%'); interest:= (interest/12)*0.01; GotoXY(34,12); write (' '); GotoXY(34,12); read (years); repeat savings:= 0; gain:= 0; GotoXY(37,14); write ('(Calculating)'); GotoXY(37,14); for year:= 1 to years do begin for month:= 1 to 12 do begin savings:= amount+savings+(interest*savings); end; gain:= savings-(amount*12*year); gain:= gain*0.70; (* taxes *) savings:= gain+(amount*12*year); end;  write (' '); GotoXY(37,14); if savings > 999 then InsertComma (savings) else write (savings:00:00); GotoXY(34,15); write (' '); GotoXY(34,15); if gain > 999 then InsertComma (gain) else write (gain:00:00); GotoXY(25,19); read (Kbd,ans); case UpCase(ans) of 'A': begin GotoXY(42,10); write (' '); GotoXY(42,10); read (amount); end; 'I': begin GotoXY(37,11); write (' '); GotoXY(37,11); read (interest); interest:= interest/1200; write ('%'); end; 'Y': begin GotoXY(34,12); write (' '); GotoXY(34,12); read (years); end; end; until UpCase(ans)= 'Q'; end; procedure Inflation; var initAmount, infl: real; begin GotoXY(62,10); ClrEol; read (initAmount); GotoXY(64,11); ClrEol; read (infl); write ('%'); infl:= infl*0.01; GotoXY(60,12); ClrEol; read (years); repeat amount:= initAmount; GotoXY(66,14); ClrEol; for year:= 1 to years do begin amount:= amount+(infl*amount); end; if amount > 999 then InsertComma (amount) else write (amount:00:00); GotoXY(25,19); read (Kbd,ans); case UpCase(ans) of 'A': begin GotoXY(62,10); ClrEol; read (initAmount); end; 'I': begin GotoXY(64,11); ClrEol; read (infl); infl:= infl*0.01; write ('%'); end; 'Y': begin GotoXY(60,12); ClrEol; read (years); end; end; until UpCase(ans)= 'Q'; end; begin (*MAIN PART *) ClrScr; writeln (' SELECT: '); writeln ('(A)mortization'); writeln ('(S)avings'); writeln ('(I)nflation'); write ('(Q)uit program'); GotoXY(1,8); writeln ('AMORTIZATION'); writeln; writeln ('Loan Amount: $'); writeln ('Interest: %'); writeln ('Years: '); writeln; write ('Monthly Payment: $'); GotoXY(27,8); write ('SAVINGS'); GotoXY(27,10); write ('Amount/Month: $'); GotoXY(27,11); write ('Interest: %');   GotoXY(27,12); write ('Years: '); GotoXY(27,14); write ('Savings: $'); GotoXY(27,15); write ('Gain: $'); GotoXY(27,16); write ('(after 30% annual taxes)'); GotoXY(53,8); write ('INFLATION'); GotoXY(53,10); write ('Amount: $'); GotoXY(53,11); write ('Inflation: %'); GotoXY(53,12); write ('Years: '); GotoXY(53,14); write ('Equivalent: $'); GotoXY (1,19); writeln (' CHANGES TO SELECTION:'); writeln ('(A)mount'); writeln ('(I)nterest (or inflation)'); writeln ('(Y)ears'); write ('(Q)uit selection'); repeat GotoXY(11,1); read (Kbd, sel); sel:= UpCase(sel); case sel of 'A': Amort; 'S': Savings; 'I': Inflation; end; until sel= 'Q'; ClrScr; end.n; writeln ('Loan Amount: $'); writeln ('Interest: %'); writeln ('Years: '); writeln; write ('Monthly Payment: $'); GotoXY(27,8); write ('SAVINGS'); GotoXY(27,10); write ('Amount/Month: $'); GotoXY(27,11); write ('Interest: %');  ͫCopyright (C) 1985 BORLAND IncB Osborne 1al SelectedP)(= EE RT(1)1~7#~= oͦkԄ!!"~#(}:$= +*!5!*!!:(2!5:(>2!!!:O::O:!*! !45(! +/ 0y0( d!k5!{5__o&  :(͠|(  *"x2y( >28!"9!! og2"">~22 9/4*9 Co&ͦͣ} [ (!e{ͦA8Q0G: x@!\w# (͂ ?(*( .( w^. ^!h6# (?( *( ͂( w#>?> w#ͦ 8 !ɿ .,;:=?*[]<>{}a{ |ʹ}ͽƐ'@'7||}>2ͯ*Bڨ  "og"2>2! ""*B"[Ru*"^#V#^#V#N#FO/o&9O/o&9!9(> (G!9 w#Eͺw}8' RB0 >' RqRR!+ Ͱ R!+ Ͱ r!+ Ͱ r!+ Ͱ r!# Ͱ r!+ Ͱ T]KB!z> S>))0 = | |̀̀DMgo>jB0 7?= H͒<z5a)a<z {0Gɯgo||~}||/g}/o#}o&K[xAJSJDM!b"!6J"DM'd } ) W _}8(8J`9{T]=o`9y ) >' ́ ͬ͗ }>' xˆ }} ˸T}ٕ(0D=z ,= ( ͒ 0%{ , 7 ?(8ͬ x ͆ - r 8˸x ͏  ,-xG}r }مM 9r .>#n0͒ { = - nx ͇ ,-(-˸G,-r }ٕ?M 9.> 8ͬ ?= u+-(>͆ 0ͬ ͆ 8 ?x ͇ , 78ƀ8ƀ8ox٨!دoGOW_gɷɷ|لg{ً_zيWyىOxوG|ٔg{ٛ_zٚWyٙOx٘Gxٸyٹzٺ{ٻ|ټx٨ xx( ?}ٽ }ցr <(r 7{ = |٤g{٣_z٢Wy١Ox٠G{ ͬ ́ }x>' ͬ}ƀ/ƀo -́ }0͎-́ ͎,}l˸ 8 4 ͗ x( - 8́ - 8,́ }l8;*!͗ ! >4ͬ͗ ͗ ͬ--- ́ ,,,-xGg?+2n*8t z~,->' x' ͘}. ͆́ , ! >4,͢- o&0%,͗ }gr }؉}颋.:}8c~I$I~L*͢ٷx˸ }0G,<},-(-́ !>I0 ͗͘ o8 ͆ >' m.`1pF,t6|!wS<.z}[|%FXc~ur1}͆ٯx(<˸ 8 !~J 0.O!>s 8 =  n s͗ ͆ .n 0 ͎-́ OT0 j oD,:j !I}袋.}8c~I$I~L! >ͬ͗ I× nn ͗ = ͆ nf^VNF!DLT\I!!53!r1!͒!> x #-= o˸x͆(- }(x>8(z ,z `iÃ!>' |r |̀>)=|(DMbo˸88x(0 8> ̀x(>-{(ay( z(>. ( {>E>+|(|Dg>-|/ 0:p# ~# +>0w#,-  60#} ˸}րogM| .(z = ~> x0w#xG%͇ %͇ ZJDM%͇ = _~65+~hìx-Sx9?+{Η@}|z z gZJDM0{ ,7}o˸? #yO!@9i&?  #?w#?/w#?w#!9! E9!!9~(+Fͺ!"9!(#>2*"| >"2:( Ͷ *w*6 !\$![ (ͦ( #:~CONTRMKBDLSTCAUXUSR>2i:*ˮ~0:*:(@q##pZ* :(  ~* < >26"!"""~>2""v>2>"!"ˮ(!~8>~O6~*"w(6(2(-()(6 (8 0 :(* y(~#+ (( 66 #6 #"*: y~o p .##~ͺ(.6w4._~ =*##55= *[R8*~#"= ͣ}== ͯ}͵}*#w+#~+>*~('k!0(ˮ]k!8ˮ!]~-#8~>27kˮw>O$6̃s #r$ͣ6̏ k ( (ˮ qk(ˮ ( k ˮ*O:~ ##~._q4((=ʦ==ʩ=ʬò*:4^q*##~6ͺ>2}*|(̓|( ̓6-#[RM8( G> A~#*'C! !TRUEFALSE!9N#Y~#( G~#> >    "~(kѻ(( !0 (ˮ!!>2Sz:0:*6##ww#w$w#w:  ##N#F*B>2w#w#[s#r> "~ͮ*-w#ww##> ͮÁ""~>2:ZR0 *4#4>2:ZR> *4 #4(> >22*f(/˦:G(##~++ :O x yC!ͺ Q*:G(##~._.͚f<\=<͚*##w ͮ +4 #4x >>2:G("ͮ"*nˮ*0 SZѷR8@* N#F#s#r, 0})jS\*##w+ N#FB ͮr+s>2!T]>)j)0 0= ]R!#]*^#V#N#F#^#V>2Ͱ:0:*6 #-Nw#Fwq#p#6#w#w#w"~Á>">!DM!":*B:!>(>2>">!"2"~ʰ*w#wx(9* :O *-4 #4!*4 #4 *-N#Fq#pV+^Bq#pSZѷR&* s#r$ s#rL <?*L!\  <( !\$>2>2L:>!(* \$\<(!3: [1ð\!(7"~> 2"S"Ns#FrB(Z#\: \<(?*"}K\! !*}#"}! x \* *>) 2""{_!"*nf}(HR0nf" ^VMDnfutqp*s#r*s#r"* uKB!0>' ~#fo{_"*R0RnfR0KqputsrNF( ^VNF^V*SutKqp R*R(~w~wnf ut"6#K*K*!""*NFy(* "*B0Cnf* [R*"*RS[s#r^#V""6#>O"w2x2*"!F"" &y*"*>2"*"!F"""!\*: Nr!~6go(\R*s#r_2x( s x(T]DMx(R0 U(͝O/o&9q# (!>F0#( ~ ( #]( ~ ( (#}(  i&T-a%â}ͦo*!~6o&|:2 2}:__zѯ2*|KB " z ^C User break+=  I/O Run-time error {ʹ, PC=*ͯNot enough memory Program aborted :ʎ'1!d!یޖB>ÈX --B0@D (08@HPX`hpxGE        zppp``((|(((|((xx2IIII&rNpTpdh&0YQ$ rf >AB<$~$D(|(D~| 0` @>AAA>@~#EAIA3DPbBAAQaHF B (   @~r@AAAHFp >QQQ. PR<66$$66&$$B(D$$$$$B$D(@` >AAYAA 9~((p!@!>HH>AIIII9~p>AAAb~B6AIIIIAA~BAIHHH@@~@>AII.AAAA>AAEC;@cEAIAQAcF @AAAA~`0 @ AAAA~ @ @@ @ A~A~?@@@~@A~_^_^A~$A~ ~   6AAAf~AAA6f   )D!!}2}2}2!*&}oEʻ*!}2!}2!}2ر!!`fzʻ*"!v*+!"n&!s!*+!"n&!s!*+!"n&!s*#U**"&E*!}2ر!"ٱM!װ!}2ױ!:ͣ!EI.!*ٱn&́!g͑!y͑!p͑!q͑!_͑!$͑!,͑OED+!}2ر!*ٱn&! E,*ٱ!!:ͣE,!*ٱ!n&! EA,!:!*ٱ!Rk*&*&!!:z)!:*ٱ!!:ͣk!!:*&*&!!:z)*!"*!"*&E;,*!"eM,!:*ٱ!!:ͣk!װ!:!*ٱ!Rk!!}2ر!}2ױ!װ:ͣ!:ͣE,!װ:! e.=!װ!װ:ͣ!:ͣͥEʔ,3.!*ٱn&RL-*"&}o}2"*ٱ!`fzB-"!*+!"n&!s*#-!}2ر-R¦-*"&}o}2"*ٱ!`fzʜ-"!*+!"n&!s*#n-!}2-R-*"&}o}2"*ٱ!`fz-"!v*+!"n&!s*#-!}2!*ٱn&! E'.!*ٱ!3.*ٱ!"ٱ*ٱ!:ͣE**&}oEʞ.!:ͣ!_!:ͣREʛ.!!!_!:ͣRs.!:ͣ!O!:ͣRE.!!!O!:ͣRs!}2!}2!:ͣ"۱!:ͣ! "*&}oE2/!:ͣ! "!ͺ!:!ͪ !ͺ!"!L"*!E"*!" !"!!:ͣfz/"*&E/*!Z"!*n&n&!"/*!Z"!*n&n&!"*#Ï/**R"߱!}2ְ!!:ͣfz4"*&}oEʵ0!Z"!*n&n&!Eʵ0!! !Z"!*n&n&R!fzʵ0"!ͺ!" *#Ô0!!Z"!*n&n&fzq2"*ױ&}oEʎ1!ͺ!"!*n&))))!+)))*+n&*&*&|g}o!v*+n&|g}o*&*&!*+n&|g}o|g}o|g}o|g}o" h2!ͺ!"!*n&))))!+)))*+n&!"!װ*n&))))!+)))*+n&|g}o*&*&|g}o!v*+n&|g}o*&*&!*+n&|g}o|g}o|g}o|g}o" *#0*&}oE2!! !Z"!*n&n&R! !Z"!*n&n&R!Rfz2"!ͺ!" *#2*&E"3!ͺ!"!"!" 13!ͺ!" !*n&́! ͑!0!9͛O}oEd3!}2ְ*۱!R"۱*߱!!*n&́! ͑!0!9͛O}o*ְ&}o}o*&}oE 4!*߱*۱!fz 4"!ͺ!" *߱!R"߱*#3*#%0*&EK4!*߱fzK4"!ͺ!" *#*4*&*&}o*&!͒}oEʊ4!}2!ͺ! " .*&*&!͒}oEʿ4!}2!ͺ! " .!ͺ! "!"!J"!" !}2!}2**R"߱!:ͣ"۱!ͺ!:!ͪ !ͺ!"!L"*!E"*!" !}2ְ!!:ͣfzW9"*&}oE5!Z"!*n&n&!E5!! !Z"!*n&n&R!fz5"!ͺ!" *#5!!Z"!*n&n&fzʳ7"*ױ&}oE6!ͺ!"!*n&))))!+)))*+n&*&*&|g}o!v*+n&|g}o*&*&!*+n&|g}o|g}o|g}o|g}o" ê7!ͺ!"!*n&))))!+)))*+n&!"!װ*n&))))!+)))*+n&|g}o*&*&|g}o!v*+n&|g}o*&*&!*+n&|g}o|g}o|g}o|g}o" *#6*&}oE<8!! !Z"!*n&n&R! !Z"!*n&n&R!Rfz<8"!ͺ!" *#8*&Ed8!ͺ!"!"!" s8!ͺ!" !*n&́! ͑!0!9͛O}oEʦ8!}2ְ*۱!R"۱*߱!!*n&́! ͑!0!9͛O}o*ְ&}o}o*&}oEN9!*߱*۱!fzN9"!ͺ!" *߱!R"߱*#9*#g5*&Eʍ9!*߱fzʍ9"!ͺ!" *#l9*&*&}o*&!͒}oE9!}2!ͺ! " 4*&*&!͒}oE:!}2!ͺ! " 4*ر&}oED:!ͺ! "!"!J"*R"!!R" eM!ͺ! "!"!J"!" !}2!}2!ͺ!:!ͪ !ͺ!"!L"*!E"*!" **R"߱!:ͣ"۱!}2ְ!!:ͣfzE"*&}oEB*ݱ!})!+)))*+n&|g}o"ݱð?yRª>*ݱ!)!+)))*+n&|g}o"ݱð?pR>*ݱ!)!+)))*+n&|g}o"ݱð?qR?*ݱ!)!+)))*+n&|g}o"ݱð?_RI?*ݱ!)!+)))*+n&|g}o"ݱð?$R~?*ݱ!)!+)))*+n&|g}o"ݱð?,R°?*ݱ!)!+)))*+n&|g}o"ݱ!ͺ*ݱ!!*+n&|g}o|g}o*&*&|g}o!v*+n&|g}o*&*&!*+n&|g}o|g}o|g}o|g}o" *#c<*&}oEʕA!! !Z"!*n&n&R! !Z"!*n&n&R!RfzʕA"*ױ&!װ*n&!_}o!*n&!_}o!*+n&!}oE}A!ͺ!*&*&|g}o!v*+n&|g}o*&*&!*+n&|g}o|g}o|g}o|g}o" ÌA!ͺ!" *#î@*&EʠB*ױ&!װ*n&!_}o!*n&!_}o!*+n&!}oEʂB!!fzB"!ͺ!*&*&|g}o!v*+n&|g}o*&*&!*+n&|g}o|g}o|g}o|g}o" *#BÝB!ͺ!"!"!" uC*ױ&!װ*n&!_}o!*n&!_}o!*+n&!}oEfC!ͺ!*&*&|g}o!v*+n&|g}o*&*&!*+n&|g}o|g}o|g}o|g}o" uC!ͺ!" !*n&́! ͑!0!9͛O}oEʨC!}2ְ*۱!R"۱*߱!!*n&́! ͑!0!9͛O}o*ְ&}o}o*&}oEE!*߱*۱!fzE"*ױ&!װ*n&!_}o!*n&!_}o!*+n&!}oED!ͺ!*&*&|g}o!v*+n&|g}o*&*&!*+n&|g}o|g}o|g}o|g}o" D!ͺ!" *!R"߱*# D*#:!}2ְ*&E\E!*߱fz\E"!ͺ!" *#;E*&*&}o*&!͒}oEʛE!}2!ͺ! " s:*&*&!͒}oEE!}2!ͺ! " s:!ͺ! "!"!J"!" !}2!}2**R"߱!:ͣ"۱!ͺ!:!ͪ !ͺ!"!L"*!E"*!" !!:ͣfzʉL"*&}oEG!Z"!*n&n&!EG!! !Z"!*n&n&R!fzG"!ͺ!" *#F!!Z"!*n&n&fzJ"!*n&́!g͑!p͑!q͑!y͑!_͑!$͑!,͑O}oEzG!"ݱèH!*n&gR¯G!})!+)))*+n&"ݱèHyRG!)!+)))*+n&"ݱèHpRH!)!+)))*+n&"ݱèHqR-H!)!+)))*+n&"ݱèH_RWH!)!+)))*+n&"ݱèH$RH!)!+)))*+n&"ݱèH,R¨H!)!+)))*+n&"ݱ*ױ&EoJ!װ*n&́!g͑!p͑!q͑!y͑!_͑!$͑!,͑OEoJ!װ*n&gR4I*ݱ!})!+)))*+n&|g}o"ݱoJyRiI*ݱ!)!+)))*+n&|g}o"ݱoJpRžI*ݱ!)!+)))*+n&|g}o"ݱoJqRI*ݱ!)!+)))*+n&|g}o"ݱoJ_RJ*ݱ!)!+)))*+n&|g}o"ݱoJ$R=J*ݱ!)!+)))*+n&|g}o"ݱoJ,RoJ*ݱ!)!+)))*+n&|g}o"ݱ!ͺ*ݱ*&*&|g}o!v*+n&|g}o*&*&!*+n&|g}o|g}o|g}o|g}o" *#"G*&}oEnK!! !Z"!*n&n&R! !Z"!*n&n&R!RfznK"!ͺ!" *#MK*&EʖK!ͺ!"!"!" åK!ͺ!" !*n&́! ͑!0!9͛O}oEK!}2ְ*۱!R"۱*߱!!*n&́! ͑!0!9͛O}o*ְ&}o}o*&}oEʀL!*߱*۱!fzʀL"!ͺ!" *߱!R"߱*#PL*#qF*&EʿL!*߱fzʿL"!ͺ!" *#ÞL*&*&}o*&!͒}oEL!}2!ͺ! " E*&*&!͒}oE3M!}2!ͺ! " E!ͺ! "!"!J"*R"!!R" D" ! !)")"+"-"/!"*)*-*!KEM̈́*+*/!):͛!ͪ *)*-*!EN!"k*+*/!):͛!ͪ *)*-̈́!!o&}2*!"*&!  ]OEʙMk*+*/!):͛!ͪ *&}21̈́*)*-*1&" ! !ժ!""""**M!!"****R**!<e.́!!͛nM}2*&!ժ ]O**}oEʞO!:*&e.=!*&͛" *!"*!EʞO͛! e.*!Rͪ *&́!͑!͑OEP*!EP*!R"!*!!͛!"! "!" *&*s*&! ]́!͑!͑&O*&! ]́!͑!͑3O*!}o}oEN*!EʓP!:!áP!:!̈́!:"> !@ !` !}2"""******R*!(e.́!!͛nM*>s*>n&! ]!` ]!@ ]OEP*>n&! ]OEqQ!}2*>n&!` ]OEʐQ!}2*>n&!@ ]OEʱQ*&}2*&" ! "*","."0"2M!!"*0*0*2*,R*2*!:e.́!!͛nM*s*n&́!0!9͛O**.}oEʷR!:*n&e.=!*n&͛" *!"*!EʷR͛! e.*.!Rͪ *n&́!͑!͑OE S*!E S*!R"!*!!͛!"! "!" *n&!  ]́!͑!͑&O*n&!  ]́!͑!͑3O*!}o}oEQ*!EʽS!:!!*!EʺS*"4S**"4̈́*4!!̈́!:͛!ͪ !!*T"&E T͛ͺYes T͛ͺNo  !!*Y"&E>T͛ͺYes KT͛ͺNo  !!*W"&EoT͛ͺYes |T͛ͺNo  !!*&ET͛ͺYes !!!͛!<"!:!ͪM!!:ͣRͪ!>" !}2U͛ͺNo  !!!!! *&E&U͛ͺYes 3U͛ͺNo  !! *&EWU͛ͺYes dU͛ͺNo  !! *&EʈU͛ͺYes ÕU͛ͺNo  !! *&EʹU͛ͺYes U͛ͺNo  !! *&EU͛ͺYes U͛ͺNo  !!*U"͛!& !!*"&E5V͛ͺYes BV͛ͺNo  !!*X"&EfV͛ͺYes sV͛ͺNo  !!*͛!& !*!*͛!& !!>k!!͛ͺ# Pascal Program Lister ͛ ͛ͺ File to list < > ͛ ͛ͺ0 Near Letter Quality ? ( ) (10,12 cpi only) ͛ͺ Proportional print ( ) ͛ͺ include Headings ? ( ) ͛ͺ list to disk ? ( ) ͛ͺ List to screen ? ( ) ͛ͺ Index numbers in text ( ) ͛ͺ Print cross index ( ) ͛ͺ Included files ( ) ͛ͺ Number lines ( ) ͛ͺ Char Per Inch<10,12,17>:  ͛ͺ Double_Strike ? ( ) ͛ͺ Emphasized ? ( ) ͛ ͛ͺ- Starting Page : Ending Page :  ͛ ͛ ͛ͺ Options:  ̈́͛!E" k͛ͺ dit  ̈́͛!P" k͛ͺrint ͛ͺ  ̈́͛!Q" k͛ͺ uit  ̈́͛!D" k͛ͺir ͛ ͛ͺ Command > M!Ԧ!:ͣ!͒Eʐ[!!n&́!A!Z͛O}oEZ!!!!!n&́!A!Z͛O!:ͣ!}oEʡZ!:ͣ!͒Eʐ[!"Ҧ!Ԧ:!*Ҧn&e.=!Ԧ*Ҧ!"Ҧ!*Ҧn&́! ͑!,͑O*Ҧ!:ͣ}oE)[!Ԧ:!!Ԧ:ͣ!E[!.e.!Ԧ:Ͳ"Ц*Ц!͒E[!Ԧ*Ц!!Ԧ:M.LST=!!:!"Ħ*ĦRa\!!!!!:!R ]!r ]!2 ]!͏N!maR¾\!!!*T"&́!Y͑!y͑́!N͑!n͑!r ]!2 ]!ͯP}2T"maR]!!!*Y"&́!Y͑!y͑́!N͑!n͑!r ]!2 ]!ͯP}2Y"maRx]!!!*W"&́!Y͑!y͑́!N͑!n͑!r ]!2 ]!ͯP}2W"maR]!!!*&́!Y͑!y͑́!N͑!n͑!r ]!2 ]!ͯP}2maR%^!!"!!!:!R ]!r ]!2 ]!͏N!maR‚^!! !*&́!Y͑!y͑́!N͑!n͑!r ]!2 ]!ͯP}2maR^!! !*&́!Y͑!y͑́!N͑!n͑!r ]!2 ]!ͯP}2ma R<_!! !*&́!Y͑!y͑́!N͑!n͑!r ]!2 ]!ͯP}2ma R™_!! !*&́!Y͑!y͑́!N͑!n͑!r ]!2 ]!ͯP}2ma R_!! !*&́!Y͑!y͑́!N͑!n͑!r ]!2 ]!ͯP}2ma R6`!!!!*U"!r ]!2 ]!ͷQ"U"ma R“`!!!*"&́!Y͑!y͑́!N͑!n͑!r ]!2 ]!ͯP}2"maR`!!!*X"&́!Y͑!y͑́!N͑!n͑!r ]!2 ]!ͯP}2X"maR0a!!!!*!r ]!2 ]!ͷQ"maRma!*!!!*!r ]!2 ]!ͷQ"*U"́! ͑! ͑!͑O}oEʘa!"U"*T"&*U"́! ͑! ͑O}o}oEa! "U"*T"&Eb*Ħ!Ea!}2W"!}2!}2!}2"!}2!}2!}2X"!}2#b!}2Y"S*&́! ͑!͑OEʠb*Ħ!R"Ħ*Ħ!*&}o}o*Ħ!*T"&}o}o}oEʝb*Ħ!R"Ħìb*Ħ!"Ħ*Ħ!*&}o}o*Ħ!*T"&}o}o}oEb*Ħ!"Ħ*Ħ!E c!"Ħ*&́!͑OE'c!"Ħ*Ħ!E\ße"*!"!r*+)))M !! fzc"!r*+)))!r*+))):!**!R! +n&e.= *#wc!r*+)))!r*+))):!.e.= ! ! fzʓd"!r*+)))!r*+))):!**!R! +n&e.= *#'de"Ң"Ԣ!r*Ԣ+))): !!r*Ԣ+)))!r*Ң+))): !r*Ң+)))!: "!}2֢!*fzʔe"ע!r*ע+))):!r*ע!R+))):Eʋe*ע*ע!R͗d!}2֢*ע#*e*֢&Ee"""¦>͛ͺWhich drive A or B... < > **!!M< >́!A͑!a͑!B͑!b͑!͑! ͑nM}2!"!"*&!AELf!\!+!s*&!BEof!\!+!s*&! Eʒf!\!+!s*&!͒Eʯh!! fzf"!\*+!?s*#ïf! !$fzg"!\*+!s*#f>!!o&"!!\o&"*!EDg*!;c!!\o&"*!"*!Eg*!;c*!ͥEDg>*͔d!*!*fz"h"!r*+))):͛!ͪ *!É!͑!͑OEh͛ͺ :  h͛ *#îg͛ **! !"!*͛ͺ! Press any key to continue... < > **!! M< >́!!͛nM}2́!͑! ͑! ͑! ͑!͑!͑!͑!͑ !! ]́!͑!͑& !ŕ!͑!͑! ͑ !2́! !z͛ !RZ!ͲVS!}2!:ͣ!Eyi!E}2*&!EEʎi \*&!DEʵi!!! 8cͲVS!!!!!>e.́!E͑!e͑!D͑!d͑!Q͑!q͑!P͑!p͑nM}2*&́!Q͑!P͑OEyi""!n&!4EVj!!Æj!&n&!Eyj!!Æj!!!,!͈!,!͈}oEj*!*s'k*!Ej!"j*!Ej!"**n&!|g}o*!@|g}os!!:ͣ!Eʉk!!:ͣfzʉk"!*!*n&s*#!:!!: !y!!:ͣ!E$l!"o!*on&!y ]OEl*o!"ol!*o!*o!:ͣEk!:!!:!o!o:ͣ"c!"e*e*c͸!o*en&! }oEʓl*e!"e[l!o:*e*c*eR!k!o!o:!c!c:(k!c*Ȼ!Etp!*Ȼfztp"Y!}2/!ʻ*Y+))))):#!2!2:!c:Ͳ!͒E^o!}2/!2:!c:Ͳ!͒Eʺm!c!2:!c:Ͳ!Rn&́!A!Z͛!0!9͛!_͑OEʺm!}2/!2:!c:Ͳ!2:ͣ!c:ͣE?n!c!2:!c:Ͳ!2:ͣn&́!A!Z͛!0!9͛!_͑!'͑OE?n!}2/!2:!c:Ͳ!͒E^o!"0!!2:!c:ͲfzGo"W!c*Wn&!{!c*Wn&!(!c*W!n&!*}o}oEn*0!"0!c*Wn&!}!c*Wn&!*!c*W!n&!)}o}oE>o*0!R"0*W#xn*0!͒E^o!}2/*/&Ekp*!Eʲo*!"!*+))*Ys#r!*+))*s#r*&Ekp!ʻ*Y+)))))$^#V!!2#;!":M{PG=!2:=!}e.=! ":=!!ʻ*Y+))))):!c:Ͳ!ʻ*Y+))))):ͣ !:(k!c*Y#lM PROCEDURE !c:Ͳ!͒M FUNCTION !c:Ͳ!͒}oEʗs!{e.!c:ͲM PROCEDURE !c:ͲM FUNCTION !c:Ͳ!{e.!c:Ͳ!}o*Ȼ!d}oEʗsM PROCEDURE !c:ͲM FUNCTION !c:Ͳ"W*Ȼ!"Ȼ!c*Wn&}2V*W!"W*V&! *W!c:ͣ}oEqq*W!c:ͣ͸Er!c*Wn&}2V*W!"W*V&! ͒*W!c:ͣ}oEq*W!c:ͣ͸Eʗs*V&e.#!2!2:!c*Wn&e.=#!2*W!"W!c*Wn&́!A!Z͛!a!z͛!0!9͛!_͑O}o*W!c:ͣ}o!2:ͣ!"}oE6r!ʻ*Ȼ+)))))!2:#!ʻ*Ȼ+)))))$*s#r*Ȼ!Eʗs!*Ȼ!Rfzʗs"Y!2:!ʻ*Y+))))):͍Eʎs!ʻ*Ȼ+)))))$*}/o|/g#s#r*Y#6s!/!"%*T"&E8t!/:*U"! *Y"&!!!:z)!!o&}2*&!͒Et!}2!o&!͒*&*&}o}o}oEsæu!ͺ!!:!ͪ *%!/:ͣ͸Eʚu!/*%n&!*&}oEu!/*%!n&!"!n&Et!/*%!!ls!/*%!n&! "!n&Eu!/*%!!ms!/*%n&!͒E3u!ͺ!/*%n&" !!o&}2*&!͒E_u!}2!o&!͒*&}o*&}oE3u*%!"%Mt!ͺ *&*&*&}o}o}oEuv!!!!*M(Press to continue or to quit :́!C͑!c͑!͑nM}2*&!͒Euv!!k͛ͺPress any key to stop printing  ͙!}2̈́*&*&}oEv!}2͠Eʼv!ͩ!D *&!Eʼv *&!͒Eʉv!}2*&}oE w*&}oEw!ͺ! "! " 8wM͘sM------- Page feed -------͘sM͘s*!**ͥ}o**͸}o*&}o*&*&}o}o}oEx*W"&Eʹx*!!;*&}oExM-Listing Program for Pascal Programs M' Page=!:=͘s*&}oEKxMListing File : !:=͘s*&*&}o}oEʅxMInclude File : !:=͘sÚx*&}oEʚxM͘s*&}oEʶxM͘sM͘sx*&}oEx! e.͘s! e.͘s! e.͘s! e.͘s! e.͘s"}2M!!*fzJy"!:*&e.=!*#y!:!!:!M.PO!:Ͳ"!!*!!!n&́!0!9͛O}oEy!!!!!n&́!0!9͛O!:ͣ!}oEʖy!:ͣ!Eʼz!"!*n&́!0!9͛O}oEgz!*!:ͣ*R!*!"*!:ͣEz!:!!*!Eʼz! *x!!5|*&}oE {M8 Cross Reference List͘s*&}oE"{M͘s*&}oEʈ{M* Procedure/Function Name pageM Usage lines=͘s*&}oE|M+___________________________________ ___ MD ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____=͘s*&}oE(|M͘s*!"!'"9wz!*Ȼfz0~"*!FEʀ|v!"*!"9wz!ʻ*+)))))$^#V!!;!ʻ*+))))):! !#!ʻ*+))))):ͣRx=M =!:=M =!!*fz~"!*+))^#V*E}!:ͣ!iEʺ}*&}oEu}!:͘sM- !*!"!*+))^#V!!;!:M =!:=!*#"}*&}oE~!:͘s*!"*#L|v*!"!"!.e.!:(kͲ́!!͛OEʇM.PO!:(kͲ́!!͛OEʫ~!:(kcy!}2M.PA!:(kͲ́!!͛OE~!}2!}2M.HE!:(kͲ́!!͛OM.PN!:(kͲ́!!͛O}oM.MT!:(kͲ́!!͛O}oM.MB!:(kͲ́!!͛O}oM.OP!:(kͲ́!!͛O}oEʽ!}2W"!}2M.LH!:(kͲ́!!͛OM.PL!:(kͲ́!!͛O}oM.PC!:(kͲ́!!͛O}oM.CP!:(kͲ́!!͛O}oM.FM!:(kͲ́!!͛O}oM.BP!:(kͲ́!!͛O}oM.DF!:(kͲ́!!͛O}oM.RV!:(kͲ́!!͛O}oM.AV!:(kͲ́!!͛O}oM.SV!:(kͲ́!!͛O}oM.RP!:(kͲ́!!͛O}oM.DM!:(kͲ́!!͛O}oM.CS!:(kͲ́!!͛O}oM.PF!:(kͲ́!!͛O}oM.RM!:(kͲ́!!͛O}oM.LM!:(kͲ́!!͛O}oM.LS!:(kͲ́!!͛O}oM.IJ!:(kͲ́!!͛O}oM.OJ!:(kͲ́!!͛O}oM.IG!:(kͲ́!!͛O}oM.FO!:(kͲ́!!͛O}oM.FI!:(kͲ́!!͛O}oEJ!}2M.UJ!:(kͲ́!!͛OEʇ*Y"&}o}2Y"!}2!}2!}2!}2!}2MData.lst!!}2!}2!}2!}2!"Ȼ!"!}2!}2!"!'"Ͱh!!:o *&E%!!'jL*&}oEA!!'jL!!'j! !:M͠*&!Q͒}oE|͛ *&}o*&*&}o}o}oEʣ!!@e.͢ =!*U"!E!:!":=!+":=!>*U"! E!:!+":=!>!:!":=!+":=!*X"&E_!:!I":=!*"&Eʀ!:!@":=!!!:ͣfzʣ"!"*&}oEt!!o&}2*!E!!͛ͺ Turn on printer OR press  ͙!"*!E**!"!o&!͒*&!}oEʮ*&!Em!}2!}2*&}oEʚ!ͺ!*n&" *#Ñ͛ *&}oE͛!"!="!!"! "ͺ Press any key to stop printer ͙! !:o ! !͒El͛!"! "! "ͺFILE : !:!ͪͺ Not Found !"!"!"! }oE*&EʚV*&!Z}oEʶ!}2M!*&Eއ!Zͩ!D ! ͩ!D *&!|g}o}2*&!E!-}2*&! ͒EF!:*&e.=!*&E]!Z}2g! }2*&! *&}oE‡!}2!:lF~9w**EʬV**ͥ**͸}o*&}o*&*&}o}o}oEʦ*&E^*!!;!:! e.=!*!!;*&E[!:!:=! e.=!jM!*&}o*&*&}o}o}o}oEʦ!:!:=͘s*&*&}o*&}o}oM{$I!:(kͲ́!!͛OM.FI!:(kͲ́!!͛O}o}oEM{$I+!:(kͲ!M{$I-!:(kͲ!}oEM{$I!:(kͲ!M.FI!:(kͲ"!}2!:*!:ͣ*Rk!!:́! !z͛͢k!!:=l!!Z!:o !Z!͒E!}2!"*!"*!"*&EL*!"*&*!F*U"!}o}o*!7*U"!}o}o}oE**ͥ**͸}o*&}o*&*&}o}o}oEߋv!"*!"!}2~**͸Ev!"*!"!}2*&*Ȼ!͒}o*&!Q͒}oEVͽz! i *&**}oE||*&}o*&}o}o*&!Q͒}o**͸}oEό!ͺ!"":!ͪ !i  *&**}oE7v z*&Program lister; { Listing program version 2.2 31 May 1985 } {$c-} {***********************************************************} { listing program for pascal and other programs } { } { note the cross index and inline index's are only } { good when listing Pascal programs } { } { Written in : Turbo Pascal v 2.0 } { } { written by : John Lindsay } { Shrewsbury, Ma } { } { FOG 1131 } { } { Date : 4 Feb 1985 } { } { rev 1.3 10 Feb 1985 } { } { Corrected Screen printout for proper reaction } { when printer not connected. } { } { .pa in column 1..5 will cause a page feed } { } { .po n in column 1..5 will set the left margin } { to n. Default is 6 } { } { rev 2.0 8 Mar 1985 } { } { corrected directory and added various printer } { commands } { -- double Strike } { -- Emphasized } {  -- Char per inch } { -- Disable headers } { -- Tab setting } { } { also clears the 8th bit to allow printing } { wordstar files without having graphic charactors } { show up in the printout } { } { Rev 2.1 15 Mar 1985 } { } { added Near Letter Quality printout with or without } { proportional spacing in 10 or 12 cpi sizes } { } { ^BBoldface^B } { ^Sunderscore^s } { ^dDouble Strike^d all work in NLC mode } {  } { .UJ is used within text to toggle the proprotional } { spacing. } { } { Rev 2.2 31 May 1985 } { } { corrected the screen printout again and } { prevended system crash when large numbers of } { procedures are listed or called } { } {***********************************************************} {.pa} (* Note : the entire included document file is removed from the program during compiling {$I lister21.doc} *) {.pa} label exit,exit2; Const Heading = 'Listing Program for Pascal Programs '; Heading2 = 'Listing File : '; Heading3 = 'Include File : '; Page_length : integer = 88; margin : string[255] = ' '; { 6 } Boldface : boolean = false; Double_strike : boolean = false; Underline : boolean = false; Max_num_of_procedures = 100; Max_num_of_calls = 500; { change these lines to set up underline for your printer } Star_underline_on : string[5] = ^['-'^a; { esc '-' chr (1) } Star_underline_off : string[5] = ^['-'^@; { esc '-' chr (0) } { if it is not a 3 charactor sequence then the line in Print_string } { will have to be changed to match } Printer_elite_string : string[8] = ^['B'^b; Printer_setup_string : string[8] = ^o^['0'; { 17 cpi & 8 lpi } printer_reset_string : string[8] = ^['@'; { resets printer to normal } Printer_tab_string : string[20] = ^['D'^h^p^x' (08@HPX`hpx'^@; { this might need to be cleared }  { for some epson printers } printer_double_strike : string[8] = ^['G'; printer_emphasized : string[8] = ^['E'; printer_indexes_per_inch : integer = 144; { for some epson printers, this } { is 216 } Proportional_print : boolean = false; Char_per_inch : integer = 17; headings : boolean = true; Emphasized : boolean = false; Pro_print : boolean = false; Type lstr = string [255]; str255 = string [255]; soc = set of char; index = record name : string[35]; pg_num : integer; end; Calls = record Id : integer; Line : integer; end; {.pa} var F,FI,F1 : text; line : string [255]; otptr : text; i,page_line, count,time, page,n,x, program_line, include_line : integer; File_name, Disk_file_name, Include_file : string [15]; Start,Stop : integer; include,Index_in_text, included_files,Disk_file, Number_include,Screen_file, Number_lines,cross_index, PA,stopp : boolean; Ch : char; temp4 : string[4]; temp : string[255]; interupt,dot : boolean; proceed : array [1..Max_num_of_procedures] of index; num_of_procedures : integer; xref : array [1..Max_num_of_calls] of calls; xref_count : integer; {.pa} {$I letters.dat} {.pa} {$I prtpro.pas} {.pa} {$I edit.inc} {.pa} {$I lister.1} {.pa} begin cross_index := true; included_files := true; number_lines := true; number_include := false; Disk_file_name := 'Data.lst'; Index_in_text := true; include := false;  Disk_file := false; Screen_file := false; num_of_procedures := 0; xref_count := 0; interupt :=false; Pa := false; start := 1; stop :=9999; get_command; ASSIGN (F1,Disk_file_name); if Screen_file then IODIRECT (0,ADDR(F1)) ELSE if not(disk_file) then IODIRECT (3,ADDR(F1)) else IODIRECT (6,ADDR(F1)); REWRITE (F1); if (File_name <> '') and (ch <> 'Q') then begin writeln; if not(interupt) and not(screen_file or disk_file) then begin line := ^[+'@'; if char_per_inch = 17 then line := line + printer_setup_string+Printer_tab_string else if char_per_inch = 10 then line := line + Printer_tab_string else line := line + Printer_elite_string + Printer_tab_string; if emphasized then line := line + printer_emphasized; if Double_strike then line := line + printer_double_strike; for count := 1 to length(line) do begin time := 0; if not(interupt) then begin repeat ch := chr(bdos(6,255)); if time = 2000 then begin gotoxy (1,23); write (' Turn on printer OR press '); clreol; time := 2001; end; if time < 2000 then time := time + 1; until (bios(14) <> 0) or (ch = ^[); if ch = ^[ then interupt := true; ch := chr(0); end; if not(interupt) then write (f1,line[count]); end;  end; writeln; if not(screen_file) then write (chr(27),'=',chr(31+23),chr(32),' Press any key to stop printer'); clreol; {.pa} { listing program } Assign (f, file_name); {$I-} reset (F); {$I+} if ioresult <> 0 then begin writeln (^g,^j,^m,'FILE : ',file_name,' Not Found'); halt; end; Page := 1; Page_line := 1; Program_line := 1; while not EOF (f) do begin if interupt then goto exit; if include and EOF (FI) then include := false; line := ''; repeat if include then read (FI,ch) else read (F,ch); ch := chr(ord(ch) and $7F); if ord(ch) = $1F then ch := chr($2D); { convert soft hyphins to real ones } if ord(ch) <> $0A then line := line + ch; if include then stopp := eof(FI) else stopp := eof(F); until (ord(ch) = $0A) or stopp; dot := false; compair (line); filter; print_header; if page > stop then goto exit; if (page>= start) and (page <= stop) and (not(include) or (include and included_files)) then begin if Number_lines then begin str (program_line:4,temp4); temp := temp4+' '; str (include_line:4,temp4); if include then temp := temp + temp4+' '; end else temp := ''; if not(interupt) and not(dot and not(number_lines)) then print_string (temp + line); end; {.pa} if (Included_files or (not(included_files) and number_include)) and  ((pos ('{$I',string_upper_case(line)) in [1..2]) or (pos('.FI',string_upper_case(line)) in [1..5])) then if (pos ('{$I+',string_upper_case(line)) = 0) and (pos ('{$I-',string_upper_case(line)) = 0) then begin x := pos ('{$I',string_upper_case(line)) + 3 + pos ('.FI',string_upper_case(line)); include := true; Include_file := copy(line,x,length(line)-x); include_file := FilterStr(Include_file,[' '..'z']); include_file := TrimL (Include_file); assign (FI,include_file); {$I-} reset (FI); {$I+} if ioresult <> 0 then include := false; include_line := 0; end; Program_line := program_line + 1; Page_line := Page_line + 1; if include then include_line := include_line + 1; if Pa or ((Page_line > 70) and (char_per_inch = 17)) or ((Page_line > 55) and not(char_per_inch = 17)) then begin if (page >= start) and (page <= stop) and (not(include) or (include and included_files)) then Page_feed; page_line := 1; Page := Page + 1; PA := false; end;  end; if page <= stop then Page_feed; page_line := 1; Page := Page + 1; PA := false; if cross_index and (num_of_procedures <> 0) and (ch <> 'Q') then cross_reference; exit: close (f); if interupt or (page > stop) then goto exit2; end; exit2: if not(interupt) and not(screen_file) and (ch <> 'Q') and (page <= stop) then write (f1,printer_reset_string); close (F1); end. and not(char_per_inch = 17)) then begin if (page >= start) and (page <= stop) and (not(include) or (include and included_files)) then Page_feed; page_line := 1; Page := Page + 1; PA := false; end; { Global Decelerations required } VAR Arrows,arrows_m, letters,exit_list : soc; test : lstr; Function Flash (y,y1,x,x1 :integer; strng :lstr; acept :soc) : char; Const hi = 75; { Flashes information at location } lo = 150; { then gets a character at location } { only characters within are allowed } Var count : integer; ch : char; tflag : boolean; begin count :=0; repeat gotoxy(x1,y1); if count = hi then begin highvideo; gotoxy(x,y); write (strng); gotoxy(x1,y1); end; if count = lo then begin count :=0; lowvideo; gotoxy(x,y); write (strng); gotoxy(x1,y1); highvideo; end; ch := chr(bdos(6,255)); count := count + 1; until ch in acept; lowvideo; gotoxy(x,y); write (strng); flash := ch; highvideo; gotoxy (x1,y1); end; {.pa} Function Get_string2 (y,x, leng, adjust : integer; default : lstr; allowed : soc; exit : soc; Var ch : char ) :lstr; VAR a : char; { This will return a string up to the length } count : integer; { requested by at location } b : string [255]; { Flash is used to get a character and the } { char is flashed at 0 then begin count := count - 1; delete (b,count+1,1); write (chr(8),' ',chr(8)); end; ch := a; until (a in exit-[^h,^s]) or ((a in exit * [chr(8),chr(19)]) and (count = 0)); if count > 0 then get_string2 := b else get_string2 := default; highvideo; end; {.pa} Function Get_boolean (x,y,adjust : integer; default : boolean; def_true, def_false, exit : soc; var ch : char ) : boolean; begin gotoxy (x,y); repeat ch := flash (y,y,x-adjust,x,'(',[chr(1)..chr(255)]); until ch in def_true+def_false+exit; if ch in def_true then get_boolean := true; if ch in def_false then get_boolean := false; if ch in exit then get_boolean := default; end; {.pa} Function Get_integer (x,y, leng, adjust : integer; default : integer; exit : soc; Var ch : char ) :integer; var count : integer; b : lstr; error : integer; begin b := ''; count := 0; repeat ch := flash (y,y,x-adjust,x+count,':',[chr(1)..chr(255)]); if ((ch in ['0'..'9'] ) and (count < leng)) then begin b := b+ch; write (ch); count := count + 1; if count = 1 then write (' ':leng-1); end; if ch in [chr(8),chr(19)] then if count > 0 then begin count := count - 1; delete (b,count+1,1); write (chr(8),' ',chr(8)); end; until (ch in exit-[^h,^s]) or ((ch in exit * [chr(8),chr(19)]) and (count = 0)); if count > 0 then begin val(b,count,error); if error = 0 then get_integer := count; end else get_integer := default; highvideo; end; {.pa} Procedure fill_in_data_for_input; begin gotoxy (17,3); highvideo; write (File_name); gotoxy (27,5); if proportional_print then write ('Yes') else write ('No ');  gotoxy (27,6); if pro_print then write ('Yes') else write ('No '); gotoxy (27,7); if headings then write ('Yes') else write ('No '); gotoxy (27,8); if Disk_file then begin write ('Yes'); gotoxy (33,8); write ('<',Disk_file_name,'':15-length(disk_file_name),'>'); Screen_file := false; end else begin write ('No '); gotoxy (33,8); clreol; end; gotoxy (27,9); if screen_file then write ('Yes') else write ('No '); gotoxy (27,10); if Index_in_text then write ('Yes') else write ('No '); gotoxy (27,11); if Cross_index then write ('Yes') else write ('No '); gotoxy(27,12); if included_files then write ('Yes') else write ('No '); gotoxy (27,13); if number_lines then write ('Yes') else write ('No ');  gotoxy (27,14); write (Char_per_inch:3); gotoxy (27,15); if double_strike then write ('Yes') else write ('No '); gotoxy (27,16); if emphasized then write ('Yes') else write ('No '); gotoxy (19,18); write (Start:4); gotoxy (42,18); write (stop:4); gotoxy (23,24); end; {.pa} procedure Input_screen; begin clrscr; lowvideo; gotoxy (1,1); writeln (' Pascal Program Lister'); writeln; writeln (' File to list < >'); writeln; writeln (' Near Letter Quality ? ( ) (10,12 cpi only)'); writeln (' Proportional print ( )'); writeln (' include Headings ? ( )'); writeln (' list to disk ? ( )'); writeln (' List to screen ? ( )'); writeln (' Index numbers in text ( )'); writeln (' Print cross index ( )'); writeln (' Included files ( )'); writeln (' Number lines ( )'); writeln (' Char Per Inch<10,12,17>: '); writeln (' Double_Strike ? ( )'); writeln (' Emphasized ? ( )'); writeln; writeln (' Starting Page : Ending Page : '); writeln; writeln; write (' Options: '); highvideo; write ('E'); lowvideo; write ('dit '); highvideo; write ('P'); lowvideo; writeln ('rint'); write (' '); highvideo; write ('Q'); lowvideo; write ('uit '); highvideo; write ('D'); lowvideo; writeln ('ir'); writeln; write (' Command >'); end; {.pa} Function Get_file_name : lstr; var name : string[15]; count : integer; command_line : string[128] absolute $80; x,y : integer; begin name := ''; if length (command_line) <> 0 then begin repeat if not(command_line[1] in ['A'..'Z']) then delete (command_line,1,1);  until (command_line[1] in ['A'..'Z']) or (length(command_line) = 0); if length(command_line) <> 0 then begin count := 1; repeat name := name + command_line[count]; count := count + 1; until (command_line[count] in [' ',',']) or (count > length(command_line)); end; end; get_file_name := name; { now create disk file name if file name is > 0 } if length(name) > 0 then begin x := pos('.',name); if x <> 0 then delete (name,x,15); disk_file_name := name + '.LST'; end; end; {.pa} Procedure Edit_data; var count : integer; begin count := 1; repeat case count of 1 : file_name := get_string2(3,17,15,1,file_name,letters,arrows_m+exit_list,ch); 2 : Proportional_print := get_boolean(27,5,1,Proportional_print,  ['Y','y'],['N','n'],arrows_m+exit_list,ch); 3 : pro_print := get_boolean(27,6,1,pro_print, ['Y','y'],['N','n'],arrows_m+exit_list,ch); 4 : Headings := get_boolean(27,7,1,headings, ['Y','y'],['N','n'],arrows_m+exit_list,ch); 5 : Disk_file := get_boolean(27,8,1,disk_file, ['Y','y'],['N','n'],arrows_m+exit_list,ch); 6 : disk_file_name := get_string2(8,34,15,1,disk_file_name,letters,arrows_m+exit_list,ch); 7 : screen_file := get_boolean(27,9,1,screen_file, ['Y','y'],['N','n'],arrows_m+exit_list,ch); 8 : index_in_text := get_boolean(27,10,1,Index_in_text, ['Y','y'],['N','n'],arrows_m+exit_list,ch); 9 : Cross_index := get_boolean(27,11,1,Cross_index, ['Y','y'],['N','n'],arrows_m+exit_list,ch); 10 : included_files := get_boolean(27,12,1,Included_files, ['Y','y'],['N','n'],arrows_m+exit_list,ch); 11 : number_lines := get_boolean(27,13,1,Number_lines, ['Y','y'],['N','n'],arrows_m+exit_list,ch); 12 : char_per_inch := get_integer(27,14,3,1,char_per_inch,arrows_m+exit_list,ch); 13 : Double_strike := get_boolean(27,15,1,Double_strike, ['Y','y'],['N','n'],arrows_m+exit_list,ch); 14 : Emphasized := get_boolean(27,16,1,Emphasized, ['Y','y'],['N','n'],arrows_m+exit_list,ch); 15 : Start := get_integer (19,18,4,2,start,arrows_m+exit_list,ch); 16 : stop := get_integer (42,18,4,2,stop,arrows_m+exit_list,ch);  end; if not(Char_per_inch in[10,12,17]) then char_per_inch := 17; if proportional_print and not(char_per_inch in [10,12]) then char_per_inch := 10; if proportional_print then begin if count = 2 then begin headings := false; cross_index := false; number_lines := false; end; double_strike := false; Disk_file := false; Screen_file := false; Emphasized := false; index_in_text := false; end else pro_print := false; fill_in_data_for_input; if ch in [^k,^e] then begin count := count - 1; if ((count = 6) and not(disk_file)) or ((count = 3) and not(proportional_print)) then count := count - 1; end else count := count + 1; if (count = 6) and not(disk_file) or ((count = 3) and not(proportional_print)) then count := count + 1; if count < 1 then count := 1; if ch in [^a] then count := 17; until (count > 16); end; {.pa} Procedure directory (x,y,lines:integer); var count, pointer : integer; storage : array [1..64] of string[12]; buffer : array [1..128] of char; fcb : array [1..36] of char absolute $5c; z,zz : integer; ch : char; procedure extract_name(pointer:integer); begin count := count + 1; storage[count] := ''; for z := 2 to 9 do storage[count] := storage[count] + buffer[z+(pointer-1)*32]; storage[count] := storage[count] + '.'; for z := 10 to 12 do storage[count] := storage[count] + buffer[z+(pointer-1)*32]; end; Procedure sort_directory (count:integer); var x : integer; valid : boolean; Procedure exchange (x1,x2:integer); var temp : string[12]; begin temp := storage[x1]; storage[x1] := storage [x2]; storage[x2] := temp; end; begin repeat valid := true; for x := 2 to count do if storage[x] < storage[x-1] then begin exchange (x,x-1); valid := false; end; until valid; end; { sort } {.pa} begin clrscr; write ('Which drive A or B... < >'); ch := upcase(flash(y,y,23,24,'< >',['A','a','B','b',^[,^m])); pointer := 1; count := 0; if ch = 'A' then fcb[1] := chr(1); if ch = 'B' then fcb[1] := chr(2); if ch = ^m then fcb[1] := chr(0); if ch <> ^[ then begin for z:= 2 to 12 do fcb[z] := '?'; for z := 13 to 36 do fcb[z] := chr(0); clrscr; { now set DMA address } z := bdos($1A,addr(buffer)); { get first directory entry } zz := bdos ($11,addr(fcb)); if zz < 4 then extract_name(zz+1); { get the rest of the directory } repeat zz := bdos ($12,addr(fcb)); pointer := pointer + 1; if zz < 4 then extract_name(zz + 1); until zz >= 4; clrscr; sort_directory (count); gotoxy (1,y); for zz := 1 to count do begin write (storage[zz]); if zz mod 3 in [1,2] then write (' : ') else writeln; end; writeln; Y := y+trunc(count/3) + 3; gotoxy (1,y); write (' Press any key to continue... < >'); ch := flash(y,Y,31,32, '< >',[chr(1)..chr(255)]); end; end; {.pa} Procedure Get_command; begin arrows := [^h,^j,^k,^l,^s,^e,^d,^x]; arrows_m := arrows-[^h,^s]; exit_list := [^a,^[,^m] ; letters := [' '..'z']; File_name := get_file_name; input_screen; fill_in_data_for_input; ch := chr(0); if length (file_name) = 0 then ch := 'E'; repeat if ch = 'E' then edit_data; if ch = 'D' then begin directory(1,1,10); input_screen; fill_in_data_for_input; end; ch := upcase(Flash(24,24,21,23,'>',['E','e','D','d','Q','q','P','p'])); until ch in ['Q','P']; end; teln; Y := y+trunc(count/3) + 3; gotoxy (1,y); write (' Press any key to continue... < >'); ch := flash(y,Y,31,32, '< >',[chr(1)..chr(255)]); end; end; {.pa} Procedure Get_comma{$V-} { turns off the length checking } {*********************************************************} Function FilterStr (InpStr : Lstr; Allowed : SOC) : Lstr; {*********************************************************} Var x : integer; begin if length(InpStr) > 0 then begin x := 1; repeat if InpStr[x] in Allowed then x := x + 1 else delete (InpStr,x,1); until x > length(InpStr); end; FilterStr := InpStr; end; {$V+} VIXENMM DOCVIXENMM PAS--FOGCPM001const sizes : array [32..127] of byte = { } (9,1,4,9,7, {%} 7,8,4,3, {)} 3,7,7,4,5, {.} 4,6,9,9, {2} 9,9,9,9,9, {7} 9,9,9,7, {;} 4,6,6,5,7, {@} 7,7,8,7, {D} 8,8,8,7,7, {I} 5,7,7,7, {M} 9,9,8,8,8, {R} 9,7,7,8, {V} 7,9,8,7,8, {[} 5,6,5,7, {_} 7,4,7,7,6, {d} 7,6,6,7, {h} 8,3,5,7,5, {m} 9,8,6,7, {q} 7,6,7,5,7, {v} 7,9,7,7, {z} 7,6,1,6,8, 8); let_ers : array [32..127,1..2,1..9] of byte = { } (((0,0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0,0)), { ! } ((122,0,0,0,0,0,0,0,0),(112,0,0,0,0,0,0,0,0)), { " } ((112,0,0,112,0,0,0,0,0),(96,0,0,96,0,0,0,0,0)), { # } ((40,40,124,40,40,40,124,40,40),(0,0,120,0,0,0,120,0,0)), { $ } ((50,73,73,255,73,73,38,0,0),(114,0,0,255,0,0,78,0,0)), { % } ((112,84,112,8,7,21,7,0,0),(100,0,104,0,22,0,38,0,0)), { & } ((14,48,89,81,36,2,1,0,0),(12,114,0,8,102,0,6,0,0)), { ' } ((0,160,192,0,0,0,0,0,0),(32,128,192,0,0,0,0,0,0)), { ( } ((62,0,65,0,0,0,0,0,0),(60,66,0,0,0,0,0,0,0)), { ) } ((65,0,62,0,0,0,0,0,0),(0,66,60,0,0,0,0,0,0)), { * } ((0,36,0,126,0,36,0,0,0),(68,0,40,124,40,0,68,0,0)), { + } ((0,0,0,126,0,0,0,0,0),(16,16,16,124,16,16,16,0,0)), { , } ((0,3,3,0,0,0,0,0,0),(0,3,2,0,0,0,0,0,0)), { - } ((8,8,8,8,8,0,0,0,0),(8,8,8,8,8,0,0,0,0)), { . } ((0,3,3,0,0,0,0,0,0),(0,2,2,0,0,0,0,0,0)), { / }  ((2,6,12,24,48,96,0,0,0),(2,4,8,16,32,64,0,0,0)), { 0 } ((0,0,62,65,65,65,62,0,0),(0,0,60,66,0,66,62,0,0)), { 1 } ((0,0,1,1,127,1,1,0,0),(0,0,0,64,126,0,0,0,0)), { 2 } ((0,35,1,69,65,73,65,51,0),(0,2,68,0,8,0,80,98,0)), { 3 } ((0,66,65,65,81,97,72,70,0),(0,2,0,0,32,16,66,12,0)), { 4 } ((0,24,8,40,9,127,9,8,0),(0,16,32,0,64,126,0,0,0)), { 5 } ((0,114,64,65,65,65,72,70,0),(0,112,18,16,16,16,2,12,0)), { 6 } ((0,62,0,81,81,81,0,46,0),(0,60,82,0,0,0,82,12,0)), { 7 } ((0,96,67,68,64,72,64,112,0),(0,64,6,0,8,0,16,96,0)), { 8 } ((0,54,0,73,73,73,0,54,0),(0,36,90,0,0,0,90,36,0)), { 9 } ((0,48,0,72,73,73,0,62,0),(0,32,80,0,0,0,82,60,0)), { : } ((0,54,54,0,0,0,0,0,0),(0,36,36,0,0,0,0,0,0)), { ; } ((1,54,54,0,0,0,0,0,0),(0,38,36,0,0,0,0,0,0)), { < } ((0,24,0,36,0,66,0,0,0),(16,0,40,0,68,0,0,0,0)), { = } ((36,36,36,36,36,0,0,0,0),(0,0,0,0,0,0,0,0,0)), { > } ((66,0,36,0,24,0,0,0,0),(0,68,0,40,0,16,0,0,0)), { ? } ((64,128,128,153,128,160,96,0,0),(0,128,0,26,32,128,192,0,0)), { @ } ((62,65,65,89,65,65,57,0,0),(126,0,0,0,40,40,112,0,0)), { A } ((31,33,0,64,0,33,31,0,0),(62,8,72,8,72,8,62,0,0)), { B } ((65,127,73,73,73,73,57,6,0),(0,126,0,0,0,0,112,14,0)), { C } ((62,0,65,65,65,0,98,0,0),(60,66,0,0,0,66,0,0,0)), { D } ((65,127,65,65,65,65,0,62,0),(0,126,0,0,0,0,66,54,0)), { E } ((65,127,73,73,73,73,65,65,0),(0,126,00,00,00,24,0,66,0)), { F } ((65,127,73,72,72,72,64,64,0),(0,126,0,0,0,24,0,64,0)), { G } ((62,0,65,73,73,8,46,0,0),(60,66,0,0,0,66,8,0,0)), { H } ((127,8,8,8,8,8,127,0,0),(126,0,0,0,0,0,126,0,0)), { I }  ((65,65,127,65,65,0,0,0,0),(0,0,126,0,0,0,0,0,0)), { J } ((6,0,1,1,64,126,64,0,0),(4,2,0,0,2,124,0,0,0)), { K } ((127,89,0,36,64,67,1,0,0),(126,16,40,0,68,0,2,0,0)), { L } ((65,127,65,1,1,1,1,0,0),(0,126,0,0,0,0,2,0,0)), { M } ((127,64,32,0,16,0,32,64,127),(126,64,0,32,0,32,0,64,126)), { N } ((127,0,16,0,8,0,4,0,127),(126,32,0,16,0,8,0,4,126)), { O } ((62,0,65,65,65,65,0,62,0),(60,66,0,0,0,0,66,60,0)), { P } ((65,127,5,68,68,68,0,56,0),(0,126,64,0,0,0,72,48,0)), { Q } ((62,0,65,65,69,67,6,59,0),(60,66,0,0,4,4,66,56,0)), { R } ((65,127,9,72,72,76,1,51,1),(0,126,64,0,0,8,84,34,0)), { S } ((50,73,73,73,73,73,38,0,0),(114,0,0,0,0,0,78,0,0)), { T } ((64,64,65,127,65,64,64,0,0),(64,0,0,126,0,0,64,0,0)), { U } ((126,64,1,1,1,1,64,126,0),(124,2,0,0,0,0,2,124,0)), { V }  ((124,2,0,1,0,2,124,0,0),(124,0,2,0,2,0,124,0,0)), { W } ((127,0,2,0,4,0,2,0,127),(126,2,0,4,0,4,0,2,126)), { X } ((99,4,16,8,8,16,4,99,0),(70,32,8,16,16,8,32,70,0)), { Y } ((64,0,33,31,33,0,64,0,0),(0,64,0,62,0,64,0,0,0)), { Z } ((99,69,65,73,65,81,65,99,0),(70,0,8,0,16,0,32,64,0)), { [ } ((127,65,65,65,65,0,0,0,0),(126,0,0,0,0,0,0,0,0)), { \ } ((96,48,24,12,6,2,0,0,0),(64,32,16,8,4,2,0,0,0)), { ] } ((65,65,65,65,127,0,0,0,0),(0,0,0,0,126,0,0,0,0)), { ^ } ((0,32,0,64,0,32,0,0,0),(32,0,64,0,64,0,32,0,0)), { _ } ((0,0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0,0)), { ` } ((0,128,192,0,0,0,0,0,0),(0,128,128,64,0,0,0,0,0)), { a } ((2,21,21,21,16,14,1,0,0),(6,0,0,0,10,30,2,0,0)), { b } ((65,127,17,17,17,17,14,0,0),(0,126,0,0,0,0,30,0,0)), { c } ((14,17,17,17,17,26,0,0,0),(30,0,0,0,0,18,0,0,0)), { d } ((14,17,17,17,17,127,65,0,0),(30,0,0,0,0,126,0,0,0)), { e } ((14,21,21,21,21,8,0,0,0),(30,0,0,0,0,26,0,0,0)), { f } ((1,63,64,64,64,0,0,0,0),(16,126,16,16,16,64,0,0,0)), { g } ((14,17,17,17,1,31,16,0,0),(30,0,0,0,16,31,0,0,0)), { h } ((65,127,16,16,16,17,15,1,0),(0,126,0,0,0,0,30,0,0)), { i } ((17,95,1,0,0,0,0,0,0),(0,94,0,0,0,0,0,0,0)), { j } ((1,0,0,16,95,0,0,0,0),(0,1,1,1,94,0,0,0,0)), { k } ((65,127,8,0,20,1,3,0,0),(0,126,0,24,0,36,2,0,0)), { l } ((1,65,127,1,1,0,0,0,0),(0,0,126,0,0,0,0,0,0)), { m } ((31,0,0,0,15,0,0,0,15),(30,16,16,16,14,16,16,16,30)), { n } ((17,31,0,0,0,0,15,0,0),(0,30,16,16,16,16,30,0,0)), { o } ((14,17,17,17,17,14,0,0,0),(30,0,0,0,0,30,0,0,0)), { p } ((16,31,1,17,17,17,14,0,0),(0,31,16,0,0,0,30,0,0)), { q } ((14,17,17,17,1,31,16,0,0),(30,0,0,0,16,31,0,0,0)), { r } ((31,0,16,16,16,0,0,0,0),(30,16,0,0,0,16,0,0,0)), { s } ((11,21,21,21,21,21,26,0,0),(26,0,0,0,0,0,22,0,0)), { t } ((16,16,127,17,16,0,0,0,0),(0,0,126,0,0,0,0,0,0)), { u } ((30,1,1,1,1,30,1,0,0),(30,2,0,0,2,30,2,0,0)), { v } ((28,2,0,1,0,2,28,0,0),(28,0,2,0,2,0,28,0,0)), { w } ((30,17,1,1,6,1,1,17,30),(30,0,0,0,14,0,0,0,30)), { x } ((17,10,0,4,0,10,17,0,0),(18,0,12,0,12,0,18,0,0)), { y } ((28,0,2,0,0,31,16,0,0),(8,4,0,2,2,31,0,0,0)), { z } ((17,19,17,21,17,25,17,0,0),(2,0,4,0,8,0,16,0,0)), ((8,8,54,65,65,65,0,0,0),(0,24,102,0,0,0,0,0,0)), { | } ((127,0,0,0,0,0,0,0,0),(126,0,0,0,0,0,0,0,0)), ((65,65,65,54,8,8,0,0,0),(0,0,0,102,24,0,0,0,0)), { ~ }  ((8,24,16,24,12,4,12,8,0),(0,16,32,16,8,4,8,0,0)), { } ((0,0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0,0))); ,16,16,16,0,0,0,0),(30,16,0,0,0,16,0,0,0)), { s } ((11,21,21,21,21,21,26,0,0),(26,0,0,0,0,0,22,0,0)), { t } ((16,16,127,17,16,0,0,0,0),(0,0,126,0,0,0,0,0,0)), { u } ((30,1,1,1,1,30,1,0,0),(30,2,0,0,2,30,2,0,0)), { v } ((28,2,0,1,0,2,28,0,0),(28,0,2,0,2,0,28,0,0)), { w } ((30,17,1,1,6,1,1,17,30),(30,0,0,0,14,0,0,0,30)), { x } ((17,10,0,4,0,10,17,0,0),(18,0,12,0,12,0,18,0,0)), { y } ((28,0,2,0,0,31,16,0,0),(8,4,0,2,2,31,0,0,0)), { z } ((17,19,17,21,17,25,17,0,0),(2,0,4,0,8,0,16,0,0)), ((8,8,54,65,65,65,0,0,0),(0,24,102,0,0,0,0,0,0)), { | } ((127,0,0,0,0,0,0,0,0),(126,0,0,0,0,0,0,0,0)), ((65,65,65,54,8,8,0,0,0),(0,0,0,102,24,0,0,0,0)), { ~ } procedure iodirect (index_value : integer; File_address : integer); { io-redirection } var version : real; begin { 0 = CON: } { 1 = TRM: } { 2 = KBD: } { 3 = LST: } { 4 = AUX: } { 5 = USR: } { 6 = DISK } { See page 158 for more details } { note Version 3.0 of turbo has redefined these numbers } { we must check the version numbers before } { redirecting the output } { page 280 in the 3.0 manual } if mem[$103] = $34 then version := 1 else if mem[$126] = $82 then version := 2 else version := 3; if (version = 1) or (version = 2) then mem[file_address+1] := index_value else begin if index_value = 0 then index_value := 1 else if index_value = 6 then index_value := 0; mem[file_address] := (mem[file_address] and $F0) + index_value or $40; end; end; {*******************************************************************} { example : } { assign (F,'test1.dat'); } { iodirect (0,addr (F)); } { rewrite (F); } { } { assigns output for file F be directed to the console } {*******************************************************************} Function String_upper_case (sttr:lstr) :lstr; var x : integer; begin if length(sttr) > 0 then for x := 1 to length(sttr) do sttr[x] := upcase(sttr[x]); String_upper_case := sttr; end; {.pa} {$V-} { turns off the length checking } {*********************************************************} Function FilterStr (InpStr : Lstr; Allowed : SOC) : Lstr; {*********************************************************} Var x : integer; begin if length(InpStr) > 0 then begin x := 1; repeat if InpStr[x] in Allowed then x := x + 1 else delete (InpStr,x,1); until x > length(InpStr); end; FilterStr := InpStr; end; {***********************************} Function TrimL (InpStr : Lstr) :Lstr; {***********************************} var i,len : integer; begin len := Length (InpStr); i := 1; while (I<= len) and (InpStr[i] = ' ') do I := I + 1; TrimL := copy(InpStr,i,len-i+1); end; {$V+} {.pa} Procedure Compair (STTR : lstr); var x,xx : integer; test_ch : char; temp : string[35]; comment_count : integer; true_procedures : boolean; begin sttr := string_upper_case (sttr); if num_of_procedures > 0 then for x := 1 to num_of_procedures do begin true_procedures := false; temp := proceed[x].name; if pos(temp,sttr) <> 0 then { only if the key work is there } begin true_procedures := true; if pos(temp,sttr) <> 1 then if sttr[pos(temp,sttr)-1] in ['A'..'Z','0'..'9','_'] then true_procedures := false; if (pos(temp,sttr) + length(temp)) < length (sttr) then if sttr[pos(temp,sttr)+length(temp)] in ['A'..'Z','0'..'9','_',chr(39)] then true_procedures := false; if pos(temp,sttr) <> 1 then { is it a comment? } begin comment_count := 0; for xx := 1 to pos(temp,sttr) do begin if (sttr[xx] = '{') or ((sttr[xx] = '(') and (sttr[xx+1] = '*')) then comment_count := comment_count + 1; if (sttr[xx] = '}') or ((sttr[xx] = '*') and (sttr[xx+1] = ')')) then comment_count := comment_count - 1; end; if comment_count <> 0 then true_procedures := false; end; end; if true_procedures then begin if xref_count < max_num_of_calls then begin xref_count := xref_count + 1; xref[xref_count].id := x; xref[xref_count].line := program_line; end; { insert page number into string (line) } if Index_in_text then begin str (proceed[x].pg_num:3,temp); insert (star_underline_on+'{PG'+temp+'}'+star_underline_off,line, pos(proceed[x].name,sttr)+length(proceed[x].name)); sttr := string_upper_case (line); end; end; end; {.pa} { look for any procedure calls now } {} if (pos('PROCEDURE ',STTR) <> 0) OR {} (pos('FUNCTION ',STTR) <> 0) then {} if ((pos('{',sttr) > pos('PROCEDURE ',sttr)+ pos('FUNCTION ',sttr)) or (pos ('{',sttr) = 0)) and (num_of_procedures < Max_num_of_procedures) then begin { Add procedure name to the list } {} xx := pos('PROCEDURE ',sttr) + pos ('FUNCTION ',sttr); num_of_procedures := num_of_procedures + 1; repeat { find first space after leader } test_ch := sttr[xx]; xx := xx+1; until (test_ch = ' ') or (xx > length(sttr)); if xx <= length(sttr) then repeat { find first non-space } test_ch := sttr[xx]; xx := xx+1;  until (test_ch <> ' ') or (xx > length(sttr)); if xx <= length (sttr) then { gather name } begin temp := test_ch; repeat temp := temp + sttr[xx]; xx := xx+1; until (not(sttr[xx] in ['A'..'Z','a'..'z','0'..'9','_'])) or (xx>length(sttr)) or (length(temp) > 34); { name now filled in } proceed[num_of_procedures].name := temp; proceed[num_of_procedures].pg_num := page; if num_of_procedures > 1 then for x := 1 to num_of_procedures -1 do if temp = proceed[x].name then proceed[num_of_procedures].pg_num := -page; end; end; end; {.pa} procedure print_string (sstr :lstr); Var x : integer; begin x := 1; if proportional_print then  begin print_proportional (sstr,char_per_inch = 10,pro_print,false,margin); repeat ch := chr (bdos(6,255)); if ch <> chr (0) then interupt := true; until (bios(14) <> 0) or not(screen_file or disk_file); { check of lst status if printing } end else begin write (f1,margin); {margin added to be compatable with wordstar printouts } while x <= length (sstr) do begin if (sstr[x] = ^[) and (screen_file) then { these lines must be changed if the underline string is less than 3 charactors } begin if sstr[x+2] = star_underline_on[3] then sstr[x+1] := 'l'; if sstr[x+2] = star_underline_off[3] then sstr[x+1] := 'm'; end; if sstr[x] <> ^s then { prevent deselecting printer } write (F1,sstr[x]); repeat ch := chr (bdos(6,255)); if ch <> chr (0) then interupt := true; until (bios(14) <> 0) or screen_file or disk_file; { check of lst status if printing } x := x + 1; end; writeln (F1); end; if interupt and not(screen_file or disk_file) then begin ch := flash (23,23,1,42,'Press to continue or to quit :',['C','c',chr(27)]); if ch <> chr(27) then begin gotoxy(1,23); lowvideo; write ('Press any key to stop printing ');clreol; interupt := false; highvideo; end; end; if interupt and (screen_file) then begin repeat ch := chr(0); if keypressed then begin read(kbd,ch); if ch = ^c then halt; { note this ends program }  end; until ch <> chr(0); interupt := false; end; end; {.pa} Procedure Page_feed; Var n : integer; begin if not(screen_file) then begin if not(interupt) then write (f1,^m,^l); end else begin print_string(''); print_string ('------- Page feed -------'); print_string(''); end; end; Procedure Print_header; begin if (Page_line = 1) and (page >= start) and (page <= stop) and (not(include) or (include and included_files)) then if headings then begin str(page:4,temp4); if not(interupt) then print_string (heading+' Page'+ temp4); if not(interupt) then print_string (heading2+file_name); if include and not(interupt) then print_string (heading3+include_file) else if not(interupt) then print_string (''); if not(interupt) then begin print_string (''); print_string (''); end; end else if not(interupt) then begin print_string (' '); print_string (' '); print_string (' '); print_string (' '); print_string (' '); end; end; {.pa} Function Fill_string (ch : char; count : integer):lstr; var temp : lstr; x : integer; begin temp := ''; for x := 1 to count do temp := temp + ch; fill_string := temp; end; Procedure Set_margin (line:lstr); var i,x : integer; begin x := pos('.PO',line); delete (line,1,x+2); repeat if not(line[1] in ['0'..'9']) then delete (line,1,1); until (line[1] in ['0'..'9']) or (length(line) = 0); if length(line) > 0 then begin x := 1; repeat if not(line[x] in ['0'..'9']) then delete (line,x,length(line)-x+1); x := x+1; until x > length(line); val (line,x,i); if i = 0 then { 0 = no error } margin := fill_string (' ',x); end; end; {.pa} procedure Cross_reference; var x,y : integer; Procedure New_page_header; begin if not(interupt) then print_string (' Cross Reference List'); if not(interupt) then print_string (''); if not(interupt) then print_string (' Procedure/Function Name page'+ ' Usage lines'); if not(interupt) then print_string ('___________________________________ ___ '+ ' ____ ____ ____ ____ ____ ____ ____ ____ ____ ____ ____'); if not(interupt) then print_string (''); page_line := page_line + 5; end; begin stop := 10000; print_header; new_page_header; for x := 1 to num_of_procedures do begin if page_line > 70 then begin page_feed; page_line := 1; page := page + 1; print_header; new_page_header; end; str (proceed[x].pg_num:3,temp); temp := proceed[x].name+fill_string(' ',35-length(proceed[x].name))+' '+temp+' '; for y := 1 to xref_count do if xref[y].id = x then begin if length(temp)>105 then begin if not(interupt) then print_string(temp); temp := ' '; page_line := page_line + 1; end; str(xref[y].line:4,temp4); temp := temp + ' '+temp4; end; if not(interupt) then print_string (temp); page_line := page_line + 1; end; page_feed; page := page + 1; page_line := 1; end; {.pa} Procedure Filter; begin if pos('.',string_upper_case(line)) in [1..5] then begin if (pos('.PO',string_upper_case(line)) in [1..5]) then begin set_margin(string_upper_case(line)); dot := true; end; if pos('.PA',string_upper_case(line)) in [1..5] then begin pa := true; dot := true; end; if (pos ('.HE',string_upper_case(line)) in [1..5]) or (pos ('.PN',string_upper_case(line)) in [1..5]) or (pos ('.MT',string_upper_case(line)) in [1..5]) or (pos ('.MB',string_upper_case(line)) in [1..5]) or (pos ('.OP',string_upper_case(line)) in [1..5]) Then begin headings := false; dot := true; end; if (pos ('.LH',string_upper_case(line)) in [1..5]) or (pos ('.PL',string_upper_case(line)) in [1..5]) or (pos ('.PC',string_upper_case(line)) in [1..5]) or (pos ('.CP',string_upper_case(line)) in [1..5]) or (pos ('.FM',string_upper_case(line)) in [1..5]) or (pos ('.BP',string_upper_case(line)) in [1..5]) or (pos ('.DF',string_upper_case(line)) in [1..5]) or (pos ('.RV',string_upper_case(line)) in [1..5]) or (pos ('.AV',string_upper_case(line)) in [1..5]) or (pos ('.SV',string_upper_case(line)) in [1..5]) or (pos ('.RP',string_upper_case(line)) in [1..5]) or (pos ('.DM',string_upper_case(line)) in [1..5]) or (pos ('.CS',string_upper_case(line)) in [1..5]) or (pos ('.PF',string_upper_case(line)) in [1..5]) or (pos ('.RM',string_upper_case(line)) in [1..5]) or (pos ('.LM',string_upper_case(line)) in [1..5]) or (pos ('.LS',string_upper_case(line)) in [1..5]) or (pos ('.IJ',string_upper_case(line)) in [1..5]) or (pos ('.OJ',string_upper_case(line)) in [1..5]) or (pos ('.IG',string_upper_case(line)) in [1..5]) or (pos ('.FO',string_upper_case(line)) in [1..5]) or (pos ('.FI',string_upper_case(line)) in [1..5]) then begin dot := true; end; if pos ('.UJ',string_upper_case(line)) in [1..5] then begin pro_print := not(pro_print); dot := true; end; end; end; er_case(line)) in [1..5]) or (pos ('.CS',string_upper_case(line)) in [1..5]) or (pos ('.PF',string_upper_case(line)) in [1..5]) or (pos ('.RM',string_upper_case(line)) in [1..5]) or (pos ('.LM',string_upper_case(line)) in [1..5]) or (pos ('.LS',string_upper_case(line)) in [1..5]) or (pos ('.IJ',string_upper_cas The Lister program was written in Turbo Pascal to print out pascal programs. It has grown into a rather large and complex program doing many more things than I had originally invisioned. Among the variety of things which this program does is the orig inal which is to print out a pascal program in a condensed for mat. This means that up to 70 lines per page are put on the paper. A page feed can be forced by the .PA command which word star uses. Remember however that in pascal source code these must be commented out( "{.PA}" for example ). Part of the appeal of the Turbo Pascal package is that the modules can remain small, and still produce a very large program. It is this ability to "Include" files into larger programs which required the listing program to do the same thing. To help the programmer, the listing program separates the modules using a dual line number scheme which numbers the entire program continuously and also numbers each included module. You can always find out what line a change is needed because the line number within the module is listed correctly. Anothe proble fo pasca programmer i th locatio o th call t procedure an function whic cros pag boundrie o th listing W jus can' see t fin th refer ence modul o code T hel this th listin progra insert int th listing th cross-referenc pag numbe wher th reference procedur o functio ca b located I addition th las pag o th listin i cros inde o eac functio o procedur } wher i ca b foun an eac lin numbe i th mai progra wher th procedur o functio i called Thi i don activel a lis tim s tha an progra changes(re-arrangements ar correctl refer enced. Note th surroundin th word {Function an {Procdure preven th listin progra fro usin thes a tru declarations. .pa To complete the first stage of the program, a very friendly menu was developed to interact with the user. To use this program Type "LISTER21 program.ext" or "LISTER21" When the program name is included, the command line is used to fill in the information into the program to be listed variable and the menu asks whether you want to Edit, Print, Directory, or Quit. If the program name is not included, the same menu appears, however you are defaulted into the edit option to enter the required file to list. Answer most questions with a "Y" or "N" key press and the cursor will advance to the next question. Numbers require that a number be entered. An Up or Down arrow key will move the cursor in the proper direction. The return key will accept the default answer just as a down arrow does. With this system, the user can wander up and down the input screen changing anything he wants, during the editing phase. During the printing process, the printing can be suspended at anytime by pressing any key on the keyboard. The printing can be continued or aborted from that location with another keypress as directed by the screen. This can be most useful when answering the telephone. .pa The Addition of Near Letter Quality print was an afterthought which has proven to be extremely useful. Since it is one of the menu options, it can be specified easily. The documentation of a program can be included within the source code listing as this one is and still be listed out separately, by specifying the starting and ending pages which you wish to list. For the final star in the program, true proportional spacing was added to give documents the type set look. This feature is menu selected, and can be specified within the listing with the .UJ command (Just like wordstar). This program was developed for the Gemini 10x printer. This printer copies many of the Epson command codes However there are some exceptions. The NLQ mode was generated using graphic capa bilities which both the Epson and Gemini printers have. The spacing however on some Epson printers allows for 216 increment per vertical inch. The Gemini printer has 144 increment per inch. A constant in the program labeled printer_indexes_per_inch is used to set the correct number for the printer being used. Another source of problem is the method of setting the tab loca tions. If you are getting junk on the first line of the print out, then set the tab string to a nul string ( '' ). This concludes the document file, I hope you enjoy this program. JSL s menu selected, and can be specified within the listing with the .UJ command (Just like wordstar). This program was{$A-} procedure print_proportional (line : str255; cpi10,Pro_print,Skip_tag: boolean;margin:str255); label continue,loop1,loop2,loop3,loop4,exit; const gee : array[1..2,1..9] of byte = ((0,1,1,1,1,2,0,0,0),(0,0,0,0,0,2,0,0,0)); wye : array[1..2,1..9] of byte = ((0,1,1,1,1,2,0,0,0),(0,0,0,0,0,2,0,0,0)); pee : array[1..2,1..9] of byte = ((0,3,1,0,0,0,0,0,0),(0,2,0,0,0,0,0,0,0)); que : array[1..2,1..9] of byte = ((0,0,0,0,1,3,0,0,0),(0,0,0,0,0,2,0,0,0)); usc : array[1..2,1..9] of byte = ((1,1,1,1,1,1,1,1,1),(0,0,0,0,0,0,0,0,0)); dol : array[1..2,1..9] of byte = ((0,0,0,2,0,0,0,0,0),(0,0,0,0,0,0,0,0,0)); com : array[1..2,1..9] of byte = ((2,0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0,0)); var dots,sum,y,x,z, extra_spaces,nn : integer; charactors,xx : integer; decenders : boolean; overprint : boolean; line2 : str255; do_anyway : boolean; boldface_line : array[1..96] of byte; double_strike_line : array[1..96] of byte; underline_line : array[1..96] of byte; B_flag,D_flag : boolean; DS,BF : byte; begin if not(skip_tag) then begin b_flag := false; D_flag := false; decenders := false; for x := 1 to 96 do begin boldface_line[x] := mem[addr(boldface)] * $FF; double_strike_line[x] := mem[addr(double_strike)] * $FF; underline_line[x] := mem[addr(underline)] * $FF; end; end; if underline then decenders := true; xx := 1; line2 := ''; overprint := false; {.pa} if length(line) > 0 then repeat if line[xx] in ['g','y','p','q','_','$',','] then decenders := true; if ord(line[xx]) = $0D then if (xx+1 < length(line)) then if (ord(line[xx+1]) = $0A) then begin print_proportional (copy(line,1,xx-1),cpi10,pro_print,true,margin); line := copy (line,xx+2,length(line)); print_proportional (line,cpi10,pro_print,false,margin); program_line := program_line + 1; page_line := page_line + 1; if include then include_line := include_line + 1; goto exit; end else begin line2 := copy(line,xx+1,length(line)); line := copy (line,1,xx-1); decenders := true; overprint := true; repeat if length(line2)< length(line) then line2 := line2 + ' '; until length(line2) >= length(line); goto continue; end; case line[xx] of ^S : begin underline := not(underline); for x := xx to 96 do underline_line[x] := mem[addr(underline)] * $FF; decenders := true; end; ^D : begin Double_strike := not(Double_strike); for x := xx to 96 do Double_strike_line[x] := mem[addr(double_strike)] * $FF; D_flag := true; end; ^B : begin Boldface := not(boldface); for x := xx to 96 do boldface_line[x] := mem[addr(boldface)] * $FF; b_flag := true; end; end; if ord(line[xx]) < 32 then  delete (line,xx,1) else xx := xx+1; continue: until xx > length(line); if not(cpi10) then begin if length(line) > 95-length(margin) then line[0] := chr(95-length(margin)); end else if length(line) > 79-length(margin) then line[0] := chr(79-length(margin)); DS := $FF; BF := $FF; {.pa} loop1: charactors := length(line); dots := length(line)* 12; { assumes 10 cpi } if not(cpi10) then dots := length(line) * 10; write (lst,margin); write (lst,^[,'L',chr(dots mod $100),chr(dots div $100)); sum := 0; for x := 1 to length(line) do if cpi10 then sum := sum + sizes [ord(line[x])] + 3 else sum := sum + sizes [ord(line[x])] + 1; extra_spaces := dots - sum; do_anyway := false; for x := 1 to length(line) do begin if not (pro_print) then if sizes[ord(line[x])] < 8 then for y := 1 to ((9-sizes[ord(line[x])]) DIV 2) do write (lst,^@); for y := 1 to sizes[ord(line[x])] do if not(overprint) then write (lst,chr((let_ers[ord(line[x]),1,y]) and (((BF and DS) or Boldface_line[x]) or (DS or (BF and Double_strike_line[x]))))) else write (lst,chr(((let_ers[ord(line[x]),1,y] or let_ers[ord(line2[x]),1,y])) and (((bf and DS) or boldface_line[x]) or (DS or (BF and Double_strike_line[x]))))); if not (pro_print) then for y := 1 to (9 -sizes[ord(line[x])] -(9-sizes[ord(line[x])]) DIV 2) do write (lst,^@); if cpi10 then write (lst,^@,^@,^@) else write (lst,^@); if not (line[x] in [' ','0'..'9']) then do_anyway := true;  charactors := charactors - 1; if (extra_spaces > 0) and (not(line[x] in [' ','0'..'9']) or do_anyway) and pro_print then for y := 1 to (extra_spaces div charactors) +1 do begin write (lst,^@); extra_spaces := extra_spaces - 1; end; end; if pro_print then for y := 1 to extra_spaces do write (lst,^@); if (D_flag or B_flag) and (DS <> 0) then begin DS := 0; write (lst,^m); goto loop1; end; if b_flag and (BF <> 0) then begin BF := 0; write (lst,^m); goto loop1; end; write (lst,^m,^[,'J',^a); BF := $FF; DS := $FF; {.pa} loop2: extra_spaces := dots - sum; charactors := length(line); write (lst,margin); write (lst,^[,'L',chr(dots mod $100),chr(dots div $100)); do_anyway := false; for x := 1 to length(line) do begin if not (pro_print) then if sizes[ord(line[x])] < 8 then for y := 1 to ((9-sizes[ord(line[x])]) DIV 2) do write (lst,^@); for y := 1 to sizes[ord(line[x])] do if not(overprint) then write (lst,chr((let_ers[ord(line[x]),2,y]) and (((BF and DS) or Boldface_line[x]) or (DS or (BF and Double_strike_line[x]))))) else write (lst,chr(((let_ers[ord(line[x]),2,y] or let_ers[ord(line2[x]),2,y])) and (((bf and DS) or boldface_line[x]) or (DS or (BF and Double_strike_line[x]))))); if not (pro_print) then for y := 1 to (9 -sizes[ord(line[x])] -(9-sizes[ord(line[x])]) DIV 2) do write (lst,^@); if cpi10 then write (lst,^@,^@,^@) else write (lst,^@); if not(line[x] i n [' ','0'..'9']) then do_anyway := true; charactors := charactors - 1; if (extra_spaces > 0) and (not(line[x] in [' ','0'..'9']) or do_anyway) and pro_print then for y := 1 to (extra_spaces div charactors) +1 do begin write (lst,^@); extra_spaces := extra_spaces - 1; end; end; if pro_print then for y := 1 to extra_spaces do write (lst,^@); if (D_flag or B_flag) and (DS <> 0) then begin DS := 0; write (lst,^m); goto loop2; end; if b_flag and (BF <> 0) then begin BF := 0; write (lst,^m); goto loop2; end; if not(decenders) then write (lst,^M,^[,'J',chr(printer_indexes_per_inch Div 6-1)) else { Second stage when decenders are required } begin { print the decender part } write (lst,^m,^[,'J',^c); {down 3 half-pins} BF := $FF; DS := $FF; {.pa} loop3: write (lst,margin); write (lst,^[,'L',chr(dots mod $100),chr(dots div $100)); extra_spaces := dots - sum; charactors := length(line); do_anyway := false; for x := 1 to length(line) do begin if not (pro_print) then if sizes[ord(line[x])] < 8 then for y := 1 to ((9-sizes[ord(line[x])]) DIV 2) do if (overprint and (line2[x] = '_')) or (line[x] = '_') or (underline_line[x] = $FF) then write (lst,chr($01 and (((BF and DS) or Boldface_line[x]) or (DS or (BF and Double_strike_line[x]))))) else write (lst,^@); for y := 1 to sizes[ord(line[x])] do begin if not(line[x] in ['g','p','q','y','_','$',',']) then nn := 0 else  case line[x] of 'g' : nn := gee[1,y]; 'y' : nn := wye[1,y]; 'p' : nn := pee[1,y]; 'q' : nn := que[1,y]; '_' : nn := usc[1,y]; '$' : nn := dol[1,y]; ',' : nn := com[1,y]; end; if overprint then if line2[x] in ['g','p','q','y','_','$',','] then case line2[x] of 'g' : nn := nn or gee[1,y]; 'y' : nn := nn or wye[1,y]; 'p' : nn := nn or pee[1,y]; 'q' : nn := nn or que[1,y]; '_' : nn := nn or usc[1,y]; '$' : nn := nn or dol[1,y]; ',' : nn := nn or com[1,y]; end; write (lst,chr(((nn or ($01 and underline_line[x])) and (((BF and DS) or Boldface_line[x]) or (DS or (BF and Double_strike_line[x])))))); end; if not (pro_print) then for y := 1 to (9 -sizes[ord(line[x])] -(9-sizes[ord(line[x])]) DIV 2) do if (overprint and (line2[x] = '_')) or (line[x] = '_') or (underline_line[x] = $FF) then write (lst,chr($01 and (((BF and DS) or Boldface_line[x]) or (DS or (BF and Double_strike_line[x]))))) else write (lst,^@); {.pa} if cpi10 then if (overprint and (line2[x] = '_')) or ( line[x] = '_') or (underline_line[x] = $FF) then for z := 1 to 3 do write (lst,chr($01 and (((BF and DS) or Boldface_line[x]) or (DS or (BF and Double_strike_line[x]))))) else write (lst,^@,^@,^@)  else if (overprint and (line2[x] = '_')) or (line[x] = '_') or (underline_line[x] = $FF) then write (lst,chr($01 and (((BF and DS) or Boldface_line[x]) or (DS or (BF and Double_strike_line[x]))))) else write (lst,^@); if not(line[x] in [' ','0'..'9']) then do_anyway := true; charactors := charactors - 1; if (extra_spaces > 0) and (not(line[x] in [' ','0'..'9']) or do_anyway) and pro_print then for y := 1 to (extra_spaces div charactors) +1 do begin if (overprint and (line2[x] = '_')) or (line[x] = '_') or (underline_line[x] = $FF) then write (lst,chr($01 and (((BF and DS) or Boldface_line[x]) or (DS or (BF and Double_strike_line[x]))))) else write (lst,^@); ! extra_spaces := extra_spaces - 1; end; end; do_anyway := false; if pro_print then for y := 1 to extra_spaces do write (lst,^@); if (D_flag or B_flag) and (DS <> 0) then begin DS := 0; write (lst,^m); goto loop3; end; if b_flag and (BF <> 0) then begin BF := 0; write (lst,^m); goto loop3; end; write (lst,^m,^[,'J',^a); DS := $FF; BF := $FF; {.pa} Loop4: extra_spaces := dots - sum; charactors := length(line); write (lst,margin); write (lst,^[,'L',chr(dots mod $100),chr(dots div $100)); for x := 1 to length(line) do begin if not (pro_print) then if sizes[ord(line[x])] < 8 then for y := 1 to ((9-sizes[ord(line[x])]) DIV 2) do  write (lst,^@); for y := 1 to sizes[ord(line[x])] do begin if not(line[x] in ['g','p','q','y','_','$',',']) then nn := 0 else case line[x] of 'g' : nn := gee[2,y]; 'y' : nn := wye[2,y]; 'p' : nn := pee[2,y]; 'q' : nn := que[2,y]; '_' : nn := usc[2,y]; '$' : nn := dol[2,y]; ',' : nn := com[2,y]; end; if overprint then if line2[x] in ['g','p','q','y','_','$',','] then case line2[x] of 'g' : nn := nn or gee[2,y]; 'y' : nn := nn or wye[2,y]; 'p' : nn := nn or pee[2,y]; 'q' : nn := nn or que[2,y]; '_' : nn := nn or usc[2,y];  '$' : nn := nn or dol[2,y]; ',' : nn := nn or com[2,y]; end; write (lst,chr(nn and (((BF and DS) or Boldface_line[x]) or (DS or (BF and Double_strike_line[x]))))); end; if not (pro_print) then for y := 1 to (9 -sizes[ord(line[x])] -((9-sizes[ord(line[x])]) DIV 2)) do write (lst,^@); {.pa} if cpi10 then write (lst,^@,^@,^@) else write (lst,^@); if not(line[x] in [' ','0'..'9']) then do_anyway := true; charactors := charactors - 1; if (extra_spaces > 0) and (not(line[x] in [' ','0'..'9']) or do_anyway) and pro_print then for y := 1 to (extra_spaces div charactors) +1 do begin write (lst,^@); extra_spaces := extra_spaces - 1;  end; end; if pro_print then for y := 1 to extra_spaces do write (lst,^@); if (D_flag or B_flag) and (DS <> 0) then begin DS := 0; write (lst,^m); goto loop4; end; if b_flag and (BF <> 0) then begin BF := 0; write (lst,^m); goto loop4; end; write (lst,^M,^[,'J',chr(printer_indexes_per_inch Div 6-5)) end; exit: end; {$A+} VIXENMM DOCVIXENMM PAS--FOGCPM001 ͫCopyright (C) 1985 BORLAND IncB Osborne 1al SelectedP)(= EE RT(1)1~7#~= oͦkԄ!!"~#(}:$= +*!5!*!!:(2!5:(>2!!!:O::O:!*! !45(! +/ 0y0( d!k5!{5__o&  :(͠|(  *"x2y( >28!"9!! og2"">~22 9/4*9 Co&ͦͣ} [ (!e{ͦA8Q0G: x@!\w# (͂ ?(*( .( w^. ^!h6# (?( *( ͂( w#>?> w#ͦ 8 !ɿ .,;:=?*[]<>{}a{ |ʹ}ͽƐ'@'7||}>2ͯ*Bڨ  "og"2>2! """*B"[Ru*"^#V#^#V#N#FO/o&9O/o&9!9(> (G!9 w#Eͺw}8' RB0 >' RqRR!+ Ͱ R!+ Ͱ r!+ Ͱ r!+ Ͱ r!# Ͱ r!+ Ͱ T]KB!z> S>))0 = | |̀̀DMgo>jB0 7?= H͒<z5a)a<z {0Gɯgo||~}||/g}/o#}o&K[xAJSJDM!b"!6J"DM'd } ) W _}8(8J`9{T]=o`9y ) >' ́ ͬ͗ }>' xˆ }} ˸T}ٕ(0D=z ,= ( ͒ 0%{ , 7 ?(8ͬ x ͆ - r 8˸x ͏  ,-xG}r }مM 9r .>#n0͒ { = - nx ͇ ,-(-˸G,-r }ٕ?M 9.> 8ͬ ?= u+-(>͆ 0ͬ ͆ 8 ?x ͇ , 78ƀ8ƀ8ox٨!دoGOW_gɷɷ|لg{ً_zيWyىOxوG|ٔg{ٛ_zٚWyٙOx٘Gxٸyٹzٺ{ٻ|ټx٨ xx( ?}ٽ }ցr <(r 7{ = |٤g{٣_z٢Wy١Ox٠G{ ͬ ́ }x>' ͬ}ƀ/ƀo -́ }0͎-́ ͎,}l˸ 8 4 ͗ x( - 8́ - 8,́ }l8;*!͗ ! >4ͬ͗ ͗ ͬ--- ́ ,,,-xGg?+2n*8t z~,->' x' ͘}. ͆́ , ! >4,͢- o&0%,͗ }gr }؉}颋.:}8c~I$I~L*͢ٷx˸ }0G,<},-(-́ !>I0 ͗͘ o8 ͆ >' m.`1pF,t6|!wS<.z}[|%FXc~ur1}͆ٯx(<˸ 8 !~J 0.O!>s 8 =  n s͗ ͆ .n 0 ͎-́ OT0 j oD,:j !I}袋.}8c~I$I~L! >ͬ͗ I× nn ͗ = ͆ nf^VNF!DLT\I!!53!r1!͒!> x #-= o˸x͆(- }(x>8(z ,z `iÃ!>' |r |̀>)=|(DMbo˸88x(0 8> ̀x(>-{(ay( z(>. ( {>E>+|(|Dg>-|/ 0:p# ~# +>0w#,-  60#}˸}րogM| .(z = ~> x0w#xG%͇ %͇ ZJDM%͇ = _~65+~hìx-Sx9?+{Η@}|z z gZJDM0{ ,7}o˸? #yO!@9i&?  #?w#?/w#?w#!9! E9!!9~(+Fͺ!"9!(#>2*"| >"2:( Ͷ *w*6 !\$![ (ͦ( #:~CONTRMKBDLSTCAUXUSR>2i:*ˮ~0:*:(@q##pZ* :(  ~* < >26"!"""~>2""v>2>"!"ˮ(!~8>~O6~*"w(6(2(-()(6 (8 0 :(* y(~#+ (( 66 #6 #"*: y~o p .##~ͺ(.6w4._~ =*##55= *[R8*~#"= ͣ}== ͯ}͵}*#w+#~+>*~('k!0(ˮ]k!8ˮ!]~-#8~>27kˮw>O$6̃s #r$ͣ6̏ k ( (ˮ qk(ˮ ( k ˮ*O:~ ##~._q4((=ʦ==ʩ=ʬò*:4^q*##~6ͺ>2}*|(̓|( ̓6-#[RM8( G> A~#*'C! !TRUEFALSE!9N#Y~#( G~#> >    "~(kѻ(( !0 (ˮ!!>2Sz:0:*6##ww#w$w#w:  ##N#F*B>2w#w#[s#r> "~ͮ*-w#ww##> ͮÁ""~>2:ZR0 *4#4>2:ZR> *4 #4(> #>22*f(/˦:G(##~++ :O x yC!ͺ Q*:G(##~._.͚f<\=<͚*##w ͮ +4 #4x >>2:G("ͮ"*nˮ*0 SZѷR8@* N#F#s#r, 0})jS\*##w+ N#FB ͮr+s>2!T]>)j)0 0= ]R!#]*^#V#N#F#^#V>2Ͱ:0:*6 #-Nw#Fwq#p#6#w#w#w"~Á>">!DM!":*B:!>(>2>">!"2"~ʰ*w#wx(9* :O *-4 #4!*4 #4 *-N#Fq#pV+^Bq#pSZѷR&* s#r$ s#rL <?*L!\  <( !\$>2>2L:>!(* \$\<(!3: [1ð\!(7"~> 2"S"Ns#FrB(Z#\: \<(?*"}K\! !*}#"}! x \* *>) 2""{_!"*nf}(HR0nf" ^VMDnfutqp*s#r*s#r"* uKB!0>' ~#fo{_"*R0RnfR0KqputsrNF( ^VNF^V*SutKqp R*R(~w~wnf ut"6#K*K*!""*NFy(* "*B0Cnf* [R*"*RS[s#r^#V""6#>O"w2x2*"!F"" &y*"*>2"*"!F"""!\*: Nr!~6go(\R*s#r_2x( s x(T]DMx(R0 U(͝O/o&9q# (!>F0#( ~ ( #]( ~ ( (#}(  i&T-a%â}ͦo*!~6o&|:2 2}:__zѯ2*|KB " z ^C User break+=  I/O Run-time error {ʹ, PC=*ͯNot enough memory Program aborted :ʎ'1!d!.-B>8!LocationLetterMASTMINDDo you want to play again (Y/N)? >*6!!+)))))))!+! s!}2!!fzʤ!}2*6!*&+)))))))*&+!s*&#l!*&!}2*&!3Ea!! }2!!fzp"}2*&*&!fzV"}2!}2*6!*&+)))))))*&+!s*&!}2*&!E"*&#!*&!}2*&#!!}2!!!fzʺ"}2*6!*&+)))))))*&+! s*&#Â"!-!/fz"}2*6!*&+)))))))*&+! s*&#"*6!*&+)))))))!"+!s*6!*&+)))))))!'+!s*6!*&+)))))))!,+!s!#!&fzʾ#}2*6!*&+)))))))*&+! !*&!"R+n&!s*&#k#!(!+fz$}2*6!*&+)))))))*&+!!*&!'R+n&!s*&##*6!!+)))))))!!+!s*6!!+)))))))!%+!s*6!!+)))))))!)+!s*6!!+)))))))!-+!s!}2!}2!@}2*6!*&+)))))))*&+*&#s*&!}2*&!}2*&!5Eʭ$!!fz\%}2H!<;}2*&! }2!*&+*&!As*&#%!!fzʏ%}2!*&+!s*&#g%!!fz%}2!*&+!s*&#Ú%!}2!}2!1}2!}2!}2!}2!}2!!}2!!fz9&}2!*&+!*&+n&s*&#&!!fzʵ(}2*6!*&+)))))))*&+!s!ͩ!D *&}2*&!Eʡ&'-*&́!A!F͛OE&*6!*&+)))))))*&+*&s'*6!*&+)))))))*&+!?s*&!}2*&!*&+n&EY'!*&+!*&+n&!s*&!!+n&Eʮ'!!+!s!*&+!*&+n&!sê(*&!!+n&E(!!+!s!*&+!*&+n&!sê(*&!!+n&EX(!!+!s!*&+!*&+n&!sê(*&!!+n&Eʪ(!!+!s!*&+!*&+n&!s*&#D&!!fz )}2*6!*&+)))))))*&+! *&!R+n&s*&#(!3!8fze)}2*6!*&+)))))))*&+!!*&!2R+n&s*&#)*6!*&+)))))))*&+!*&+n&!0s*6!*&+)))))))*&+!*&+n&!0s!*&+n&!͒E **6!*&+)))))))!+!ss!*&+n&!͒EI**6!*&+)))))))!9+!ss*&!R}2*&!R}2*&!}2*&!R}2*&!}2!*&!R+n&!*&!}oE%*6!!+)))))))! +!s*6!!+)))))))!"+!s*6!!+)))))))!$+!s*6!!+)))))))!&+!s*6!!+)))))))!(+!s*6!!+)))))))!*+!s*6!!+)))))))!,+!s*6!!+)))))))!.+!s*6!!+)))))))!!+!!+n&!s*6!!+)))))))!%+!!+n&!s*6!!+)))))))!)+!!+n&!s*6!!+)))))))!-+!!+n&!s!!6fz,}2*6!!+)))))))*&+!!*&!R+n&s*&#Ó,*6!!+)))))))!7+!s!$ͩ!D *&!Y͒E8!>+-* *&+!!*&!R+n&s*&#Ó,*6!!+)))))))!7+!s!!*&+n&!0s*6!*&+)))))))*&+!*&+n&!0s!*&+n&!͒E **6!*&+)))))))!+!ss!*&+n&!͒EI**6!*&+)))))))!9+!ss*&!R}2*&!R}2*&!}2*&!R}2*&!}2!*&!R+n&!*&!}oE%*6!!+)))))))! +!s*6!!+)))))))!"+!s*6!!+)))))))!$+!s*6!!+)))))))!&+!s*6!!+)))))))!(+!s*6!!+)))))))!*+!s*6!!+)))))))!,+!s*6!!+)))))))!.+!s*6!!+)))))))!!+!!+n&!s*6!!+)))))))!%+!!+n&!s*6!!+)))))))!)+!!+n&!s*6!!+)))))))!-+!!+n&!s!!6fz,}2*6!!+)))))))*&+!!*&!R+n&s*&#Ó,*6!!+)))))))!7+!s!MASTMIND.COM This is a simple deduction game. It will only work on a VIXEN or OSBORNE 1, because it addresses the screen directly. Type "mastmind" at the "A>" The computer will randomly choose a string of 4 letters, using the 6 letters A, B, C, D, E, & F, with possible duplications. They will not be displayed. You are given 7 attempts to match the string. The computer tells you after each attempt how many letters were correct, plus how many letters were also in the correct location. Examples: Computer string: EFAA Computer string: ABBB Your guess: ABCD Your guess: AABB Locations: 0 Locations: 3 Letters: 1 Letters: 3 After the 7 attempts, the computer's random string will be displayed. (You can quit with Ctrl-C) Written in TURBO PASCAL by Doug Cox, July 85, on a Vixen, for use in the public domain.program MASTMIND; (* written in TURBO PASCAL by Doug Cox July '85 for the Osborne 1 & Vixen only *) label Q; {$B-} const Loc: Array[1..8] of Char = 'Location'; Let: Array[1..6] of Char = 'Letter'; Mast: Array[1..4] of Char = 'MAST'; Mind: Array[1..4] of Char = 'MIND'; Replay: Array[1..33] of Char = 'Do you want to play again (Y/N)? '; ScreenTop: Integer= $F000; type Row= 1..24; Col= 1..128; PointerType= ^ScreenPointer; ScreenPointer= Array[Row, Col] of Byte; var p: PointerType ABSOLUTE ScreenTop; ch: Char; box: Array[1..4] of Char; temp: Array[1..4] of Char; locations, letters: Array[1..7] of Byte; h, i, j, k, v, w, x, y, z: Byte; ok: Boolean; begin repeat ClrScr; p^[1,1]:= 32; (* space *) x:= 31; repeat for y:= 6 to 22 do p^[y,x]:= 22; (* graphic 'v' *) x:= x + 4; until x = 51; x:= 32; for z:= 1 to 4 do begin for x:= x to x + 2 do begin y:= 6; repeat p^[y,x]:= 27; (* graphic '}' *) y:= y + 2; until y = 24; end; x:= x + 2; end; y:= 4; for x:= 31 to 33 do p^[y,x]:= 13; (* graphic 'm' *) for x:= 45 to 47 do p^[y,x]:= 13; p^[y,34]:= 22; p^[y,39]:= 22; p^[y,44]:= 22; for x:= 35 to 38 do p^[y,x]:= Ord(Mast[x-34]) + 128; for x:= 40 to 43 do p^[y,x]:= Ord(Mind[x-39]) + 128; p^[7,33]:= 22; p^[7,37]:= 22; p^[7,41]:= 22; p^[7,45]:= 22; x:= 29;y:= 24; z:= 64; repeat p^[y,x]:= Ord(succ(z)); (* 'A' thru 'F' *) x:= x + 4; z:= z + 1; until x = 53; for z:= 1 to 4 do begin Randomize; x:= Random (60); x:= Trunc (x div 10); box[z]:= Chr(x + 65); end; for z:= 1 to 7 do locations[z]:= 0; for z:= 1 to 7 do letters[z]:= 0; h:= 19; i:= 21; j:= 49; k:= 21; v:= 1; y:= 21; z:= 1; repeat x:= 33; for w:= 1 to 4 do temp[w]:= box[w]; for w:= 1 to 4 do begin p^[y,x]:= 127; read (Kbd, ch); ch:= UpCase(ch); if ch = ^C then Goto Q; if ch in ['A'..'F'] then p^[y,x]:= Ord(ch) else p^[y,x]:= 63; (* ? *) x:= x + 4; if ch = box[w] then locations[z]:= locations[z] + 1; if ch = temp[1] then begin temp[1]:= Chr(1); letters[z]:= letters[z] + 1; end else if ch = temp[2] then begin temp[2]:= Chr(1); letters[z]:= letters[z] + 1; end else if ch = temp[3] then begin temp[3]:= Chr(1); letters[z]:= letters[z] + 1; end else if ch = temp[4] then begin temp[4]:= Chr(1); letters[z]:= letters[z] + 1; end; end; for x:= 21 to 28 do p^[y,x]:= Ord(Loc[x-20]); for x:= 51 to 56 do p^[y,x]:= Ord(Let[x-50]); p^[i,h]:= locations[z] + 48; p^[k,j]:= letters[z] + 48; if locations[z] <> 1 then p^[y,29]:= 115; (* s *) if letters[z] <> 1 then p^[y,57]:= 115; i:= i - 2; k:= k - 2; v:= v + 1; y:= y - 2; z:= z + 1; until (locations[z-1] = 4) or (v = 8); Q:p^[7,32]:= 22; p^[7,34]:= 22; p^[7,36]:= 22; p^[7,38]:= 22; p^[7,40]:= 22; p^[7,42]:= 22; p^[7,44]:= 22; p^[7,46]%:= 22; p^[7,33]:= Ord(box[1]) + 128; p^[7,37]:= Ord(box[2]) + 128; p^[7,41]:= Ord(box[3]) + 128; p^[7,45]:= Ord(box[4]) + 128; for x:= 22 to 54 do p^[1,x]:= Ord(Replay[x-21]); p^[1,55]:= 22; read (Kbd, ch); until UpCase(ch) <> 'Y'; ClrScr; end. 3]:= Chr(1); letters[z]:= letters[z] + 1; end else if ch = temp[4] then begin temp[4]:= Chr(1); letters[z]:= letters[z] + 1; end; end; for x:= 21 to 28 do p^[y,x]:= Ord(Loc[x-20]); for x:= 51 to 56 do p^[y,x]:= Ord(Let[x-50]); p^[i,h]:= locations[z] + 48; p^[k,j]:= letters[z] + 48; if locations[z] <> 1 then p^[y,29]:= 115; (* s *) if letters[z] <> 1 then p^[y,57]:= 115; i:= i - 2; k:= k - 2; v:= v + 1; y:= y - 2; z:= z + 1; until (locations[z-1] = 4) or (v = 8); Q:p^[7,32]:= 22; p^[7,34]:= 22; p^[7,36]:= 22; p^[7,38]:= 22; p^[7,40]:= 22; p^[7,42]:= 22; p^[7,44]:= 22; p^[7,46] This is the release date of the disk. PRTPRO PAS BRTPRO PAS VIXENMM COM ,VIXENMM DOC VIXENMM PAS FILTER .INC A3 7E 640 5 LETTERS .DAT 17 76 8320 65 LISTER .1 B3 B1 16000 125 LISTER21.DOC BB B8 4992 39 PRTPRO .PAS B5 E8 17024 133 VIXENMM .COM E0 C4 11392 89 VIXENMM .DOC 2B 04 1024 8 VIXENMM .PAS E1 2D 3456 27  Fog Library Disk FOG-CPM.001 Copyright (1985) by Fog International Computer Users Group to the extent not copyrighted by the original author for the exclusive use and enjoyment of its members. Any reproduction or distribution for profit or personal gain is strictly forbidden. For information, contact FOG, P. O. Box 3474, Daly City, CA. 94015-0474. as part of the description of a file indicates that the program is distributed on a "try first, pay if you like it" basis. If you find the program(s) meet your need, please refer to the author's documentation for information on becoming a registered user. Only by registering and paying for the programs you like and use will the authors of such programs continue development. Often, more complete documentation, additional modules, and new releases are available only to registered users. This disk contains some games and utilities, all written in Turbo Pascal and all including source code. Filename Description -10-00 .85 This is the release date of the disk. -CPM001 .DOC This is the description of the disk contents. CAL2-EX .COM 575B 13K [Exec calendar 1 of 3] This is an appointment calendar for the Osborne Executive. CAL2-EX .PAS F635 6K [Exec calendar 2 of 3] CALENDAR.DOC 8310 2K [Exec calendar 3 of 3] FINANCES.COM 4A47 11K [Loan Amortization 1 of 3] Loan amortization program including the Turbo Pascal source. FINANCES.DOC 4906 1K [Loan Amortization 2 of 3] FINANCES.PAS 9A48 5K [Loan Amortization 3 of 3] LISTER22.COM 390A 35K ver. 2.2 [LISTER22 1 of 8] List and cross references source files. Includes the Turbo Pascal source code. LISTER22.PAS 87B0 14K ver. 2.2 [LISTER22 2 of 8] EDIT .INC 0073 16K ver. 2.2 [LISTER22 3 of 8] FILTER .INC A37E 1K ver. 2.2 [LISTER22 4 of 8] LETTERS .DAT 1776 9K ver. 2.2 [LISTER22 5 of 8] LISTER .1 B3B1 16K ver. 2.2 [LISTER22 6 of 8] LISTER21.DOC BBB8 5K ver. 2.2 [LISTER22 7 of 8] PRTPRO .PAS B5E8 17K ver. 2.2 [LISTER22 8 of 8] VIXENMM .COM E0C4 12K [MasterMind game 1 of 3] MasterMind game for the Osborne 1 or Vixen. VIXENMM .DOC 2B04 1K [MasterMind game 2 of 3] VIXENMM .PAS E12D 4K [MasterMind game 3 of 3] e games and utilities, all written in Turbo Pascal and all including source code. Filename&1 B3B1 16K ver. 2.2 [LISTER22 6 of 8] LISTER21.DOC BBB8 5K ver. 2.2 [LISTER22 7 of 8] PRTPRO .PAS B5E8 17K ver. 2.2 [LISTER22 8 of 8] VIXENMM .COM E0C4 12K [MasterMind game 1 of 3] MasterMind game for the Osborne 1 or Vixen. VIXENMM .DOC 2B04 1K [MasterMind game 2 of 3] VIXENMM .PAS E12D 4K [MasterMind game 3 of 3] .INC A37E 1K ver. 2.2 [LISTER22 4 of 8] LETTERS .DAT 1776 9K ver. 2.2 [LISTER22 5 of 8] LISTER .'