IMD 1.17: 27/06/2012 8:44:02 UCSD PASCAL SYSTEM VII.0 DISK 4/6 PART NUMBER 61-0011-004 REV A TERAK UTILITIES MANUFACTURED ON 6-NOV-80  @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ &lŗkm HBf     &  CODEp[SERIAL.IO.TEXT[5 CONCAT.TEXT@[5 CONCAT.CODE@[5 IRWIN3.FOTO/ IRWIN2.%C e U7F ?IO ERROR WHILE BOOTING? 7$ ?NOT ENOUGH CORE TO BOOT? FOTO[  e   ևߕ vߕ 7| SYSTEM.PASCAL? w7b SYSTEM.8510/A? @Aw  `! mG~d!~  ^\F C& J&  0  EN  ~  _~U@pe5w E ŋw Ŋw C! @ D~̋   wTwDԤ eeW 7 ?YOU DON'T HAVE A  ߋt_v @ @ PASCAL4Ȗe SYSTEM.8510/A\> SYSTEM.PASCALb[>CSYSTEM.CHARSET["C_ SYSTEM.FILER@[g_ GREDIT.TEXTp[ GREDIT.CODEp[ ANIMATE.TEXTp[e ANIMATE.CODEp[e FATCAT.FOTO[r GEOMETRY.FOTO[ TERAK.FOTO[  IRWIN.FOTO[Ԝ ) PRINTOUT.TEXTp[5)1 PRINTOUT.CODEp[51C RT2PAS.TEXTp[eCI RT2PAS.CODEp[eIm TERMINAL.TEXT\Ƞmw TERMINAL.CODE[wDIRECTORY.T <f,4~%x$J8EXT[DIRECTORY.CODE[ CNTRL.DM.TEXTp[e CNTRL.DM.CODE[垓 CNTRL.TK.TEXTp[ CNTRL.TK.#V"COPYRIGHT (C) 1978, REGENTS OF UNIV OF CALIF,SD Z Z ` f:@FLRX^djpv| "*2``@Z`d %  D~ " ~ E D~ D C~ %  D~  ~& <AA~E e8f"a8f"@"$ F% &@L$f&b8f"c8f" \ j .   @`& E&~AA~E e @`&AA~E e @`  `` @ @f ~f{fxfufrfoflfifffcf `f" t @L A@@A tBt B@P< ``f~ ``A~ c ҇ef rHJKC  >P  ?]f$Zf&Wf(Tf*Q NKHEB?<963 0"-$*&'($*! /efAA,"<w eeee e  e e& f   EezN EE7- 7 &  G 6E7, 6 ?  w pr@$@$@$@" EB~f r&z%% 7 (\7 (``WtB &E7 5@|<7w {7yw 7 psw mw g- aBE B<<  wN EC~ B~Uf rfVpfz  eN @_ azE ~ ~UV3T E@ JD B94T?4 E@" "-l8@ 6NE LU@t7`.~BE B @Wtw`& B~<z& & E7? ~7E@U@  E7 w wU &    N\Et& B~ & > ~UB~  Ձ@  a a!~F@  B~  *7 7 7 zv x7 vEl7 h 7 E7 tv wU W r7 $7 "~<E `E `EՀW @p@ `E e `&& `& ` ^ E@ &?  w U@w > 6 & h ^7 X E e `&EՀ~<  7Z   ҂ ~< E e ` EF @~w 2 ?*  "U@  wE 7 wv FRX\`&    @ ` G7vz   7H 7Z 6W w{Z N B F J ^ f j n x |  " 6 B D J f 2  4 ^ v ~   6 j | h*06NV\bz <6 E E7 ~<& EE Jd`n  B@B <C``& ΟX @ e E`E``B~8A Ew0w.Dw$ &  Z&X( &7 |v7 n|7 `|7 T 7 < 6 '((@`@`( (+m ]   P~P~eeNPP  \ = "  \m\  W  m ef5`\_e w5 5@ W  ~~e<ee``!~ e C~C~ %< C~\ɋE 5\\\f F^T2&,FR,: f6 C~ceί%@ eAp6% "1, 1,1,^  %W Y#w (Q&vI  >7 7(w& EFHJKABCDWX][f@@ N Z[  ^A %^A&Daef ¥_09E AZ  U7MwG7 % @`?R wLVxx|xt@ wU :: C  f ee $ $ $ $ @A eeee >eJ< K E7 w z2@t  w Et@_7   O 0E]``&& `  E e @a&&6E e @a&!$'(****AND 'ARRAY ,BEGIN CASE CONST DIV 'DO DOWNTOE e @a \d<Z@@`@`$fH@7 `e B~  B~< _ ELSE END EXTERNAL5FOR FILE .FORWARD "FUNCTION GOTO IF IMPLEMEN4IN7@` dd&`f&d&b&  m ef )INTERFAC3LABEL MOD 'NOT &OF OR (PACKED +PROCEDURPROGRAM !RECORD - ɋ e  rfwBC % e 7d,\ Aɋ BJ@ BREPEAT SET *SEGMENT !SEPARATE6THEN TO TYPE UNIT 2UNTIL USES 1VAR m8~@ Bm*~@ Bm~     WHILE WITH 7 <)& @  z7 <)7 )7 )7 &7 *7 &7 ' I?zr& 7h  AF eA -Bl: \.<$WFl7 ,,\ vw *< R'(((@ BCzEG@HPtJ$LM nO(k<   mAɋF! &ffD e w5 wDe`<nC<QRChTV焵W!cY_[\^^k `#ǭaxXc'exfhShjQYkoNmo9?pIrs|ouEw7x߄z @|Η}½  & &  tʕ U Q~ʕ \׌UE׌x׌"  e w d    X N wK w: 7 ,* $? U@ _E7 wf @7 6_ 8 E7 _ 7 v7 7 7 P 7"U?  E7 PRTV + wU  E@ w h07  w w N!.7 eJww  U @e @wxBEfEP U@ _E7 _ ]p |ʋD~ G~ 5E~ E~e  e  ` e  |$$ K wU  J _&ZT| ** wU &f&f7 .U   02 -/ ->%$  -~>%$t t n d ^_TR HDɝ^& _E7 .C DE!:7  7aehD A   aw7 28*7 2E 7 _$7  E7 V&U@ % E7 e:wXP@P7n@eI70@wnM)w\ 7 , ßz 5U$ ez\& Dr)&&\   5@5@7 X&'&'0'0' )'''' )& )& )& )&$'(:' )&J  E     7 7  @  27 !ׯ+U E ` D' )D'x'f&\  \& \\r1@\[?\ ew & ?U?*@ڪAD    ͋D 5|w 5B N  5 , W#D  7W ΁?Zw  C %     @  f&\   B -  e \z\D'U `  xZ7Wm7 P ]Dw=7w Zl Fw bIw   D5H5   :@ S~ e&-"wn.5) 5|w  w tR <w H<  Alw&f65t w E   e@ׇEU 77 :  .-& pU`E@ wHw .:" ʵm H& W Y#w H^E. U w w  UEw  BFU@ % eC ~% C ``` ezLN w Zć  tw  h!w  UOw p w 먇  <w  0w `ʽ W Y#wwU  E@ e ]& 7 7 7ߐ2 7  | t ~"   =@f&ysE[\pCf&f&\% a @w   6 6 &  f 6A  v  6N\z\\\ N A f C %C B    \  w  D& &&@7 &)D& && 6  A7 ^'*'&**'*&"*** )J* )& )& )& )& )) ɡOšOɡšF  LS#  , P# e\ \S\ e& @7 &:*)e\z*f& \:יc&>X4%]@& & &  , I#  l,á*6!F *STK OFLOW*תPFF+ & & D&&D&& @%7 r'*  IA e e@ e& & & & & Dˡ 6!:9 "8?á <צ Exec err #   á,&&e #@  @6 7 'J+6 6 #?%-0 @ ׳ ,(+, ,ábÍ:L]L?ƪ@ \fEA#& e@ & f& f& f7 '&X, ff w +á -ˡ.$  š t@..  &@& , $$&ˡ . .6% .&$&!F:F FˡFFD'%ɡšɡš  P&:+:azȄaA:) Type צ to continue) 8>`  PASCALSYUSERPROGDEBUGGERPRINTERRINITIALIGETCMD & ,Í ˫hp(ުPצצ22ȡ5233 ȡ 23aĩ3zȄ 23aA f C_  fW & @&&&&7 f( )<)p((f('&v( )&'&&'V(&\( )(e\\;@\ \N @     d˯7 H ȡ   צ0H" dÍÍˡ 퓄 Ä퓡  dÄÍ" ġ  *@#ٕš ګ۫ š۫ ګ,0   ˄"ɡ  dá  dá C#C˄ C    22š*á ?צ:22ȡá;2á!2ȡ5252š[ץQɫ  ȡ 0  0ȡ? ȡ  ġ  á22š2222ȡ2š5252á4w4]ץ11á4\1šV42233z ġMáš6 삫뻥 d #( / 3042221é42é1Ä2*á444ń55P.TEXTׯ]צ.CODEÍáɡ 럚肚X ū  J.BACKׯ7צ.INFO$.GRAFׯצ.FOTO8 <!~ áš  h ! ! Ä & ! !ë  ÄÄȄĄMȄt  Ä  1  !š Í 7ÄU iȡF ōɍ ō ȍ  dč "쓡ëǐɄ:6ń~66! á ~ 쓡ת!!9 D*~ éÍ~  , Ą ˄˥ń á   uš  gá /Ä쓡"á  :"ë á 쓡ת$+  ɡ"á a˄ Ꟛšq#ń? z 0 ń Ȅ! ~ת     n Í`~W ˡ!  ,ȫ$* "ë넡, ~ á9 铡/! !!1ˡ) ! 76*Í2~ š˄ `+ \ ( 7( :VQ28˄šá  d1    á sá# Ȅ 隹Ká/Ä   áš蕿@šQȡ2 šx á1 š2    :X fE6!~?8FצPut in :P?FP'Ǡá*EEšš$ !邚邫镫ë퓡h  ! "ˡ ɡ! E   !#E$ á"ˡ"& E ##& ! "ˡf á3 á+á! "ˡ Eá +6+6ˡ6á  T4P"hvf J.*L +Uz  Oš *š .Tf* zF d2:X fE6!~?8FצPut in :P?  áá ~צ/13:!      4T h ɡ 逫-á-32768ת Pġ>o0   šˡ 퓄 Ä퓡w 0ń0ˡ oɡ` Nȡš š   ɍL  "ˡ.ˡ   d쓡 뾿  .dá0á-  21šá. Ą ɡ 낫š ꓡ2  Q l>š 쾿  š땫ĚL삫Ú š a .Tá " *áá0á"á61 ɚ l š +-Í-ëzV 0á$-á š áš  šš!邚邫镫ë퓡S z kO  ȡ*ń ! "ˡ! "ˡ "ˡáˡȄ4šáRתPńȄ ,ń.  %ƮƂƂ0ƂXƁ<s$` 0T @NDZ 8 T z ~ x\6  ( :*צ dup dir entry(צfile already open(צ file not open(צbad input format(r8FNo debugger in systemתP8F6^.)G:!ing buffer overflowת(צdisk write protected(uillegal block #ת(]bad byte countת(Fצbad init record(.( SYSTEM.WRK. $*(J '%Ҧ74 text&}eN:%oYDצ IO error: (צUnimplemented instruction(צFloating point error(u'773code'77$Z&ت( *SYSTEM.WRK. 4(RWtn d8String overflowת(]Programmed HALTת(EProgrammed break-pointת(&ReP9$oYC %ƮƂƂ0ƂXƁ<s$` 0T @NDZ 8 T z ~ x\6  (٢ š٢ ٢٢ 4*ƁV`tDoo odoo'zrצUnknown run-time error(צValue range error(צNo proc in seg-table(Exit from uncalled procת(Stacḱʁʁʁצ*SYSTEM.MISCINFOP*"áO* ?́*́ʁʁʁʁʁʁ overflowת(צInteger overflow(Divide by zeroת(צNIL pointer reference(צProgram interrupted by user(ʁ%ʁ% t*&*n تٞ&"á ~٤  :SYSTEM.ASSMBLERת :SYSTEM.COMצSystem IO error(צ unknown cause( parity (CRC)ת(צillegal unit #(illegal IO requestת(צdata-PILERת :SYSTEM.EDITORת :SYSTEM.FILERת צ:SYSTEM.LINKERƁ&̨<́b ́cʁcȡ~ؤFP'Ǡá*EEE   !#E$ á"ˡ"com timeout(vol went off-lineת(file lost in dirת(צ bad file name(צno room on vol( vol not found& E ##&Eá +6+6ˡ6á  T4ת(file not foundת(צ dup dir entry(צfile already open(צ file not open(צbad input format(r8FNo user programתP8F0#^.)G:!ing buffer overflowת(צdisk write protected(uillegal block #ת(]bad byte countת(Fצbad init record(.( SYSTEM.WRK. $*(J '%Ҧ74 text&}eN:%oYDצ IO error: (צUnimplemented instruction(צFloating point error(u'773code'77$Z&ت( *SYSTEM.WRK. 4(RWtn d8String overflowת(]Programmed HALTת(EProgrammed break-pointת(&ReP9$oYC  ;??ٟá'C CONSOLEצSYSTERMGRAPHICצPRINTERREMINצREMOUTexulתצAug Sepת צOct Novת צDec ???תצ??????ת6! <ƋD*SYSTEM.CHARSETת(ƋDʋI&"áǀʋUʋTʋKƆD ʋT  ̌fʌުP11ˡCۡ>1áIllegal file nameצNo file ́3ˡ fȡƆD   ̌fʌfȡƈD  ل7@ǀ ?̌fʌfȡƊDؤؤ  not code3"ˡצ Bad block #02́42ʁ4ȡCƀ2ƀ2ō$ƀ ƀ P  ƋDR677::9 3222́42ʁ4ȡuƀ2ˡaݡ9צ Linking...ܡ #צ988:9  6 ۪1٦׷)Must L(ink firstg222́42ʁ4ȡJ22č7ʁ302́532́6ʁ5ʁ5ʁ6ʁ5ʁ622צ: ܢܢH d    0&צצ.צ??e f@^ڤ áڤ !~ e ת*U  ? צ*SYSTEM.WRK.TEXT& *SYSTEM.WRK.CODEײ , 7 !! !:!!ڤ  ڤ  áڤ R :9CONSOLE:ת(:9SYSTERM:ת(8:98áצ Assemblingצ Compiling...á999':::::&: 6ëצ???JanתצFebMarתצAprMayתצJunJ(yáצAssembleצCompile what text? (ׯ::(:.TEXT-:( ulתצAug Sepת צOct Novת צDec ???תצ??????ת6! "ˡ$צ Can't find ::9 ƀצ:9 ƀ:SYSTEM.SWAPDISK&:(7%7̄詄% š t Welcome ?צ, to-*SYSTEM.WRK.CODE[*]תצTo what codefile? (צ,áuצ$,,ˡ-́dʁdתʁd0ʁdʁd؞&"á*ʁd ضá0?ʁdצ*SYSTEM.STARTUP(߫7U.C.S.D. Pascal System II.0Current date is C -C-%́eʁ%ʁeȡlضʁ%ʁbQ́fƁfʁdƁfƁ&ʁ% Ɓf(ߡʁ% ʁbʁ%́bʁ%́%C %System re-initialized(, 06" 0 MayתצJunJ  צ*Command: U(ser restart, I(nitialize, H(altP')%$z쓡ݽ,::(,$,]ˡ$-::(:צ.CODE[*]0:--"ˡ צ Can't ope Linking...ˡ&צ Restarting...צ U not allowedn -   áث 7_a 7& š+ >*>$$~$~$$>> >.*.:*:8DD88(800   $~$|8(8š%צSYSTEM.WRK.CODEsSYSTEM.WRK.CODE׷Fš5 ~8(8``0 > BB~~BB~>BBBBB>~>~~ šA.á צ.CODEm%>>"rBB^@BBB~BBB ">B""B~fZBBBBBBFJZRbB~BBBBB~~BB~~BBBRr~@~BB>BBB<צ:) Running...ء ء:9B<@B<~BBBBBB~BBBBB$BBBBBZfBB$$BBBBB<~B0< B~>> 0``|@@@@@|>8:9á'צ*SYSTEM.STARTUP %áá  <@\B|:FBF:BBBB>xx >  Linking...ˡ&צ Restarting...צ U not allowedہہǻRRJHá68AX0qz((* "D&(,. Dv\xý6   FצKCommand: E(dit, R(un, F(ile, C(omp, L(ink, X(ecute, A(ssem, D(ebug,? [II.0]P')%?á@Fýýý   " ȡ3پ!}ȄپaپzȄ پaAצI T  ܪ۪ڪ-ˡ[ ġR&    צ ? (Y/N) - -F&צ ?  ɡ& Invalid #aP  ˄8&Destroy Gצ: ?  Gצצkת{צcתת(WצSתԦת(KצOת  J [ áF([*****]/(ġ 0 2` ٪ # ת á ÿ۽ϟn`Äצ(ڹצParity (CRC) error(Bad unit numberת(Bad I/O operationת( Timeout errorÿŹýýýŹת(Vol went off-lineת(File lost in dirת(|צ Bad file name(fצNo room on vol(ONo such vol on-lineת(ýýýŻ3File not foundת( t`K1ٹVol already on-lineת(Text file lostת(צCode file lost(Qˡá  File foundת(צBlkd vol( Unblkd volת(צ File name(צFile/(unblkd vol)(צFile/(blkd vol)(צFile/vol(Vol nameת(צOutput file full(Workfile is savedת(No directory on volת(No workfile to saveת(Wildcard not allowedת(צ"Bad form (Wild Non-Wild) card(Ill file/vol nameת(}Ill change (Vol <??`l  (>ǟ`Ƌto> file) nameת(UBad dest for files foundת(4,"iEbUġ#(צ `8`8 ` `o`o?expected1(& Ş"˶ I/O error # 4!צ Filer error # ء5 FILEHAND \&),áY 6(   MJLN0A$6Uۡ &Pɡ צ, áצ áצ g=#g=ɍ=*á =*jjjצ:j($hh=ɡX="#š=P="=fܪ(G[!nء CGGá+á &"ˡ~[צ["=h"h=h"h"=P=gg=á?gg=ɡ, 󍓡 =g ˡ  .  sآWצ:آ(Yצc&PܓÄ)jjSjצ:jˡjj(jAj(ܓfOGK׷Ȅ آצ ? ) ,áYø۪   ff@Զ  rުݪ"צPWkKGšׯɄ  0ު(áܲ~Í %&ܥKO &&ȡu ''k'S{c\ڥs[KG2G:[ Remove oldRƁ-צChangȡKk'k-'' ܡšڡKNeChange to what׷{צSW,,W,צ:,(,,(,{A,(*צChange Y˄ &"&& & ܡ&'&k'{[*[")ǐ ),, d,,[,["𥀈{á򥀿D1 0 ء,ˡ   ߓ`&צPut  : in unit  { c󓍄E''S'צ:'{!'0'c?'(&K&not proccessedء ߓ ٨š5Kˡ*   ġ" ء " á á3!:W~,gڲ= ggۓ$=?N۪ڪƁK""áN׷9& צ ? "'ز=g(=g=&=g&Pɡۡצ ...too long <ٹFצ file n  ڪ٪ت&:&Pɡ(š ame < scan string #צ vol name  M8!ۡ1á    - char. max >---> 4ثضÍצ$*á-:á?: Illegal formatT<=ڲ= ݪצc&.צ what fileצ:á ;&Pġ - عEXå[ׯGC81(o* what vol ?  , gg#š=jgjPg?=ɍ :   Ɓ3"ݣ ɡݣ  ڕš"ق Text file saved  & 0צCODE  #צCode file saved62"o.ܡC׷C#ÄÄ~Íj%á*צPut in G:'צInsert destination צצ not named2 Workfile is :.񄓡 (not saved) No workfiledisk % š " ݢÄv%.ת&תת(&Ɓ.񄓡9&צThrow away current workfile ? ݢÄ ۡ"ˡ ݢڶ /ݢ0/0 /0 ءצ*SYSTEM.WRK.TEXTצ*SYSTEM.WRK.CODEצ*SYSTEM.LST.TEXT**.*צ.BACK*צ/0 0 òCń /C"ݢݢ///צ://td צTRemove  ء&צWorkfile cleared&Tf ' ݪܪ  : .  ǀransferTo whereׯ󓄡=H3Transferצblocks# of blocks to transfer צTransferá@ .  ڲ צ& * )'Getצǐ&G.[  צ. Ɓ-צMakeǐh"))** **.&ؓń=.צ.TEXT.צ.CODE ..Ȳ.׷:.TEXTצText ײ"&G:[ madeצT! ߪ Ɓ8 55 *SYSTEM.W&)צ.CODEצCode )١&צNo  file loaded (- RK. 5 5 4454=5  d66.6.6 65ݪ   p &+- ȡ%ܾz ܾ0ŶȄ: \,%Date #٪ؓצ *SYSTEM.WRK.,C:[.set: <1..31>--<00..99>Cˡ_צ Today is C -C-á" G"+!+~G?KÄ?G;K;GK,,, $[.GC .צE&Save as G,:, ׯ>צRemoveǀ RemoveE+G:. ? 瓡צSave asצ[š C?/צTEXT$CODE$饀ޤ removed%á % ń,&Update directory ? צ".[G&TEXT&  #hKצ*..CODEOld code removed, C  New date ?  ,Cػ+škGGȡ"GؾAĥGؾZȄ?:צPrefix is - ;: 0 צ Zero dir ofצH  GإGؾAa ȡ$GCػ+c,C ػ?צ:@ÄצDuplicate dir ?   Are thereצblks on the diskצ# of blocks on the disk צNew vol name ?  Cצ The date is C -C-C 6 * 饀:˥׷!צ:DGצ : correct ? ,%ö,ÍP$&,􍓡~%K:, %,,,|.G CK"צ: zeroed p1šצFile(s) endangered:Mȡڶ+šڸ+*ڂ*ŶB < UNUSED >     .p/ƃƅ'l\ؤ áצ Directoryڢڢ  v 2Dir listing ofצ׷١糖 צ#1:(ƃ"١̅.̅-̅,̅+̅*̅) ̅(ˡZ ȡ<ڤ š+ؓښڤ ȡ3ؓ R j3צBad block scan ofצ Ä . %̅,ړצListƅ-~$ʅ.áWriting.ʅ.̅.ʅ- ̅/צHScan forצblocksScan for how many blocks ܕšۏ"ˡ`ۂȡQʅ- ʅ//ʅ/ʅ/̅)ʅ(ʅ)̅(ƃʅ/ƃצʅ/ƃʅ) ƃʅ/  ƃ-ƃƅ0ʅ/ "ˡ93צBlock  צ is badۂġ צ bad blocks2 0ƃ-ƃʅ/   ءQƃʅ/ ƃʅ/  ƃƃƅ0ʅ/ƅ0ƃfile3ƃʅ/  4צExamine blocks onצH&Block-range ? S  SRR  RRˡR ƃƅ0ʅ/ƅ0. ڍʅ- /ƃʅ. ƃ/ƃ  ƃ files;ƃצ, ƃʅ( ƃ blocks usedƃ, ƃʅ* ƃ unusedƃצ, ƃʅ+ ƃצ in largest T USVR̂dVʂdȡצBlock V ƁdVƁdV"á dV"Ɓdd  may be ok"١ ƃƃ"ƃ ,  N- Vols on-line: ȡ &Gz is badV3ˡYV šOUVˡ9TTTM šTVT ȡR~צ; צ #  :צRoot vol is - VVUVVá52Mark bad blocks ?š$צ (files will be removed !)צ (Y/N)  VWarning units   &  צ have the same name--('"צPrefix titles byl;G& Prefix is ;:`%\!X0T4P1L5H6 {Graphics Editor. V01-06. 3-March-79}  %{TERAK CORPORATION believes that the information contained herein is %accurate. ID*@:BZ2" (@,(NXF0N>w\ ƁG&צSYSTEM.n no event will TERAK be liable for any losses or damages, %whether direct or indirect, resulting from the use of such %informYbcCZ BAD.xxxxx.BADתV̂dVʂdȡV̂eʂeWʂeXT̂fTʂfġ1Z TʂeoT0WRK.TEXT צSYSTEM.WRK.CODE &PĶ (Dɞ(ń?Íצ0???JanFeʂeoTTT TWT ɡTTWT#VV צBad blocks markedH`]t5ebMarAprMayJunJulAugSepOctNovDec?????????0צ Bad CodeTextInfoDataGrafFoto ~% ۢˡMoving ۢۢצ SYSTEM.PASCAL G?   š "0 & L (*&brB\( "&`'"#))'D+*,H--*..\//x0001B1Z1h55p8L5H6 " " ġ  7צCrunch@צFrom end of disk, blockצStarting at block # 3 % forward ת  ȡ'  š 7  צback  ġ ɡ7 GO^3 : crunched#צPlease re-boot{ X6تPFP') xR88תVצOFiler: G(et, S(ave, W(hat, N(ew, L(dir, R(em, C(hng, T(rans, D(ate, Q(uit [C.4]8+צ&Filer: G, S, N, L, R, C, T, D, Q [C.4]8?áVOFiler: B(ad-blks, E(xt-dir, K(rnch, M(ake, P(refix, V(ols, X(amine, Z(ero [C.4]8+&Filer: W, B, E, K, M, P, V, X, Z [C.4]8ڡ$&B% ȡ~٤ܦ׷u ȡhܲ~ؤ OOLEAN); $1: (C: PACKED ARRAY [0..9599] OF CHAR); $2: (D: PACKED RECORD ,PIX: PACKED ARRAY [0..9599] OF CHAR; ,X,Y:INTEGER {INPUT NUMBER} "RANGE,TIME: INTEGER; "XBAR,YBAR: INTEGER; "GEN: GENMAP; {CHA; {CURSOR LOC'N} ,MARK: PACKED ARRAY ['A'..'Z'] OF RECORD {MARK ARRAY} 2X: INTEGER; 2Y: INTEGER 2END; " ANGLE: INRACTER GENERATOR} CCH,NUL: CHAR; {COMMAND CHARACTER} SKIP,DELFLG,TWIST: BOOLEAN; TEGER; ,PEN: INKCOLORS END); %3: (Q: PACKED ARRAY[0..4863] OF INTEGER); {19 BLKS FOR BLK I/O} " 4: (S: PACKED ARRAY[0..4799 COMPAT: PACKED ARRAY [0..0] OF CHAR;  XMRKNBL,YMRKNBL: BOOLEAN; "EML: EMLCS; {SY] OF SET OF SIXTEEN) {SET CASE FOR OVERLAYS} "END; {TERAKSCREEN} (  SCANLINE=RECORD CASE BOOLEAN OF (TRUE: (C: CHAR); (FANC BIT IS IN EMLCS} "S: STRING; "PHYLE: FILE;   PROCEDURE DRAWLINE(VAR RADAR:INTEGER; VAR S:TLSE:(B: PACKED ARRAY [0..7] OF BOOLEAN) {8 DOTS PER LINE} "END; {SCANLINE} " "CHARSET=ARRAY [0..255] OF {CHARACTERAKSCREEN; 8ROW, X0, Y0, DX, DY, PEN: INTEGER); EXTERNAL;  PROCEDURE GIVEHELP;  PROCEDURE PARTONE; "BEGIN "WRITELN(' ER CODE} (PACKED ARRAY [0..15] OF CHAR; {SCAN LINE} " "GENMAP=RECORD CASE BOOLEAN OF /TRUE: (ADR: INTEGER); /FALSE: (BFR *-----PENSTATE COMMANDS-------------*------ANGLES---------*'); "WRITELN(' | U)p draw ghost lines/dots | 90ation, including, without limitation, losses arising from %claims of patent, copyright, and trademark infringement. No license : ^CHARSET) -END; "SYNCBIT=PACKED RECORD 0JUNQUE: 0..2047; 0SYNC: BOOLEAN -END; "EMLCS=RECORD CASE BOOLEAN OF %is granted hereby for the use of any patent or patent rights of %TERAK. TERAK reserves the right to update the information co*TRUE: (ADR: INTEGER); *FALSE:(REG: ^SYNCBIT) *END;   VAR {** GLOBAL DATA **} "Z: BOOLEAN; {SELECTS ONE OF TWO PIntained %herein at any time without further notice. % %The information contained herein is proprietary to TERAK CORPORATION CTURES} "{** IMPURE DATA **} {picture dependent} "X: ARRAY[BOOLEAN]OF INTEGER; {CURSOR X POSITION 0..319} Y: %and must be treated as confidential. It may not be disclosed to %others or used for any purpose except as expressly consente ARRAY[BOOLEAN]OF INTEGER; {CURSOR Y POSITION 0..239} ANGLE: ARRAY[BOOLEAN]OF INTEGER; {HEADING ORIENTATION 0.d to by %TERAK. 7COPYRIGHT 1980 BY TERAK CORPORATION >"ALL RIGHTS RESERVED"} > PROGRAM GREDIT;  {$S+}  {$L-}  {$R-} {$I-.359} INK: ARRAY[BOOLEAN]OF INKCOLORS; {PEN STATUS} SCREEN: ARRAY[BOOLEAN]OF TERAKSCREEN; {THE GRAPHIC UN} CONST  FF=12; CR=13; ETX=3; ESC=27; BS=8; SP=32; LF=10; TAB=9;  TYPE INKCOLORS=(INVISIBLE, WHITE, BLACK, COMPLEMENT); IVERSE} "MARK: ARRAY[BOOLEAN]OF PACKED ARRAY ['A'..'Z'] OF RECORD -X: INTEGER; {BOTH X&Y=32767->INVALID AS X,Y PAIR} -Y: I"FIVE=0..4; "SIXTEEN=0..15; " "TERAKSCREEN=RECORD CASE FIVE OF $0: (B: PACKED ARRAY [0..239] OF PACKED ARRAY [0..319] OF BNTEGER {X=32767 BUT Y<32767->VALID NUMBER} +END; {** PURE DATA **} {picture independent} "NUMBER, HOLD: INTEGER;  "WRITELN(' | J)ump to relative X,Y location | : : |'); "WRITELN(' | L)eap to absolute X,Y locatio Z THEN NZ:=FALSE ELSE NZ:=TRUE END;   PROCEDURE DETWIST;  BEGIN IF TWIST THEN WRITE('No '); WRITELN('Twist'); "TWIST:=NOT n |-160,0 0,0 159,0 |'); "WRITELN(' | H)ead to absolute angle for Move | : : |'); "WRITELN(' TWIST; DELFLG:=FALSE; END;   FUNCTION INSIDE(A,B,C:INTEGER):INTEGER; BEGIN IF BC THEN INSIDE:=C ELSE INS | P)olygon generator B)ox generator |-160,-119...159,-119 |'); "WRITELN(' | W)alk blocks ^)rrowhead generator *---LETTEREIDE:=B END {INSIDE};  PROCEDURE BLINK; {BLINK CURSOR UNTIL SOMETHING IS TYPED}  VAR CRSBIT:BOOLEAN; D MEMORY---*'); "WRITELN(' | S)egment circle generator | R)emember V)erify |'); "END; "PROCEDURE PARTTWO; "BE BEGIN WITH SCREEN[Z] DO BEGIN "CRSBIT:=B[Y[Z],X[Z]]; "TIME:=0; {TIME RETURNS ELAPSED TIME} "REPEAT $REPEAT UNTIL EML.REG^.GIN "WRITELN(' *-----CONTROL COMMANDS--------------* F)orget cursor,nmbrs|'); "WRITELN(' | N)ew pix & letters Z)ap SYNC; {MS BIT=1 ... VERT RETRACE} $IF TIME<10000 THEN TIME:=TIME+1 ELSE TIME:=TIME-8; $IF TIME MOD 8=0 THEN B[Y[Z],X[Z]]:=TRUEpix only *-----SINGLE DOTS-----*'); "WRITELN(' | A)scii character pattern entry | Period key sets dot |'); WRITELN(' ; " IF ((TIME MOD 8=2)AND(NOT CRSBIT)OR(TIME MOD 8=5)AND(CRSBIT)) $ THEN B[Y[Z],X[Z]]:=FALSE; "UNTIL NOT UNITBUSY(2); B[Y[Z] | I)dentify cursor, and states | Comma key clears dot|'); "WRITELN(' | X)change with alternate picture *----CU,X[Z]]:=CRSBIT;  END END; {BLINK}   PROCEDURE HANG(WAITTIME:INTEGER);  BEGIN "REPEAT $REPEAT UNTIL EML.REG^.SYNC; {MS BITRSOR MOTION----*'); "WRITELN(' | K)ombine alt pix into this pix | \ twists 45 degrees.|'); =1 ... VERT RETRACE} $WAITTIME:=WAITTIME-1; "UNTIL (WAITTIME<0) OR (NOT UNITBUSY(2)); END;   PROCEDURE GETCCH;  BEGIN "IF"WRITELN(' | ete, alter massive areas | Cursor arrows move |'); "WRITELN(' | O)utput picture into disk fil NOT SKIP THEN UNITREAD (2,COMPAT[0],1,,1); "BLINK; SKIP:=FALSE; CCH:=COMPAT[0]; "IF CCH IN ['a'..CHR(127)] THEN CCH:=CHR(ORD( |'); "WRITELN(' | D)own draw solid lines/dots | | |'); "WRITELN(' | E)raser drawe | cursor per penstate,|'); "WRITELN(' | G)et picture from disk file Q)uit | twist, & repetition.|'); "WRITE ('  clear lines/dots | 180 --*-- 0,360 |'); "WRITELN(' | C)omplement reversing lines/dots | | |');  *-----------------------------------*---------------------*'); "WRITE (' to cont'); "END;  BEGIN  UNITWRITE (3,SCREEN"WRITELN(' *-----MOTION COMMANDS---------------* 270 |'); "WRITELN(' | M)ove relative to cursor @hea[Z].C[0],7);(*GRAPHICS OFF*)WRITE (CHR(FF));(*CLEARSCREEN*)  PARTONE;PARTTWO;  REPEAT UNITREAD (2, COMPAT[0], 1); CCH := COMding *------RANGES---------*'); "WRITELN(' | T)urn heading by relative angle |-160,120.....159,120 |'); PAT[0] UNTIL CCH = ' ';  WRITE(CHR(FF)); UNITWRITE(3,SCREEN[Z].C[0],63); END (*GIVEHELP*);  FUNCTION NZ:BOOLEAN;  BEGIN IF  SURE? '); GETCCH; RUSURE:=(CCH='Y'); WRITELN(CCH); CCH:=NUL  END; {RUSURE}   PROCEDURE CHKPEN; {IF PEN UP, PUT IT DOWN} CCH].Y; ECHO; CCH:='m' END; "UNTIL CCH='m'; "XMRKNBL:=FALSE; YMRKNBL:=FALSE; IF NEGATORY THEN NUMBER:=-NUMBER; END {GETNUMBER} BEGIN IF INK[Z]=INVISIBLE THEN "BEGIN INK[Z]:=WHITE; WRITELN ('*PEN DOWN*') END  END;   PROCEDURE SHOWCURSOR(IX,IY:INTEGE;  PROCEDURE POLYGON; VAR STEP,SIZE:INTEGER; XX:REAL; BEGIN CHKPEN; WRITE ('Polygon angle: '); GETNUMBER; STEP:=NUMBER; R); VAR I,J,K:INTEGER;  BEGIN WITH SCREEN[Z] DO BEGIN "B[IY,IX]:=NOT B[IY,IX]; "FOR K:=0 TO 999 DO IF K MOD 100=0 THEN $FOR WRITE (' Side: '); GETNUMBER; SIZE:=NUMBER; WRITE (' Increment: '); GETNUMBER; WRITE(' Type anything to stop...'); UNI:=INSIDE (0, IX-2, 319) TO INSIDE (0, IX+2, 319) DO &FOR J:=INSIDE (0, IY-2, 239) TO INSIDE (0, IY+2, 239) DO (B[J,I]:=NOT B[ITREAD (2,COMPAT[0],1,,1); {ASYNCH I/O} REPEAT XX:=ANGLE[Z]*0.0174533; {COMMON EXPRESSION} J,I]; "B[IY,IX]:=NOT B[IY,IX];  END END {SHOWCURSOR}; PROCEDURE DRAW (NEWX,NEWY:INTEGER); VAR XDIFF,YDIFF: INTEGER; BEGIN {DR DRAW (X[Z] + ROUND(SIZE*COS (XX)),Y[Z]-ROUND(SIZE*SIN (XX))); SIZE:=SIZE + NUMBER; ANGLE[Z]:=(ANGLE[Z] + STEP) MOD 360;AW} NEWX:=INSIDE (0, NEWX, 319); NEWY:=INSIDE (0, NEWY, 239); IF INK[Z] <> INVISIBLE THEN BEGIN XDIFF:=NEWX-X[Z];  UNTIL NOT UNITBUSY (2); WRITELN;  END {POLYGON};   PROCEDURE CURSE(I,J:INTEGER);  VAR OLDCCH:CHAR; REP,XX,YY:INTEGER; YDIFF:=NEWY-Y[Z]; &DRAWLINE(RANGE,SCREEN[Z],20,X[Z],Y[Z],XDIFF,YDIFF,ORD(INK[Z])) END; X[Z]:=NEWX; Y[Z]:=NEWY; END {DRAW}; P BEGIN "OLDCCH:=CCH; REP:=0; "REPEAT $REPEAT XX:=X[Z]+I; YY:=Y[Z]+J; IF DELFLG THEN DRAW(XBAR,YBAR); &DRAW(XX,YY); REP:=REPROCEDURE GETNUMBER; VAR NEGATORY:BOOLEAN; COUNT:INTEGER;  PROCEDURE ECHO; BEGIN WRITE(CCH); COUNT:=COUNT+1; END;  BEGIN NUMB-1; UNTIL REP<=0; $GETCCH; IF TIME<15 THEN REP:=5; IF TIME<10 THEN REP:=10; "UNTIL CCH<>OLDCCH;{CURSE} "DELFLG:=FALSE; SKIP:=ER:=0; COUNT:=0; "REPEAT "GETCCH; "IF COUNT=0 THEN BEGIN $IF CCH='-' THEN BEGIN NEGATORY:=TRUE; ECHO END TRUE;  END;   PROCEDURE DELETE;  BEGIN "XBAR:=X[Z]; YBAR:=Y[Z];  IF INK[Z]=INVISIBLE THEN BEGIN INK[Z]:=BLACK; SCREEN[Z1ELSE NEGATORY:=FALSE; END; "IF (CCH>='0') AND (CCH<='9') THEN $BEGIN NUMBER:=10*NUMBER+ORD(CCH)-ORD('0'); ECHO; END; "IF (C].B[YBAR,XBAR]:=FALSE; "WRITELN ('*ERASER*') END; WRITELN('Delete... Use Cursor Keys to move'); "REPEAT DELFLG:=TRUE; GETCCH; OUNT>0) AND (CCH='h') THEN $BEGIN WRITE(CHR(BS),' ',CHR(BS)); NUMBER:=NUMBER DIV 10; $COUNT:=COUNT-1; END; "IF (CCH>='A')AND($CASE CCH OF &'\': DETWIST; &'z': IF TWIST THEN CURSE(-1,-1) ELSE CURSE(0,-1); &'l': IF TWIST THEN CURSE(1,1) ELSE CURSE(CCH<='Z') THEN $IF (MARK[Z,CCH].X<>32767) THEN &BEGIN &IF XMRKNBL THEN BEGIN NUMBER:=MARK[Z,CCH].X; ECHO; CCH:='m' END; &IF 0,1); &'w': IF TWIST THEN CURSE(-1,1) ELSE CURSE(-1,0); &'k': IF TWIST THEN CURSE(1,-1) ELSE CURSE(1,0) $END; CCH)-32); "IF CCH IN [CHR(0)..CHR(31)] THEN CCH:=CHR(ORD(CCH)+96); END;  FUNCTION RUSURE:BOOLEAN;  BEGIN "WRITE(' ARE YOUYMRKNBL THEN BEGIN NUMBER:=MARK[Z,CCH].Y; ECHO; CCH:='m' END $ END ELSE $IF MARK[Z,CCH].Y<>32767 THEN &BEGIN NUMBER:=MARK[Z,  END END; & PROCEDURE SIRCLE;  VAR ALPHA,ALPHAINC,ALPHAEND,XORG,YORG:REAL; I,J:INTEGER;  BEGIN WITH SCREEN[Z] DO BEGIN WRIT"DRAW(X[Z]+ROUND(SIZ*COS(ALPHA+BETA)),Y[Z]-ROUND(SIZ*SIN(ALPHA+BETA))); "X[Z]:=HOMEX; Y[Z]:=HOMEY; "DRAW(X[Z]+ROUND(SIZ*COS(AE('Segment radius: '); GETNUMBER; HOLD:=NUMBER; "WRITE(' units Angle: '); GETNUMBER; WRITELN(' degrees'); "{ HOLD == RADIUS LPHA-BETA)),Y[Z]-ROUND(SIZ*SIN(ALPHA-BETA))); "X[Z]:=HOMEX; Y[Z]:=HOMEY  END; "  PROCEDURE ARROW(SIZE:INTEGER);  BEGIN "AL"UNTIL DELFLG; "DELFLG:=FALSE; SKIP:=TRUE  END;    PROCEDURE ASCII;  VAR I,J,L,ALTSET:INTEGER; K:PACKED ARRAY[0..9] OF  NUMBER == ANGLE } "IF HOLD>0 THEN ALPHA:=90 ELSE ALPHA:=-90; {DELTA HEADING TO CENTER} "ALPHA:=(ANGLE[Z]+ALPHA)*0.0174533; SCANLINE;  BEGIN WITH SCREEN[Z] DO BEGIN "ALTSET:=0; "WRITELN('Ascii... swaps set lowers case terminates'); {CALC HEADING TO CENTER} "IF NUMBER<0 THEN ANGLE[Z]:=(ANGLE[Z]+180)MOD 360;{NEG ANGLE->REVERSE START} "HOLD:=ABS(HOLD);XORG:=X"REPEAT $UNITREAD (2,COMPAT[0],1,,1); BLINK; CCH:=COMPAT[0]; $IF CCH IN [' '..CHR(127)] THEN $BEGIN &REPEAT UNTIL EML.REG^.[Z]+HOLD*COS(ALPHA); YORG:=Y[Z]-HOLD*SIN(ALPHA); "IF HOLD<>0 THEN "BEGIN SYNC; {MS BIT=1 ... VERT RETRACE} &UNITWRITE(3,SCREEN[Z].C[0],447); {GEN NBL, SAME ZONES, CLICK!} &FOR J:=0 TO 9 DO K[J].C:=GE$ALPHAINC:=1/HOLD; IF NUMBER<0 THEN ALPHAINC:=-ALPHAINC; $J:=ABS(ROUND(NUMBER*0.0174533*HOLD)); $WHILE J>=0 DO &BEGIN (Y[Z]N.BFR^[ORD(CCH)+ALTSET,J]; {MINIMIZE SNOW} &UNITWRITE(3,SCREEN[Z].C[0],63); {BACK TO CHARACTER PAGE} &WRITE(CCH); {SAFE TO ECH:=INSIDE(0,ROUND(YORG+HOLD*SIN(ALPHA)),239); (X[Z]:=INSIDE(0,ROUND(XORG-HOLD*COS(ALPHA)),319); (CASE INK[Z] OF *WHITE: B[Y[ZO NOW} &FOR J:=INSIDE(0,Y[Z]-9,239) TO Y[Z] DO &BEGIN (L:=J-Y[Z]+9; (FOR I:=X[Z] TO INSIDE(0,X[Z]+7,319) DO (CASE INK[Z] OF],X[Z]]:=TRUE; *BLACK: B[Y[Z],X[Z]]:=FALSE; *COMPLEMENT: B[Y[Z],X[Z]]:=NOT B[Y[Z],X[Z]] (END; 'J:=J-1; ALPHA:=ALPHA+ALPHAIN *INVISIBLE: B[J,I]:=K[L].B[I-X[Z]]; *WHITE: IF K[L].B[I-X[Z]] THEN B[J,I]:=TRUE; *BLACK: IF K[L].B[I-X[Z]] THEN B[J,I]:=FALSC; &END; END; "ANGLE[Z]:=(ANGLE[Z]+NUMBER+360)MOD 360;  END END;   PROCEDURE ARROWHD;  VAR ALPHA:REAL;  PROCEDURE VECTE; *COMPLEMENT: IF K[L].B[I-X[Z]] THEN 6B[J,I]:=NOT B[J,I] (END; &END; &X[Z]:=INSIDE(0,X[Z]+8,319) $END ELSE OR(SIZ:INTEGER;BETA:REAL);  VAR "HOMEX,HOMEY:INTEGER;  BEGIN "HOMEX:=X[Z]; HOMEY:=Y[Z]; $CASE ORD(CCH) OF &ESC: IF ALTSET=0 THEN ALTSET:=128 ELSE ALTSET:=0; &CR: BEGIN WRITELN; X[Z]:=0; Y[Z]:=INSIDE(0,Y[Z]+10,239) END; &BS: X[Z]:=INSIDE(0,X[Z]-8,319); &LF: Y[Z]:=INSIDE(0,Y[Z]+10,239); &26: Y[Z]:=INSIDE(0,Y[Z]-10,239); &12: Y[Z]:=INSIDE(0,Y[Z]+10,239); &23: X[Z]:=INSIDE(0,X[Z]-8,319); &11: X[Z]:=INSIDE(0,X[Z]+8,319) " END; "UNTIL CCH=CHR(ETX);  WRITELN  E CCH OF "'A',' ': BEGIN WRITE('Angle: '); GETNUMBER; WRITE(' degrees.'); 1ANGLE[Z]:=NUMBER MOD 360 END; "'L': BEGIN WRITE(' TX+U THEN "WITH SCREEN[Z] DO CASE INK[Z] OF $INVISIBLE: B[TGTY+V,TGTX+U]:=B[SRCY+V,SRCX+U]; Heading to absolute X: '); XMRKNBL:=TRUE; GETNUMBER; /HOLD:=NUMBER-X[Z]+160; WRITE(' Y: '); YMRKNBL:=TRUE; GETNUMBER; /NUMBER$WHITE: IF B[SRCY+V,SRCX+U] THEN B[TGTY+V,TGTX+U]:=TRUE; $BLACK: IF B[SRCY+V,SRCX+U] THEN B[TGTY+V,TGTX+U]:=FALSE; $COMPLEMEN:=NUMBER+Y[Z]-120; /IF HOLD=0 THEN IF NUMBER>=0 THEN NUMBER:=90 ELSE NUMBER:=-90 /ELSE NUMBER:=ROUND(ATAN(NUMBER/ABS(HOLD))/0.T: IF B[SRCY+V,SRCX+U] THEN B[TGTY+V,TGTX+U]:=NOT B[TGTY+V,TGTX+U] "END;  END;   BEGIN WRITE ('Walk block area of Width: ')0174533); /IF HOLD<0 THEN NUMBER:=180-NUMBER; ANGLE[Z]:=NUMBER MOD 360 END "END;  WRITELN; CCH:=NUL  END;   PROCEDURE M; XMRKNBL:=TRUE; GETNUMBER;  W:=NUMBER; WRITE(' units Height: '); YMRKNBL:=TRUE; GETNUMBER; H:=NUMBER;  WRITELN(' units'); WOVE;  BEGIN "WRITE ('Move along heading: '); GETNUMBER; WRITELN (' units.'); "DRAW (X[Z] + ROUND(NUMBER*COS (ANGLE[Z]*0.01745RITE('Motion: M)ove, J)ump, L)eap: '); GETCCH;  CASE CCH OF "'M':BEGIN (WRITE ('Move along heading: '); GETNUMBER; WRITELN ('PHA:=((ANGLE[Z]+180) MOD 360)*0.017453; "VECTOR(SIZE,0.78); SIZE:=(SIZE DIV 2)+1; "VECTOR(SIZE,0.46); VECTOR(SIZE,0.16)  END;33)), (Y[Z]-ROUND(NUMBER*SIN (ANGLE[Z]*0.0174533)));  END;   PROCEDURE LEAP;    BEGIN CHKPEN; WRITE('Arrowhead: S)mall, M)edium, L)arge or X)tra large: '); "GETCCH; "CASE CCH OF $'S',' ': BEGIN WRI BEGIN WRITE ('Leap to absolute X: '); XMRKNBL:=TRUE; GETNUMBER; "HOLD:=NUMBER; WRITE(' Y: '); YMRKNBL:=TRUE; GETNUMBER; "DRTE('Small'); ARROW(3) END; $'M': BEGIN WRITE('Medium'); ARROW(4) END; $'L': BEGIN WRITE('Large'); ARROW(5) END; " 'X': BEGINAW (INSIDE(0,HOLD+160,319),INSIDE(0,120-NUMBER,239)); "WRITELN  END;   PROCEDURE JUMP;  BEGIN WRITE ('Jump to relative X:  WRITE('Xtra large'); ARROW(7) END "END;  WRITELN; CCH:=NUL  END; &  PROCEDURE BOX;  VAR XX:REAL;  PROCEDURE SIDE(SIZE:'); XMRKNBL:=TRUE; GETNUMBER; "HOLD:=NUMBER; WRITE(' Y: '); YMRKNBL:=TRUE; GETNUMBER; "DRAW (INSIDE(0,X[Z]+HOLD,319),INSIDE(0INTEGER);  BEGIN "DRAW(X[Z]+ROUND(SIZE*COS(XX)),Y[Z]-ROUND(SIZE*SIN(XX))); "XX:=XX+1.5707963;  END;  BEGIN CHKPEN; WRITE(,Y[Z]-NUMBER,239)); "WRITELN  END;   PROCEDURE WALK;  VAR H,W,SRCX,SRCY,U,V:INTEGER;  PROCEDURE BLOK(TGTX,TGTY:INTEGER); 'Box Width: '); XMRKNBL:=TRUE; GETNUMBER; HOLD:=NUMBER;  BEGIN "IF W<0 THEN BEGIN SRCX:=INSIDE(0,X[Z]+W,319); W:=X[Z]-SRCX; TGTX:=TGTX-W END )ELSE BEGIN SRCX:=X[Z]; W:=INSIDE(0,X[Z]"WRITE(' units Height: '); YMRKNBL:=TRUE; GETNUMBER; WRITELN(' units'); "XX:=ANGLE[Z]*0.0174533; "SIDE(HOLD); SIDE(NUMBER); +W,319)-X[Z] END; "IF H>0 THEN BEGIN SRCY:=INSIDE(0,Y[Z]-H,239); H:=Y[Z]-SRCY; TGTY:=TGTY-H END )ELSE BEGIN SRCY:=Y[Z]; H:=INSSIDE(HOLD); SIDE(NUMBER);  END;   PROCEDURE HEADING;  BEGIN WRITE('Heading: Set by A)ngle or L)ocation: '); "GETCCH; "CASIDE(0,Y[Z]-H,239)-Y[Z] END; "FOR V:=0 TO H DO IF INSIDE(0,TGTY+V,239)=TGTY+V THEN "FOR U:=0 TO W DO IF INSIDE(0,TGTX+U,319)=TG   END;  BEGIN "WRITE('Remember L)ocation or N)umber: '); "GETCCH; "CASE CCH OF "'L',' ': BEGIN ,WRITE ('Location of cur); "X[Z]:=160; Y[Z]:=120; ANGLE[Z]:=0; INK[Z]:=INVISIBLE; TWIST:=FALSE; END {INITIALIZE}; $  FUNCTION GETFILENAME:BOOLEAN; {Isor as letter: '); GETLTR; ,MARK[Z,CCH].X:=X[Z]-160; MARK[Z,CCH].Y:=120-Y[Z]; ,END; "'N': BEGIN )WRITE ('Number: '); GETNF TRUE, FILE NAME IS IN STRING S}  BEGIN "WRITE (' what filename: '); READLN(S); GETFILENAME:=FALSE; UMBER; WRITE (' as letter: '); )GETLTR; MARK[Z,CCH].X:=32767; MARK[Z,CCH].Y:=NUMBER; )END "END; {CASE} "WRITELN; CCH:=NUL; "IF LENGTH(S)>0 THEN BEGIN $IF POS('.FOTO',S)=0 THEN S:=CONCAT(S,'.FOTO'); $IF (LENGTH(S)>14) THEN WRITELN('*Ill filename*')  END; "  PROCEDURE IDENTIFY;  BEGIN "WRITE ('Identify cursor at (',X[Z]-160,',',120-Y[Z], )') Heading is ',ANGLE[Z],' degre6ELSE GETFILENAME:=TRUE END;  END;   PROCEDURE LOADDATA;  BEGIN WITH SCREEN[Z] DO BEGIN "X[Z]:=D.X; Y[Z]:=D.Y; MARK[Z]:=Des. Pen is '); "CASE INK[Z] OF $BLACK: WRITE('eraser.'); $WHITE: WRITE('down.'); $INVISIBLE: WRITE('up.'); $COMPLEMENT: WRI.MARK; "ANGLE[Z]:=D.ANGLE; INK[Z]:=D.PEN  END END;   PROCEDURE GET; {LOAD INPUT FILE}  BEGIN "WRITE('Get new screen from'TE('complementer.') "END; "WRITE(' Pix is '); "CASE Z OF $FALSE: WRITELN('A'); $TRUE: WRITELN('B') "END; "SHOWCURSOR(X[Z]); "IF GETFILENAME THEN "BEGIN $OPENOLD(PHYLE,S); $IF BLOCKREAD(PHYLE,SCREEN[Z].Q[0],19)=19 &THEN BEGIN LOADDATA; CLOSE(PHY,Y[Z]);  END;   PROCEDURE VERIFY;  PROCEDURE VERYFY;  BEGIN "IF MARK[Z,CCH].X<>32767 THEN $BEGIN LE) END &ELSE BEGIN WRITELN('*FILE READ ERROR*'); HANG(180) END; "END;  END;   PROCEDURE DUMPDATA;  BEGIN WITH SCREEN[Z] &WRITELN(CCH,' at (',MARK[Z,CCH].X,',',MARK[Z,CCH].Y,')'); &SHOWCURSOR(MARK[Z,CCH].X+160,120-MARK[Z,CCH].Y); $END ELSE &IF MDO BEGIN "D.X:=X[Z]; D.Y:=Y[Z]; D.MARK:=MARK[Z]; D.ANGLE:=ANGLE[Z]; D.PEN:=INK[Z]  END END;   PROCEDURE OUTPUT; {WRITE OUT  units.'); (BLOK (X[Z] + ROUND(NUMBER*COS (ANGLE[Z]*0.0174533)), (Y[Z]-ROUND(NUMBER*SIN (ANGLE[Z]*0.0174533))); &END; "'L':BARK[Z,CCH].Y<>32767 THEN WRITELN(CCH,' = ',MARK[Z,CCH].Y);  END;  BEGIN "WRITE ('Verify mark letter (sp for all) : '); "REPEEGIN WRITE ('Leap to absolute X: '); XMRKNBL:=TRUE; GETNUMBER; (HOLD:=NUMBER; WRITE(' Y: '); YMRKNBL:=TRUE; GETNUMBER; (BLOK AT GETCCH UNTIL ((CCH>='A')AND(CCH<='Z')) OR (CCH=' '); "IF CCH<>' ' THEN VERYFY ELSE "BEGIN WRITELN; FOR CCH:='A' TO 'Z' DO V(INSIDE(0,HOLD+160,319),INSIDE(0,120-NUMBER,239)); &END; "'J':BEGIN WRITE ('Jump to relative X: '); XMRKNBL:=TRUE; GETNUMBER; ERYFY; WRITELN END;  END;   PROCEDURE FORGET; {CLEAR MARK ARRAY} "BEGIN $FOR CCH:='A' TO 'Z' DO $BEGIN MARK[Z,CCH].X:=32(HOLD:=NUMBER; WRITE(' Y: '); YMRKNBL:=TRUE; GETNUMBER; (BLOK (INSIDE(0,X[Z]+HOLD,319),INSIDE(0,Y[Z]-NUMBER,239)); &END 767;MARK[Z,CCH].Y:=32767 END "END;  PROCEDURE INITIALIZE; {CLEAR EVERYTHING EXCEPT MARK ARRAY} BEGIN "EML.ADR:=-140; GEN.ADR END;  WRITELN;  END;   PROCEDURE REMEMBER;  PROCEDURE GETLTR; "BEGIN REPEAT GETCCH UNTIL CCH IN ['A'..'Z']; WRITE(CCH);:=-8192; NUL:=CHR(0); "FILLCHAR (SCREEN[Z].C[0],9600,NUL); {CLEAR THE SCREEN} WRITE (CHR(FF)); "UNITWRITE (3,SCREEN[Z].C[0],63 1CLOSE(PHYLE,PURGE); HANG(180) END;  END;  END;   PROCEDURE KOMBINE;  VAR  IX,IY:INTEGER;  A:BOOLEAN; HACK,WACK:SET O "DELFLG:=FALSE; SKIP:=FALSE; {SKIP allows a case to return a CCH (See CURSE)} "REPEAT IF NOT SKIP THEN WRITE ('*'); GETCCF SIXTEEN;  BEGIN WITH SCREEN[Z] DO BEGIN "WRITELN('Kombine pictures...'); "WRITE('D)uplicate, C)omplement, O)verlay, I)ntersH; {SKIP ON -> NO WAIT IN GETCCH} $CASE CCH OF 'm': BEGIN WRITE(CHR(FF)); UNITWRITE(3,SCREEN[Z].C[0],63) END; &'?','/':ect, E)rase, or R)everse: '); "GETCCH; WRITELN; A:=NZ; "CASE CCH OF "'D',' ': BEGIN WRITE('Duplicating...'); Z:=A; DUMPDATA; GIVEHELP; 'P': POLYGON; 'U','D','E','C': INKER; '.','>': SCREEN[Z].B[Y[Z],X[Z]]:=TRUE;  Z:=NZ; .Q:=SCREEN[A].Q; LOADDATA END; "'C': BEGIN WRITE('Complementing...'); FOR IY:=0 TO 4799 DO BEGIN .HACK:=[0..15]; HAC&',','<': SCREEN[Z].B[Y[Z],X[Z]]:=FALSE; &'T': BEGIN WRITE ('Turn heading by: '); GETNUMBER; ,ANGLE[Z]:=(ANGLE[Z]+NUMBER)MOK:=HACK-S[IY]; {NOT Z} .WACK:=[0..15]; WACK:=WACK-SCREEN[A].S[IY]; {NOT A} .S[IY]:=(S[IY]*WACK) + (SCREEN[A].S[IY]*HACK) END ED 360; WRITELN(' degrees.') END; 'M': MOVE; &'H': HEADING; 'L': LEAP; 'J': JUMP; 'S': SIRCLE; &'BND; "'O': BEGIN WRITE('Overlaying...'); FOR IY:=0 TO 4799 DO .S[IY]:=S[IY] + SCREEN[A].S[IY] END; "'E': BEGIN WRITE('Erasin': BOX; &'A': ASCII; &'^','6': ARROWHD; &'R': REMEMBER; &'F': BEGIN WRITE('Forget all lettered locations & numbers...')g...'); FOR IY:=0 TO 4799 DO .S[IY]:=S[IY]-SCREEN[A].S[IY] END; "'I': BEGIN WRITE('Intersecting...'); FOR IY:=0 TO 4799 DO .; 2IF RUSURE THEN FORGET END; &'O': OUTPUT; &'G': GET; &'\': DETWIST; &'z': IF TWIST THEN CURSE(-1,-1) ELSE CURSE(0,-1)S[IY]:=S[IY]*SCREEN[A].S[IY] END;  'R': BEGIN WRITE('Reversing (this pix only)...'); FOR IY:=0 TO 4799 DO BEGIN ; &'l': IF TWIST THEN CURSE(1,1) ELSE CURSE(0,1); &'w': IF TWIST THEN CURSE(-1,1) ELSE CURSE(-1,0); &'k': IF TWIST THEN CU.HACK:=[0..15]; S[IY]:=HACK-S[IY] END END  END; "WRITELN; CCH:=NUL;  END END;   PROCEDURE INKER; "BEGIN "CASE CCH OF RSE(1,-1) ELSE CURSE(1,0); &'Z': BEGIN WRITE('Zap picture...'); IF RUSURE THEN INITIALIZE END; &'I': IDENTIFY; &'V': VERIF"'U': BEGIN INK[Z]:=INVISIBLE;WRITELN('Pen Up.') END; "'D': BEGIN INK[Z]:=WHITE; WRITELN('Pen Down.'); .SCREEN[Z].B[Y[Z],X[Y; &'W': WALK; &'X': BEGIN WRITELN ('Xchange pictures.'); 2Z:=NZ; UNITWRITE(3,SCREEN[Z].C[0],63) END; &'K': KOMBINE; &'NZ]]:=TRUE END; "'E': BEGIN INK[Z]:=BLACK; WRITELN('Eraser.'); .SCREEN[Z].B[Y[Z],X[Z]]:=FALSE END; "'C': BEGIN INK[Z]:=COMP': BEGIN WRITE('New picture...'); IF RUSURE THEN 2BEGIN INITIALIZE; FORGET END END; &'_': DELETE; &'Q': WRITELN ('QUIT') SCREEN TO FILE}  BEGIN "WRITE('Output screen into'); "IF GETFILENAME THEN "BEGIN $OPENNEW(PHYLE,S); DUMPDATA; $IF BLOCKWRILEMENT;WRITELN('Complement.') END  END;  END;   BEGIN {MAIN PROGRAM} Z:=TRUE; INITIALIZE; FORGET; Z:=FALSE; INITIALIZETE(PHYLE,SCREEN[Z].Q[0],19)=19 &THEN CLOSE(PHYLE,LOCK) &ELSE BEGIN WRITELN('*FILE WRITE ERROR*'); ; FORGET; "UNITWRITE(3,SCREEN[Z].C[0],63); {TURN ON DISPLAY} WRITELN ('GREDIT... GRaphics EDitor... V01-07... ? for help.'); A *-----PENSTATE COMMANDS-------------*------ANGLES---------*צA | U)p draw ghost lines/dots sive areas | Cursor arrows move |צA | O)utput picture into disk file | cursor per penstate,|$END; "UNTIL (CCH='Q'); UNITWRITE(3,X,7); {GRAPHICS OFF} END.   | 90 |A | D)own draw solid lines/dots | | |צA | E)raser draw clear lines/dots | 180 --*-- 0,360 |A | C)omplement reversing lines/dots | |  |צA *-----MOTION COMMANDS---------------* 270 |A | M)ove relative to cursor @heading *------RANGES---------*צA | T)urn heading by relative angle |-160,120.....159,120 |A | J)ump to relative X,Y location | : : |צA | L)eap to absolute X,Y location |-160,0 0,0 159,0 |A | H)ead to absolute angle for Move | : : |צA | P)olygon generator B)ox generator |-160,-119...159,-119 |A | W)alk blocks ^)rrowhead generator *---LETTERED MEMORY---*צA | S)egment circle generator | R)emember V)erify |vA . GREDIT  *-----CONTROL COMMANDS--------------* F)orget cursor,nmbrs|צA | N)ew pix & letters Z)ap pix only *---- -SINGLE DOTS-----*A | A)scii character pattern entry | Period key sets dot |צA | I)dentify cursor, and states | Comma key clears dot|A | X)change with alternate picture *----CURSOR MOTION----*צA | K)ombine alt pix into this pix | \ twists 45 degrees.|A | ete, alter mas  á|-á|0ĩ|9Ȅ u|0uũ|hÄ% u u|Aĩ|ZȄy 4|AE,7Q]|" ꤓ Segment radius: ut units Angle: צ degreesˡ: 4|Aum| 4|Aum|+ 4|Aˡ 4|Aum||máءtš Z Z  9=uɡǴhttt t uur  Polygon angle: u Side: uצ Increment:  Type anything ttˡtuɡ u9=t ġt t ? o stop...9=ةuقh#` UM7]I5 A | G)et picture from disk file Q)uit | twist, & repetition.|צA *--------------------------------|ق؂~yxȡ vɡv ɡ |ˡ~VX hy---*---------------------* to conttD ꤓ || á  x á2  ꤓxy*ERASER*!Delete... Use Cursor Keys to move~ |N?1 R} צNo Twist}}~:ɡš}|}k}X}F\z>V 8^$&(*,.0T  ꤓ٥v v'ɡ vvvvvá٥vؓv246c:<~~y 8 ꤓצ:Ascii... swaps set lowers case terminates؄٥#٥ػ   # $    || 試  ꤓǿ ȡڤz|؂ھ ꤓ?| ||a| |||`|H  ARE YOU SURE?  |Y|{|@  ȡڥ ?ȡ ڤ٤ۥu٤ۥ ڤVá! צ *PEN DOWN*4  ꤓؤؤȡmdá_??٤ۥ ڤ7٤ۥڤڤoR5?⩦|ȡ@ ȡۤۤؤؤcF ?áǀ ?  w ˡ4٥إw ꤓڥ ؚٚj|u _?G?/(%WU"$|á u%Heading: Set by A)ngle or L)ocation:  |Angle: צ degrees.uhצ!vJump to relative X: ut Y: t?u!JMnK Heading to absolute X: uǠt Y: uxutáuġZuZuut   |l|$,#Remember L)ocation or N)umber:  |Location 9=utɡ Ǵuuuhb LZ  "$&(*,.02468:<>@B0FHJLof cursor as letter: # 4|AǠ 4|AxNumber:  as letter: # 4NPRTVX{|r Move along heading:  units.u9=|A 4|Auf N^  "$&(*,.02468:<>@BDFHJLNPRTVXu9=n~Leap to absolute X: ut Y: tǠ?xu\{|v \"Identify cursor at (Ǡ ,x  ) Heading is lJump to relative X: ut Y: t?u  degrees. Pen is  Lצeraser.Hdown.7צup.( complementer.tɡ+?ٶ%?š+/BW& Pix is  AB '>$ 4|Aˡ|uhh ڲڲܚۚڲض%ȡضضáȡٶ?ڲܚۚǴh=سG@س?س #?ٶá ꤓ ضٶܶܶضٶwܶH 3Arrowhead: S)mall, M)edium, L)arge or X)tra large:  |VSmallMediumضٶLܶ#ضٶضٶsJ3צLargeצ Xtra largez Xr^  "$&(*,.02468:<>@BDFHJLN "4!Walk block area of Width: uצ units Height: uצ unitsPRTVX^`bdfjlnp{|,زز@צMotion: M)ove, J)ump, L)eap:  |צMove along heading: צ units.u9=B  Box Width: utצ units Height: צ unitsu9=tutu9=!צLeap to absolute X: utצ Y: tǠ?xu ||7F'nj z{ ꤓǀ%{   ꤓ?Ǡx }`( -CU&+h  "$1 /ƦƧՂv('(' ꤓ?צ3GREDIT... GRaphicwhat filename: Pšaצ.FOTOá!P.FOTOUPš *Ill filenames EDitor... V01-07... ? for help.~* |  ꤓ?/ ꤓ*V) ꤓأأ 4آ¨4أ آH*Get new screen fr ꤓTurn heading by: uhצ degrees.om)X ꤓá *&צ*FILE READ ERROR*Ǵ + ꤓآ"*Forget all lettered locations & numbers... '-+}}آآ¥ 44آآ J,Output screen into)`, ꤓ}}Zap picture... ($% Xchange pictures. á .*FILE WRITE ERROR*Ǵ - ꤓKombine pictures...צDD?.New picture... ('QUIT,z ^ $ *x)uplicate, C)omplement, O)verlay, I)ntersect, E)rase, or R)everse:  |Duplicating...ګ,ݥ ~v6J8h>\ `\djlnprtvxz|~>di|Qáڤ*צComplementing...ǿȡWؤ ڤؤؤؤ ڤؤƦeMZ l7 7 w v7 v jj^7 ^ CptE`eE /6צ Overlaying...ǿȡ ؤؤ ڤؤצ Erasing...ǿȡ ؤؤ ڤ .-00(7 $m-  ` ~ m- ` ~ؤIntersecting...ǿȡ ؤؤ ڤؤReversing (this pix only)...-,    5  \v @BDFAˡ2|צ =  4|A &"Verify mark letter (sp for all) :  |Aĩ|&1NPRVXZ\^bd{|}G .| Pen Up.  Pen Down.ZȄ| Í| ˡ&&A|Z|ȡ &||J ~%A|Z|ȡ. 4|A 4|A ꤓ צEraser. ꤓQ  Complement. > h& , @ @|rfVVVVV62* y losses or damages, %whether direct or indirect, resulting from the use of such %information, including, without limitation,  < Jzlf~ *!4#"V##$$%P%z%2&V&&'P*&\4/losses arising from %claims of patent, copyright, and trademark infringement. No license %is granted hereby for the use of any patent or patent rights of %TERAK. TERAK reserves the right to update the information contained %herein at any time without further notice. % %The information contained herein is proprietary to TERAK CORPORATION %and must be treated as confidential.O^ It may not be disclosed to %others or used for any purpose except as expressly consented to by %TERAK. 6COPYRIGHT 1980 BYe TERAK CORPORATION ="ALL RIGHTS RESERVED"}  PROGRAM ANIMATE;  (*$R-*) (*$I-*) CONST  WRDLIM = 16000;  FF = 12;  BS = 8;  TYPE "SYNCBIT = PACKED RECORD 0JUNQUE: 0..2047; 0SYNC: BOOLEAN -END; " "EMLCS = RECORD CASE BOOLEAN OF *TRUE: (ADR: INTEGER); *FALSE:(REG: ^SYNCBIT) *END; "  VAR GAR: PACKED ARRAY [0..20] OF INTEGER; (*ARRAY OF SCREEN SUBSCRIPTS*) " "COMPAT: PACKED ARRAY [0..0] OF CHAR; "EML: EMLCS; (*SYNC BIT IS IN EMLCS*) "S: STRING; "BASTARD: FILE; "PIX: INTEGER; "PIXNDX,TOPNDX: INTEGER; "WRDSIZ: INTEGER; "I,ZONE: INTEGER; "NUMBER: INTEGER; "CCH,NUL: CHAR; "FRAME:  INTEGER; "GARSIZ: INTEGER; "NEGATORY: BOOLEAN; "COUNT: INTEGER; "SCREEN: PACKED AR {TERAK CORPORATION believes that the information contained herein is %accurate. In no event will TERAK be liable for anRAY [0..WRDLIM] OF INTEGER; (*NO RANGE CHECKING!*) " "  PROCEDURE HANG(WAITTIME:INTEGER);  BEGIN "REPEAT $WAITTIME:=WAITTI $REPEAT &WRITE('Get frame #',PIXNDX+1,' from'); GETFILENAME; &IF I>0 THEN (*VALID NAME IN S*) &BEGIN (RESET(BASTARD,S); (I IF NUMBER>0 THEN FRAME:=1 ELSE NUMBER:=-NUMBER; WRITELN; (REPEAT *WRITE('Type anything to stop...'); *UNITREAD(2,COMPAT[0],1:=BLOCKREAD(BASTARD,SCREEN[PIX],(WRDSIZ+255) DIV 256); (IF (IORESULT<>0)OR(I=0) THEN BEGIN I:=-1; WRITELN('*FILE READ ERROR*');,,1); *HANG(30); PIXNDX:=0; *WHILE UNITBUSY(2) DO *BEGIN ,HANG(NUMBER); ,UNITWRITE(3,SCREEN[GAR[PIXNDX]],ZONE); ,PIXNDX:=P EHANG(60) END ELSE CLOSE(BASTARD); (IF I>0 THEN BEGIN UNITWRITE(3,SCREEN[GAR[PIXNDX]],7+ZONE); *WRITE(' O.K.?'); REPEAT GETCIXNDX+FRAME; ,IF PIXNDX<0 THEN PIXNDX:=TOPNDX; ,IF PIXNDX>TOPNDX THEN PIXNDX:=0; *END; ME-1; $REPEAT UNTIL EML.REG^.SYNC; (*MS BIT = 1 ... VERT RETRACE*) "UNTIL WAITTIME<0; END;   PROCEDURE GETCCH;  BEGIN "UNCH UNTIL CCH IN ['Y',' ','N','m']; *IF CCH='m' THEN CCH:=NUL; WRITELN(CCH); IF CCH='N' THEN I:=-1 END &END $UNTIL I>=0; $PIXITREAD (2,COMPAT[0],1); CCH:=COMPAT[0]; "IF CCH IN ['a'..CHR(127)] THEN CCH:= CHR(ORD(CCH)-32); :=PIX+WRDSIZ; (*BUMP TO NEXT PIX*) $PIXNDX:=PIXNDX+1  END ELSE "BEGIN WRITELN('*** MEMORY IS FULL ***'); PIXNDX:=PIXNDX+1; "IF CCH IN [CHR(0)..CHR(31)] THEN CCH:= CHR(ORD(CCH)+96); END; PROCEDURE GETNUMBER;  PROCEDURE ECHO; BEGIN WRITE(CCH); COUNI:=0 END;  END; (*EXIT WITH I=0 -> DONE*)   BEGIN (*MAIN PROGRAM*) "(*initialize*) "EML.ADR:=-140; NUL:=CHR(0); "REPEAT T:=COUNT+1; END;  BEGIN NUMBER := 0; COUNT:= 0; "REPEAT "GETCCH; "IF COUNT=0 THEN BEGIN $IF CCH = '-' THEN BEGIN NEGATORY$WRITELN (CHR(FF),'ANIMATE... Graphics Animator... V01-03...'); $WRITE('Display in U)pper, M)iddle, L)ower, T)op, B)ottom, or A := TRUE; ECHO END 1ELSE NEGATORY := FALSE; END; "IF (CCH>='0') AND (CCH<='9') THEN $BEGIN NUMBER:= 10*NUMBER+ORD(CCH)-ORD('0)ll zones?'); $REPEAT WRDSIZ:=0; GETCCH; $CASE CCH OF &'L': BEGIN WRITELN(CCH); ZONE:=8; WRDSIZ:=1600; GARSIZ:=-3200; END; '); ECHO; END; "IF (COUNT>0) AND (CCH='h') THEN $BEGIN WRITE(CHR(BS),' ',CHR(BS)); NUMBER:= NUMBER DIV 10; $COUNT:= COUNT-1; &'M': BEGIN WRITELN(CCH); ZONE:=16; WRDSIZ:=1600; GARSIZ:=-1600; END; &'U': BEGIN WRITELN(CCH); ZONE:=32; WRDSIZ:=1600; GARSIZEND; "UNTIL CCH='m'; "IF NEGATORY THEN NUMBER := - NUMBER; END (*GETNUMBER*);  PROCEDURE GETFILENAME;  BEGIN "WRITE (' wha:=0; END; &'B': BEGIN WRITELN(CCH); ZONE:=24; WRDSIZ:=3200; GARSIZ:=-1600; END; &'T': BEGIN WRITELN(CCH); ZONE:=48; WRDSIZ:=32t filename: '); READLN(S); I:=LENGTH(S); "IF (I>0)AND(POS('.FOTO',S)=0) THEN S:=CONCAT(S,'.FOTO');  IF (I>14)THEN BEGIN WRIT00; GARSIZ:=0; END; &'A',' ','m': BEGIN WRITELN('A'); ZONE:=56; WRDSIZ:=4800; GARSIZ:=0; END $END; $UNTIL WRDSIZ<>0; $WRITELELN('*Ill filename*'); I:=0 END;  END; "  PROCEDURE LOAD;  BEGIN "GAR[PIXNDX]:=PIX+GARSIZ; (*CALC GAR PNTR FOR THIS PIX*) N('Enter frame picture files. After last frame, type only...'); $PIX:=0; PIXNDX:=0; REPEAT LOAD UNTIL I=0; TOPNDX:=PIXNDX"IF PIX+(((WRDSIZ+255) DIV 256)*256) < WRDLIM THEN "BEGIN $FILLCHAR(SCREEN[PIX],2*WRDSIZ,NUL); (*CLEAR IN CASE BAD I/O*) -2; $IF TOPNDX>=0 THEN &REPEAT (FRAME:=-1; (WRITE('Time between frames (in 60ths of a second neg->reverse): '); (GETNUMBER; @us o@nusoǀ n@us0oǀ nuA8onuL mX ANIMATE #  "$&(*,.02468:<>@BeHJLNPRTVX^`bdfhnprtvxz|~ nˡ?Enter frame picture files. After last frame, type only...kmpámllġtצ9Time between frames (in 60ths of a second neg->reverse): qštqqType anything to stop...m#4qxmomtmmɡlmmlšmx*C)ontinue, T)ime adj, N)e ɡ ssas sss`s4swwaqwww set up, Q)uit: s @smársssIsTˡ6צQuit ? s@*UNITWRITE(3,SCREEN[0],7); (*GRAPHICS OFF*) *WRITE('C)ontinue, T)ime adj, N)ew set up, Q)uit: '); *REPEAT GETCCH UNTIL CCH INás-ávvs0ĩs9Ȅ qs0qwũshÄ$ q qwwsmávqqp~ wh ['C','T','N','Q',' ','m']; *IF CCH='m' THEN CCH:=NUL; WRITELN(CCH); (UNTIL NOT (CCH IN ['C',' ']); &UNTIL CCH<>'T' $ELSE BEat filename: PppŦ.FOTOץÄPצ.FOTOUPpš!*Ill filename*GIN WRITE('Quit ? '); REPEAT GETCCH $UNTIL CCH IN ['N','Y']; WRITELN(CCH) END; "UNTIL CCH<>'N';  END. " pVmkuknǀ>ɡxknr  Get frame #m  frompšCCxknp"˩pÍ*p*FILE READ ERROR*<Cpšaxmoצ O.K.?s @smársssNáppġknkmm/*** MEMORY IS FULL ***mmp2JKCƁo{njr צ)ANIMATE... Graphics Animator... V01-03...ADisplay in U)pper, M)iddle, L)ower, T)op, B)ottom, or A)ll zones?nsso@nǀ uso@n ` @ x|00 < 88>`@v;  x`@?8| # `|`0p0ssNˡC=6IDw}#&,X2pe only...kmpámllġtצ9Time between frames (in 60ths of a second neg->reverse): qštqqType anything t@|`  @ p `(m[@0 8> @0@8;` @    0 @ ;@`@@6?`3` @18 T0@0 0 @< @@@ @@ `A@8,`  ``0  x 0 p0 xa @<@ @1 @@@@@`0@ @` w @@ 00@ x @$ p01 @@ @Z @  @ 0 qA0 0 a @@@ y @@@    @V1A`8 0`0@ 0@  |@ @@@   @@@@B  0@ !`?  0` 8 @ A p@ @@   @lUU50 @  0 vC p@0 @ < @ @@@  PUګUk P{><@! @  @" `A` FC cF?  H `0X @00 `@ H@p@(@@@4@  @0 0@@@`       ;` p`  HP`0p h (`(@( `0 0B(` Ax`8@ @@@~0  !@  @@8  @x`@ }`= ?@p0 pgX>p c {H`@x\@R<Hp@8[L`@@ Hd0`D`@ @K0@` &@0pF@C@! @ @@@ D @~ @@ `@  `H#D`($D4$D<0?@B 0@@B @@" <$L@ $@@$xC@ !   Hxp8  ?  @CCć @   DDD@ D@D@`AEǃAF@D@   @   @AFDD  CC     p@@?     @  @ B "    ~   @  j,,<2"2&""""x"" <<<<<  p8 H p x   " @  @@ @ >@@ >">"@ &""E &">@@  @ *2> 2"">2""@@ @>>"" @@ @  p  @@  @   @@ @ ?*@ B@ @ B  @` p@ @ `@ @ @ "C " #B  "B @ @  @@ @@ @ @  @ @@ @ @ @ @@ ! @#    D  @  @  $ 0  @  @UUU0  `   `     @  @ @ @ @ @ @ @ @       4C4C'X'-Ä@@ @0A@@@@0A@P@@@PA@P@@ `  A@@PA@@AA ` @ @@  $ % ?D$?#D"@????????& vGG_ f _fLLBfZ'  (b 8     @@@8@0@@ 9 a@  "@"$  "$`! @$ <GH, x@H @Hx @0@` D@@d* < "*0b B"*"2!x A"K$&b@ A I$D``0?(bL?@!"ID@! ED@x! @@ ` 8"@`H$ @DHH0H@BBD  0@ D$! BBDD@HB AB" BB <a"2ˆ! @ p@!@  @   ʃ(  | B! 0$B!@ 80@$B"AH0@! A@( !C@& B @3 ! `H4q"0DD1808`$"#! !! 3 ( 2"! 3  B( "A 3@DDB(D"2#CIe$B88 I2$ 3CDB(BD 3" DD"HB"( 3~! FB"HB"(AH ( `ȈH2 H` DHL$" Id@`FHd "B"HB$p"#"DD@P"!"DDD1$"@  @B,"$"HC  !*$"H"B  )F"$J$D A "D`!K><! DAB[0ٞ  D ABЀذنA 9B$ED@Ay0DBdM @ADBD`a0D CЀرن` IЀسن`H!BЇزنg&$@ `BBD"BH 2~!"D#"3!Fضَ'$"DЀضټ#A$$Ѐضٸ`#@2 D ?D?"D"D@"HBD ~| #IMBHAشٰ`# DB !Ę`ؼٰ`#! DB A@ظٰ`&  "B AAHH8H1 `ذٰ`&  "A$ A `gذϾo& "A& B /L0Ϝo&@D"A"9BAH A @H  B DD  "DDD"" D"a""BB 0BD"1""B AB#"$!@#$BD!D@$B" `$B  AB!A$!   "Ad A"ADb  H"? H B"?3 `OD$ 30 C@d !PAB  0HPA8@ DHA @  $(A` @30@p@@ "@30C@ @! @30?H @B!@@30? $ $A@ @ $A!@ $") ?@Q"8"@I" "@bI" B@"E" F@DB" D@$B! D@$B!!@D`"BA @b AA @"AA@AA@@@H@D @@O @?@@0|@B@CB@@H$! $P H(rUDVBTTX +O^?5?*  It may not be disclosed to %others or used for any purpose except as expressly consented to by %TERAK. 6COPYRIGHT 1980 BY "ADDRESS = -172; { -172 DEC = 177524 OCT = SERIAL #1 { <<<<<<<< } " "CR = 13; FF = 12; LF = 10; BS = 8; HT=9; DLE=16; SP= TERAK CORPORATION ="ALL RIGHTS RESERVED"}  {$R+}  {$I-}  PROGRAM PRINTOUT;  {This is a Run-Off program to grind 32;  TYPE "CS = PACKED RECORD 1JUNK: 0 .. 63; 1INT: BOOLEAN; 1DUN: BOOLEAN; 1BUNK: 0 .. 127; 1RDY: BOOLEAN .TEXT files thru ( either a printer controller or a serial interface. "END {CS}; CSDB = PACKED RECORD 1XCS: CS; 1XDB: CHAR  END {CSDB};  VAR "SLU: RECORD CASE BOOLEAN OF -TRU)The unmodified code drives the serial line unit #1 with )soft form feeds. Variations which may be injected are: +* Driving tE: (ADR: INTEGER); -FALSE:(REG: ^CSDB) "END {SLU}; "LIGHTS: PACKED ARRAY[0..500] OF INTEGER; {LIGHT SHOW BIAS} PAGEBUF:PACKhe line printer controler instead of the SLU. +* Generate hardware form feeds. +* Drive either device through the oED ARRAY[0..511] OF CHAR; {SCROLLING & LOOKAHEAD BUFFER} SRCBYT: INTEGER; {-> CHAR IN PAGEBUF UNDER SCRUTINY} "TGTBYT: Iperating system handlers. )Variations in the source code are flagged by '<<<<<<<<' . )To adjust PRINTOUT to your particularNTEGER; {-> CHAR PUT SPOT IN LINE} PBUFTOP:INTEGER; {NUMBER OF CHARACTERS LOADED INTO PAGEBUF}  installation, search out all )such flags, read the comments, and edit in your decisions. ) )Printout supports a set of run-off commands. A Command is a line )containing only two characters, justified against the left margin. )The commands are... $^F {TERAK CORPORATION believes that the information contained herein is %accurate. In no event will TERAK be liable for an FORMFEED Move to top of next page. $^O or ^0 OVERSTRIKE Suppress Line feed at end of this line. $^1 thru ^9 LINEFEEy losses or damages, %whether direct or indirect, resulting from the use of such %information, including, without limitation, D Advance one thru nine blank lines. $^P PARAGRAPH If within 10 lines of bottom of page ,Formfeed. $^S Start slosses arising from %claims of patent, copyright, and trademark infringement. No license %is granted hereby for the use of anyingle line spacing. $^D Start double line spacing. $^T Start triple line spacing.  patent or patent rights of %TERAK. TERAK reserves the right to update the information contained %herein at any time without f$^Q Start quadruple line spacing.}   CONST "PAGEHEIGHT=66; {66 rows per physical page} " "{Choose one of the fourther notice. % %The information contained herein is proprietary to TERAK CORPORATION %and must be treated as confidential.llowing two lines to drive printer or serial interface.} "{ADDRESS = -180; { -180 DEC = 177514 OCT = PRINTER #1} { <<<<<<<< }+  {FIRST THREE LINES OF EVERY PAGE}  LINEPTR: INTEGER; {SCANS HEADING & ETC LINE} "LINEEND: INTEGER; e has. For printer interface, " always use the 'WHILE...' line. For serial interface, use either line, or #neither if DATA S{CONTROLS HEADING SCAN END} "ALTLINE: BOOLEAN; {TRUE -> GET SOURCE FROM S } "PAGE,PAGECNT: INTEGER; {RUNNINET READY (pin 20 of RS-232) is not driven at all.} "REPEAT UNTIL SLU.REG^.XCS.RDY;{Ready bit wait (Serial, if active)}{<<<<<<<<G PAGE NUMBER}  PAGING: BOOLEAN; {TRUE -> INSERT PAGE NUMBERS} "COPIES: INTEGER; {NUMBER OF COPIES REQUESTED} "I, } "{WHILE SLU.REG^.XCS.RDY DO; {Error bit wait (Printer, always)}{<<<<<<<< } " "REPEAT UNTIL SLU.REG^.XCS.DUN; {WAIA: INTEGER; {GEN'L USE} "OVERSTRIKE: BOOLEAN; {FLAG TO OVERSTRIKE NEXT LINE} T ON DONE BIT} "SLU.REG^.XDB:=C; {SEND THE CHARACTER}  END;   PROCEDURE GETCCH;  VAR MASK: PACKED ARRA PPAG: CHAR; {PAGINATE? DEFAULT YES} "PHED: CHAR; {HEADING? DEFAULT NO} "PNUM: CHAR; {PAGE NUY[0..0]OF CHAR;  BEGIN "UNITREAD(2,MASK[0],1); CCH:=MASK[0]; "IF CCH IN ['a'..'z'] THEN CCH:= CHR(ORD(CCH)-32);  END;  PROMBERS? DEFAULT NO} "PSPAC: CHAR; {LINE SPACING. DEFAULT SINGLE} "PCOP: INTEGER; {NUMBER OF COPIES. DEFAULT ONECEDURE GETNUMBER (VAR N:INTEGER);  VAR "NUMBER:INTEGER; "COUNT:INTEGER;  PROCEDURE ECHO; BEGIN WRITE(CCH); COUNT:=COUNT+1; E} "PMARG: CHAR; {SPECIAL MARGINS? DEFAULT NO} "PMOR: CHAR; {ANY MORE? DEFAULT NO}  PTXT: STRING; ND;  BEGIN COUNT:= 0; "GETCCH; IF CCH = CHR(CR) THEN WRITE(N) "ELSE BEGIN NUMBER := 0; REPEAT  {FILENAME. DEFAULT SYSTEM.WRK.TEXT}  {PFRM: CHAR;} {INITIAL FF? DEFAULT NO} -{Use the above if prompting for initia$IF (CCH>='0') AND (CCH<='9') THEN &BEGIN NUMBER:= 10*NUMBER+ORD(CCH)-ORD('0'); ECHO; END; $IF (COUNT>0) AND (CCH=CHR(BS)) THl formfeed} {<<<<<<<<<<}  {PEJCT: CHAR;} {PAGE EJECT? DEFAULT NO} -{Use the above if prompting for page eject} {<<<<<EN &BEGIN WRITE(CHR(BS),' ',CHR(BS)); NUMBER:= NUMBER DIV 10; $ COUNT:= COUNT-1; END; ! GETCCH UNTIL CCH = CHR(CR); N "LINE: PACKED ARRAY [1..200] OF CHAR; {LINE UNDER CONSTRUCTION} "SOURCE:FILE; S:STRING; BLKNUM:INTEGER; {RUNNING FILE BLOC<<} -  {To drive the printer or serial interface through the operating system,  replace the entire procedure PNTBYT with theK NUMBER}  CCH:CHAR; {RESULT FROM GETCCH} "NUL:CHAR; {ALWAYS = CHR(0)}  LMARGIN,RMARGIN:INTEGER; {COLUMN following proceedure...  PROCEDURE PNTBYT(C:CHAR);  BEGIN UNITWRITE(6,C,1) END; !change the 6 above to 8 in order to drive tS ON PRINTER}  LINECNT: INTEGER; {NUMBER OF LINES PRINTED ON THIS PAGE}  LINESPERPAGE: INTEGER; {LINES he serial interface}   PROCEDURE PNTBYT(C:CHAR);  BEGIN TO PRINT PER PAGE}  SPACING: INTEGER; {SINGLE, DOUBLE, TRIPLE, QUAD LINE SPACING} "H: ARRAY[1..3]OF STRING; "{Choose one or none of the following two lines, depending upon what, if any, #sense the signal driving bit 15 of the interfac, "IF CCH<>CHR(CR) THEN C:=CCH; {Parameter is default} WRITELN(C);  END;   PROCEDURE PAGENUM;  VAR  CATCHER,J: INTEGER; "$upon the printer, and using the O/S drivers, one of these may need $to be removed to avoid double spacing or no spacing <<<<ZEROES:BOOLEAN; "PWRS: PACKED ARRAY [0..4] OF INTEGER;  BEGIN "FILLCHAR(LINE[1],200,CHR(SP)); "ZEROES:=TRUE; A:=PAGECNT; "P<<<<} " "{PNTBYT(NUL); {Repeat, If any filling is required after CR or LF <<<<<<<} "LINECNT:=LINECNT+1;  END;   PROCEDUREWRS[0]:=1; FOR I:=1 TO 4 DO PWRS[I]:=10*PWRS[I-1]; "J:=RMARGIN-7; "FOR I:=4 DOWNTO 0 DO $BEGIN &J:=J+1; &CCH:=CHR(A DIV PWR FORMFEED;  BEGIN "{PNTBYT(CHR(FF));} ${>>>>>>>> Use above for hardware FF, or below for software FF <<<<<<<<} "WHILE LINECNS[I] + 48); &IF CCH='0' THEN BEGIN IF ZEROES THEN BEGIN CCH:=' '; CATCHER:=J END END 1ELSE ZEROES:=FALSE; &A:=A MOD PWRS[I]; T=PBUFTOP THEN GETMORE; 1BYT:=PA PROCEDURE GETFILENAME;  BEGIN !WRITE('filename: ',PTXT,'>'); READLN(S); !IF LENGTH(S)<>0 THEN PTXT := S; I:=LENGTH(PTXT); GEBUF[SRCBYT]; { Pick up a byte } 1PAGEBUF[SRCBYT]:=NUL; { Drives the light show} 1SRCBYT:=SRCBYT+1; { Post increment } +!IF (I>0) AND (POS('.TEXT',PTXT)=0) THEN PTXT:=CONCAT(PTXT,'.TEXT'); !IF LENGTH(PTXT)>24 THEN BEGIN WRITELN('*Ill filename*'); END; $TRUE: BEGIN IF LINEPTR>LINEEND THEN BYT:=CHR(CR) ELSE -BEGIN BYT:=S[LINEPTR]; LINEPTR:=LINEPTR+1 END END "END  END; I:=0 END;  END; {RETURN WITH I=0 -> BAD / NO FILENAME}   PROCEDURE FILEOUT;  FORWARD;   PROCEDURE GETMORE; {GET A BLK FR  PROCEDURE PUSHBYT(C:CHAR);  BEGIN "IF TGTBYT<=200 THEN BEGIN LINE[TGTBYT]:=C; TGTBYT:=TGTBYT+1 END;  END;  OM FILE, MOVE TO TOP OF PAGEBUF}  BEGIN ${ Clear space in text space } "FILLCHAR(PAGEBUF[0],512,NUL); ${ Sentinel in 1st chaPROCEDURE TAB(CNT:INTEGER);  BEGIN "WHILE CNT>0 DO BEGIN PUSHBYT(CHR(SP)); CNT:=CNT-1 END  END;   BEGIN {MAKELINE}  FILr in case of EOF or I/O error } " { EOF EXIT does not prevent a call to LINEOUT } "PAGEBUF[0]:=CHR(CR);  { Check for endLCHAR(LINE[1],200,CHR(SP)); TGTBYT:=LMARGIN; LINEDONE:=FALSE; "REPEAT $POPBYT; $IF ORD(BYT)NUL,PAGEBUF[511])+512; ${ Bump BLKNUM for next time } "BLKNUM:=BLKNUM+1; SRCBYT:=0; $END;  PROCEDURE LINEFEILE I>SP DO BEGIN I:=I-1; PUSHBYT(CHR(SP)) END END; &LINEDONE:= BYT=CHR(CR) $END ELSE ${ Printable character section } &PUSH:= NUMBER; END;  END {GETNUMBER};  PROCEDURE NOYES(VAR C:CHAR);  BEGIN "REPEAT GETCCH UNTIL CCH IN ['Y','N',' ',CHR(CR)]; ED;  BEGIN "PNTBYT(CHR(CR)); PNTBYT(CHR(LF)); {These terminate each line. Depending - mber at top } $IF LINECNT=0 THEN $BEGIN &IF PAGING THEN BEGIN PAGENUM; LINEOUT END; &LINECNT:=1; $END; $ SE FOR A:=1 TO 3 DO H[A]:=''; &PROMPT('Page numbers? '); WRITE(PNUM,'>'); NOYES(PNUM); " IF PNUM='Y' THEN (BEGIN PROMPT('E${ check for possible header on next three lines } $IF (LINECNT IN [1..3]) AND (LINESPERPAGE>0) THEN $BEGIN S:=H[LINECNT]; Lnter starting page number: '); (WRITE(PAGE,'>');GETNUMBER(PAGE); WRITELN; .IF PAGE=0 THEN PAGE:=1; PAGING:=TRUE END (ELSE PAGBYT(BYT); "UNTIL LINEDONE;  END; "  PROCEDURE COMMAND(C:CHAR);  BEGIN "CASE C OF "'O','0': OVERSTRIKE:=TRUE;{This may notINEEND:=LENGTH(S); +LINEPTR:=1; ALTLINE:=TRUE; MAKELINE; LINEOUT; +ALTLINE:=FALSE END ${ else output a line } $ELSE BEGIN MA work, depending on printer <<<<<<<< } "'F': FORMFEED; "'1','2','3','4','5','6','7','8','9': FOR CCH:=C DOWNTO '1' DO LINEFEEKELINE; LINEOUT END; {MAKELINE CALLS GETMORE AS REQ'D} $IF (LINESPERPAGE>0)AND(LINECNT>LINESPERPAGE) THEN FORMFEED; "UNTIL FALD; "'P': IF LINECNT>LINESPERPAGE-10 THEN FORMFEED; "'S': SPACING:=1;  'D': SPACING:=2; "'T': SPACING:=3; "'Q': SPACING:=4SE; {EXIT IN GETMORE GETS US OUT}  END;   PROCEDURE PROMPT(S:STRING);  BEGIN "FOR I:=1 TO 35-LENGTH(S) DO WRITE(' '); WRIT "END;  END;   PROCEDURE LINEOUT;  VAR LFTBYT, RYTBYT: INTEGER;  BEGIN  { Find right hand edge of line } E(S);  END; "  PROCEDURE INIT;  BEGIN  PPAG:='Y';PHED:='N';PNUM:='N';LINESPERPAGE:=49;  PAGE:=1;PSPAC:='S';PCOP:=1;PMARG:="RYTBYT:=SCAN(-199,<>CHR(SP),LINE[200])+200; { Right hand edge 1..200}  { Truncate right hand edge } "IF RYTBYT>=RMARGIN THEN'N';PTXT:='SYSTEM.WRK.TEXT';  LMARGIN:=1;RMARGIN:=80;PMOR:='N';NUL:=CHR(0);  {PFRM:='N';}{Use this if prompting for initial fo RYTBYT:=RMARGIN;  { Check for control commands } "IF (RYTBYT=2)AND(LINE[1]='^') THEN COMMAND(LINE[2]) ELSE $BEGIN &IF RYTBYrmfeed, below}{<<<<<<<}  {PEJCT:='N';}{Use this if prompting for page eject, below}{<<<<<<<}  WRITELN('PRINTOUT... text file pT>=1 THEN FOR TGTBYT:=1 TO RYTBYT DO PNTBYT(LINE[TGTBYT]); &IF OVERSTRIKE THEN PNTBYT(CHR(CR)) (ELSE CASE ALTLINE OF /FALSE: rinting utility... V02-01');  END;   PROCEDURE PAGINATE;  BEGIN   { Are we to page? } FOR TGTBYT:=SPACING DOWNTO 1 DO LINEFEED; /TRUE: LINEFEED -END; &OVERSTRIKE:=FALSE; $END  END;   PROCEDURE FILEOUT;  B"PROMPT('Paginate? '); WRITE(PPAG,'>'); NOYES(PPAG);  IF PPAG='N' THEN BEGIN PAGING:=FALSE; LINESPERPAGE:=0 END ELSE  $BEEGIN "BLKNUM:=2; {SKIP FIRST TWO BLOCKS} "PBUFTOP:=0; {FIRST UNUSED BYTE IN PBUF} "SRCBYT:=0; {PAGEBUF SCANNER} "LINECNT:=GIN ${ Get lines per page } &REPEAT PROMPT('Enter lines per page: '); WRITE(LINESPERPAGE,'>'); &GETNUMBER(LINESPERPAGE); &WR0; {START AT LINE 1 ON PAGE (0 triggers page numberer} "PAGECNT:=PAGE; {START AT GIVEN STARTING PAGE} "PAGEBUF[0]:=CHR(CR); {IITELN; UNTIL LINESPERPAGE IN [10..100]; ${ Get heading strings and/or page number start } &PROMPT('Heading? '); WRITE(PHED,'>'NCASE NON-INTEGRAL # OF LINES IN BLK} "ALTLINE:=FALSE; OVERSTRIKE:=FALSE; {RESET FLAGS} "REPEAT ${ check for possible page nu); NOYES(PHED); &IF PHED='Y' THEN (BEGIN FOR A:=1 TO 3 DO BEGIN WRITELN('Enter Heading line #',A); EREADLN(H[A]) END END (EL. MARGIN:=1; RMARGIN:=80 END; " "{ Set up printer } "SLU.ADR := ADDRESS; "SLU.REG^.XCS.INT:=FALSE; "{Remove the above two lines if driving interface thru O/S handlers <<<<<<<<} " "{PROMPT('Initial form feed? '); WRITE(PFRM,'>'); ػ  @" NOYES(PFRM); IF PFRM='Y' THEN FORMFEED;} ${>>>>>>>> Use above for hardware FF, or below for software FF <<<<<<<<} "PROMPT(' á  V0ĩ9Ȅ ُ0ũÄ"   áٚV xAlign top-of-form'); WRITELN; "PROMPT('Type space for linefeed; Type to continue'); "REPEAT GETCCH; IF CCH=' ' THEN LINEF @ ˡة8@ 7;< <ȡ$<EED; UNTIL CCH=CHR(CR); WRITELN;{<<<<<<<} " "UNITWRITE(3,LIGHTS[0],35); {GIVE THE FOLKS A SHOW} "REPEAT COPIES:=COPIES-1; FIL <<<< <ġZ;<00á ڡ ;<;ING:=FALSE $END;  END;    BEGIN  INIT;  REPEAT "REPEAT $WRITE('Text '); GETFILENAME; $RESET(SOURCE,PTXT); I:=IORESULEOUT; FORMFEED UNTIL COPIES<=0; "UNITWRITE(3,LIGHTS[0],7); {Turn off light show} CLOSE(SOURCE);  "{PROMPT('Eject page? ');T; IF I<>0 THEN WRITELN('?File not found?'); "UNTIL I=0; "PAGINATE; $  { Get number of lines per line }  WRITE(PEJCT,'>'); "NOYES(PEJCT); IF PEJCT='Y' THEN FORMFEED;} 0{ Above is most useful for software FF <<<<<<<<} " "WRITELN;"PROMPT('Line spacing: S)ingle, D)ouble, T)riple, or Q)uad? '); "WRITE(PSPAC,'>'); REPEAT GETCCH #UNTIL CCH IN['S','D','T','Q PROMPT('Is there any more? '); WRITE(PMOR,'>'); "NOYES(PMOR);  UNTIL PMOR<>'Y';  END. "  ',CHR(CR)]; #IF CCH <> CHR(CR) THEN PSPAC := CCH; #COMMAND(PSPAC); WRITELN(PSPAC); $  { Get number of copies to run out } " PROMPT('Enter number of copies: '); WRITE(PCOP,'>'); " GETNUMBER(PCOP); WRITELN; COPIES := PCOP; " "{ Non standard margins ??? } "PROMPT('Non-standard margins? '); WRITE(PMARG,'>'); " NOYES(PMARG);IF PMARG='Y' THEN $BEGIN REPEAT PROMPT('Left margin PRINTOUT  column: '); $WRITE(LMARGIN,'>'); GETNUMBER(LMARGIN); WRITELN; $UNTIL LMARGIN IN [1..198]; $REPEAT PROMPT('Right margin colu mn: '); $WRITE(RMARGIN,'>'); GETNUMBER(RMARGIN); WRITELN; $UNTIL (RMARGIN IN [1..199])AND(RMARGIN>LMARGIN); $END ELSE BEGIN L/   ɡ; á áث<< š <<  ١J% n عM= ث1>CCYáצLeft margin column:  >Right margin column:  >ġ y š jd^XR0TJUMOQSUWY[] "$&(B,{02468:ńPǬצAlign top-of-formצ.Type space for linefeed; Type to conti<>oPFf\   ةġå^Änġ(ȡnue á á#:: :ȡ`Is there any more? D= 36"ġ  *=+f 87>DDYˡƃ`rOItV"Hh 6 R  T v *tandard margins? C 6=á 9ń,)P546 6 ũń i>CCYáצLeft margin column:  >Right margin column:  > تP<#+<+ȡ <<%T>Y>N?N@18SABNCESYSTEM.WRK.TEXTתńPǬצAlign top-of-formצ.Type space for linefeed; Type to contiPPNDצ0PRINTOUT... text file printing utility... V02-01צ Paginate? >>O^>>Ná 9Enter lines per page:  >צ Heading? ?>e<<ڡ 0צPageP  filename: E>P??Yáb;;ȡREnter Heading line #; ;)P;;*;;ȡˡEPE<<צ.TEXTEÄ!EEPצ.TEXTUPEš"צ*Ill filename*;)תP;;צPage numbers? @>@@YáOEnter starting page number: 8 ><V  `á  l  88á899ƃ`ƄՁxText `E"<<ˡ ?File not fou  Bɡ 77 " 6Wġ 045š nd?<á3Line spacing: S)ingle, D)ouble, T)riple, or Q)uad? A>  444 _.pȡؿ(š  AAAEnter number of copies: B >BB:Non-standard margins? C0  STATUSWORD: INTEGER; FIRST: INTEGER; SECOND: INTEGER; EXTENSION: INTEGER; LGTH: INTEGER; FILLER: INTEGER; DATE: DATEWRD END; XFERTYPE=(RT11EDIT,BINARY,NONE); " DIREC = RECORD CASE BOOLEAN OF FALSE: (BUF: PACKED ARRAY [0..1023] OF CHAR); TRUE: (SEGSAVAIL: INTEGER; NEXTSEG: INTEGER; HIGHSEG: INTEGER; FILLER: INTEGER; BEGINSEG: INTEGER; ENTRY: ARRAY [0..71] OF FILENTRY) END; VAR I, BLOCK,FILESIZE: INTEGER; B:BOOLEAN; "CH:CHAR; OUT! {TERAK CORPORATION believes that the information contained herein is %accurate. In no event will TERAK be liable for any: CHARS; RT11: DIREC; "XFEROPTION:XFERTYPE; TITLE,WANTED:PACKED ARRAY[0..9] OF CHAR; "S:STRING; "INBUF,OUTBUF:PACKED ARRA losses or damages, %whether direct or indirect, resulting from the use of such %information, including, without limitation, lY[0..1023] OF CHAR; "FOUT:FILE; MONSTR: PACKED ARRAY[1..12] OF STRING;  PROCEDURE DERAD50 (WORD: INTEGER; VAR STORE: CHARS)osses arising from %claims of patent, copyright, and trademark infringement. No license %is granted hereby for the use of any ; VAR I: INTEGER; NEG: BOOLEAN; BEGIN NEG := WORD < 0; IF NEG THEN WORD := WORD + 32767 + 1; patent or patent rights of %TERAK. TERAK reserves the right to update the information contained %herein at any time without fu STORE[2] := CHR (WORD MOD 40); IF NEG THEN BEGIN WORD := WORD DIV 40 + 819; IF STORE[2] >= CHR(32) THEN WORDrther notice. % %The information contained herein is proprietary to TERAK CORPORATION %and must be treated as confidential.  := WORD + 1; STORE[2] := CHR( (ORD(STORE[2])+8) MOD 40) END ELSE WORD := WORD DIV 40; STORE[1] := CHR (WORD MIt may not be disclosed to %others or used for any purpose except as expressly consented to by %TERAK. 6COPYRIGHT 1980 BY OD 40); STORE[0] := CHR (WORD DIV 40); FOR I := 0 TO 2 DO BEGIN WORD := ORD(STORE[I]); IF WORD = 0 THEN WORDTERAK CORPORATION ="ALL RIGHTS RESERVED"} (*$I-*)  PROGRAM RT2PAS; CONST EMPTY = 512; PERM = 1024; TENTATIVE = 256; E := ORD (' ') ELSE IF WORD <= 26 THEN WORD := WORD + 64 ELSE IF WORD >= 30 THEN WORD := WORD + 18 ENDMARK = 2048; TYPE DATEWRD = PACKED RECORD 0YEAR: 0..31; (*YEAR-72*) 0DAY: 0..31; (*ALLOCATE*) 0MONTH: 0..31; (*5 BITS EA*) 0JUNK: 0..1 (*INTEGER FILL*) ,END; "CHARS = PACKED ARRAY [0..2] OF CHAR; FILENTRY = RECORD1 2TITLE[6]:='.'; 2MOVERIGHT(OUT[0],TITLE[7],3); 0END; ,END; *B:=(WANTED=TITLE); *IF NOT B THEN ,BEGIN .BLOCK:=BLOCK+LGTH; "I,BLKNUM,PIN,POUT,BLANKCNT:INTEGER; "INCH:CHAR; "NEWLINETOG:BOOLEAN;   BEGIN "FILLCHAR(INBUF,512,CHR(0)); "FILLCHAR(OULSE (*ERROR-CHANGE TO BLANK*) WORD := ORD (' '); STORE[I] := CHR(WORD) END END (*DERAD50*); PROCEDURE ENRAD (NUM .I:=I+1; ,END; (END (*WHILE*); $IF B THEN FILESIZE:=RT11.ENTRY[I].LGTH $ELSE BEGIN WRITELN('?FIL NOT FND?'); BLOCK:=-1 ENDBARS: INTEGER; VAR I: INTEGER); VAR M, N, P, J: INTEGER; BEGIN J := NUMBARS DIV 10; I := NUMBARS MOD 10 + 40 * (J MOD 10) ;  END (*LOCATEFILE*);   FUNCTION GETWANTED:BOOLEAN;  VAR I,J:INTEGER; BEGIN  WRITE('Enter source file title: '); "GETW+ 1600 * (J DIV 10) - 16306 END (*ENRAD*);  PROCEDURE SHOWDIR;  BEGIN "UNITREAD (5, RT11, 1024, 6); (*READ BLOCKS 6-7 = RT1ANTED:=FALSE; "WANTED:=' '; (*OVERLAY ONTO A BED OF SPACES*) READLN(S); "IF LENGTH(S)>0 THEN $BEGIN &I:=POS('.',S1 DIRECTORY*) WRITELN; WRITELN (' TITLE SIZE DATE'); WRITELN; I := 0; BLOCK := RT11.BEGINSEG; WITH RT11 DO ); &IF I<>-1 THEN (*FORCE TITLE SANS EXTENSION*) (FOR J:=I TO 6 DO INSERT(' ',S,I); (*INTO FIRST 6 POS WHILE ENTRY[I].STATUSWORD <> ENDMARK DO WITH ENTRY[I] DO "BEGIN $IF STATUSWORD = PERM THEN &BEGIN (DERAD50 (FIRST, OUT); ITIONS *) &IF LENGTH(S)<=10 THEN (*IF LENGTH IS REASONABLE*) (MOVERIGHT(S[1],WANTED[0],LENGTH(S)); &GETWANTED:=TRUE; (*IF LEN(WRITE (OUT); (DERAD50 (SECOND, OUT); (WRITE (OUT); (DERAD50 (EXTENSION, OUT); (IF OUT <> ' ' THEN WRITE ('.',OUT) ELSE WRGTH NOT RESONABLE, LOOKUP BLANK TITLE*) $END; END (*GETWANTED*);   PROCEDURE GETTGT;  BEGIN "REPEAT $WRITE('Enter target ITE (' ':4); (WRITE (LGTH:6); (IF (DATE.MONTH IN [1..12]) AND (DATE.DAY IN [1..31]) THEN ( WRITE(' ':4,DATE.DAY:2,'-',MONSTRfile title: '); $READLN(S); $B:=FALSE; $IF LENGTH(S)>0 THEN $BEGIN &REWRITE(FOUT,S); [DATE.MONTH],'-',DATE.YEAR+72:2); & WRITELN; &END; $BLOCK := BLOCK + LGTH; $I := I + 1 "END; WRITELN;  END (*SHOWDIR*); &IF IORESULT=0 THEN B:=TRUE ELSE WRITELN('?ILL FILE DESC?'); $END;  UNTIL B;  END; (*GETTGT*)   FUNCTION GETMODE:BOOLEA  PROCEDURE LOCATEFILE;  VAR I,J:INTEGER;  BEGIN "UNITREAD (5, RT11, 1024, 6); (*READ BLOCKS 6-7 = RT11 DIRECTORY*) I:=0N;  BEGIN "WRITE('Transfer Mode: B)inary or T)ext ? '); "READLN(S); CH:=CHR(0); IF LENGTH(S)>0 THEN CH:=S[1]; "XFEROPTION:=N; "B:=FALSE; BLOCK:=RT11.BEGINSEG; "WITH RT11 DO $WHILE (ENTRY[I].STATUSWORD<>ENDMARK) AND (NOT B) DO &WITH ENTRY[I] DO (ONE; "IF CH IN ['B','b'] THEN XFEROPTION:=BINARY; "IF CH IN ['T','t'] THEN XFEROPTION:=RT11EDIT; "GETMODE:=XFEROPTION<>NONE; BEGIN *IF STATUSWORD=PERM THEN ,BEGIN .DERAD50(FIRST,OUT); .MOVERIGHT(OUT[0],TITLE[0],3); .DERAD50(SECOND,OUT); .MOVERIGHT END; (*GETMODE*) &  PROCEDURE PUTPAGE(VAR POUT:INTEGER);  VAR I:INTEGER; "CH:CHAR;  BEGIN "I:=BLOCKWRITE(FOUT,OUTBUF,2);(OUT[0],TITLE[3],3); .DERAD50(EXTENSION,OUT); .IF OUT=' ' THEN 0FOR J:=6 TO 9 DO TITLE[J]:=' ' .ELSE 0BEGIN  "POUT:=0; "FILLCHAR(OUTBUF,1024,CHR(0));  END (*PUTPAGE*);  PROCEDURE TRANSLATE;  CONST "LF=10; "CR=13; "DLE=16;  VAR2 INBUF,1); &IF I<>1 THEN (BEGIN *WRITELN; *WRITE('OUTPUT ERROR, program terminated', CHR(7(*BEL*))); *EXIT(PROGRAM); ۡ (ۡ*(3 ġ((((ȡ;á ȡ(END; $END;  END (*XBINARY*);  BEGIN (*MAIN*) "MONSTR[1]:='Jan'; MONSTR[2]:='Feb'; MONSTR[3]:='Mar'; "MONSTR[4]:='Apr'; @ġ ٿB  ( @ Dz?$ צ TITLE SIMONSTR[5]:='May'; MONSTR[6]:='Jun'; "MONSTR[7]:='Jul'; MONSTR[8]:='Aug'; MONSTR[9]:='Sep'; "MONSTR[10]:='Oct'; MONSTR[11]:='ZE DATEGˡGá ׷ .Nov'; MONSTR[12]:='Dec'; "WRITELN('RT2PAS RT-11 TO PASCAL FILE TRANSFER UTILITY V01-01'); "WRITELN('RT-11 structur  آ آK آ -fآ  )-آH TBUF,1024,CHR(0)); "I:=BLOCKWRITE(FOUT,OUTBUF,2,0); (*2 blocks of nuls to start*) "BLANKCNT:=0; POUT:=0; "NEWLINETOG:=FALSEed disk is assumed to be in QX1 drive (Unit 5)'); "REPEAT $REPEAT &WRITE('Display the directory? (y/n)'); &READLN(S); PAGE(O; FOR BLKNUM:=1 TO FILESIZE DO $BEGIN &UNITREAD(5,INBUF,512,BLOCK); &BLOCK:=BLOCK+1; &PIN:=0; &WHILE PIN<=511 DO UTPUT); &IF LENGTH(S)>0 THEN IF S[1] IN ['Y','y'] THEN SHOWDIR; $ IF GETWANTED THEN LOCATEFILE ELSE BLOCK:=-1; $UNTIL BLOCK>& BEGIN *INCH:=INBUF[PIN]; IF NOT (ORD(INCH) IN [0,LF]) THEN ,BEGIN .WRITE(INCH); IF INCH=CHR(CR) T=0; $CLOSE(FOUT); (*COVERS RECALL TO GETTGT*) $GETTGT; "UNTIL GETMODE; "CASE XFEROPTION OF $RT11EDIT: TRANSLATE; $BINARY:XHEN 0BEGIN 2OUTBUF[POUT]:=CHR(CR); 2POUT:=POUT+1; NEWLINETOG:=TRUE; 2BLANKCNT:=0; 2IF POUT>940 THEN PUTPABINARY; "END (*CASE*); "CLOSE(FOUT,LOCK); WRITELN('*** FILE TRANSFER DONE ***');  END. GE(POUT); 0END .ELSE 0IF NEWLINETOG THEN 2BEGIN 4IF INCH=' ' THEN 6BLANKCNT:=BLANKCNT+1 4ELSE 6BEGIN 8OUTBUF[POUT]:=CHR(DLE); OUTBUF[POUT+1]:=CHR(ORD(' ')+BLANKCNT); NEWLINETOG:=FALSE; 8OUTBUF[POUT+` RT2PAS 2]:=INCH; 8POUT:=POUT+3; 6END; 2END (*NEWLINETOG*) 0ELSE 2BEGIN 4OUTBUF[POUT]:=INCH; 4POUT:=POUT+1; 2END; *END (*IF INB UF...*); *PIN:=PIN+1; (END (*WHILE*); $END (*FOR*); "PUTPAGE(POUT);  END (*TRANSLATE*);  PROCEDURE XBINARY;  VAR I,BLKNUM:INTEGER;  BEGIN "FOR BLKNUM:=1 TO FILESIZE DO $BEGIN &UNITREAD(5,INBUF,512,BLOCK); &BLOCK:=BLOCK+1; &I:=BLOCKWRITE(FOUT,3  >>> t* > > >>ȡ>ȡ> á#> Ǭš Pޡ= á/>> ؂>ݿ>ݿ  ȡm>>>ˡ<צ OUTPUT ERROR, program terminatedt Ɔ>ƇjՁ4f )JanתPf )צFebPf )MarתPf )צAprPf )MayתPf )צJunPf )JulתPf )צAugPf  )SepתPf  )צOctPf  )NovתPf  )צDecP>RT2PAS RT-11 TO PASCAL FILE TRANSFER UTILITY  {TERAK CORPORATION believes that the information contained herein is %accurate. In no event will TERAK be liable for an V01-01      ׯ  ȡ  .   퓡  G>צ*** FILE TRANSFER DONE ***Ɔ>rxDl, JulתPf )צAugPf  !צ ?FIL NOT FND?3 Enter source file title:  P)SepתPf  )צOctPf  )NovתPf  )צDecP>RT2PAS RT-11 TO PASCAL FILE TRANSFER UTILITY šQ.ץˡȡצ P ȡ 9Enter target file title: Pš5>"áצ?ILL FILE DESC?z "Transfer Mode: B)inary or T)ext ? Pš   O^Ƞ4  It may not be disclosed to %others or used for any purpose except as expressly consented to by %TERAK. 6COPYRIGHT 1980 BYAN; {DONE...true-> character received} 0BUNK: 0 .. 7; 0OVF: BOOLEAN; {Software flag...ring buffer overflow occured} 0OVR:  TERAK CORPORATION ="ALL RIGHTS RESERVED"}  {Program to emulate a terminal to a 'HOST' computer system. This HOST is #typic BOOLEAN; {Overrun hardware error occured} 0BRK: BOOLEAN; {Continuous break detected} 0PTY: BOOLEAN; {Parity error detectally a time-sharer using telecom, but can also be another local ed} 0ERR: BOOLEAN {Inclusive OR of above four bits}  END;  XMITCS = PACKED RECORD 0BREAK: BOOLEAN; {Xmit cont's br#stand-alone computer. There are four local commands: receive file, #send file, emulate terminal, and quit. The serial intereak} 0JUNK: 0 .. 31; 0INT: BOOLEAN; {Interrupt enable} 0DUN: BOOLEAN; {DONE...true-> character received} 0BUNK: 0 .. 127face is #supported by our own handler (rather than REMOTE:) to maximize the #buffer space, minimize latency, and detect all er; 0RDY: BOOLEAN {Data terminal ready (static ready signal) }  END;  CSDB = PACKED RECORD /RCS: RECVCS; /RDB: CHAror conditions. Also, #the console is polled, and the system disk handler runs interruptable, #all to minimize the possibilitR; /JNK: CHAR; /XCS: XMITCS; /XDB: CHAR  END;  QUEUE = PACKED ARRAY [0..QUEUESIZE] OF CHAR; {Ring buffer for receiver} y of overrun during data file reception. #The emulated terminal will be a Data Media. However, by translating #control charact HANDLER = RECORD ,QBASE: INTEGER; {Address of ring buffer} ,QHEAD: INTEGER; {Index for insertion} ,QTAIL: INTers, any terminal could be emulated. Parts of TERMINAL #which are HOST dependent, are flagged by... <<<<<<<< .}  {$S+EGER; {Index for extraction} ,STATUS: RECVCS; {Status of reception} ,CODE: ARRAY [0..29] OF INTEGER *END; {N}  {$R-}  {$I-} PROGRAM TERMINAL; CONST HALFDUPLEX = FALSE; {Change to TRUE to run half duplex} QUEUESIZE = 16384; ote that STATUS is addressable as CODE[-1].}  CLKHANDLER = ARRAY [0..15] OF INTEGER;   VAR $I,J,LINECNT: INTEGER; $ABORT:  NUL = 0; BEL = 7; &BS = 8; {Non-destructive backspace} LF = 10; FF = 12; {Clear Console} &CR = 13; BOOLEAN; $CH: CHAR; $SRC,TGT,S: STRING; $ALPHALOCK: BOOLEAN; $TXTFILE: TEXT; $BINFILE: FILE; $BLKFILE: FILE; $  CSLU, losses arising from %claims of patent, copyright, and trademark infringement. No license %is granted hereby for the use of any DLE = 16; {Preamble for space compression} DC2 = 18; {Keystroke to toggle ALPHALOCK}  patent or patent rights of %TERAK. TERAK reserves the right to update the information contained %herein at any time without f HOME = 25; {Home cursor} &EOM = 25; CNTRLZ=26; {End of file char} &EOL = 29; {Erase to end-of-line} &DEL = 127; urther notice. % %The information contained herein is proprietary to TERAK CORPORATION %and must be treated as confidential.&FOREVER = FALSE;   TYPE  RECVCS = PACKED RECORD 0JUNK: 0 .. 63; 0INT: BOOLEAN; {Interrupt enable} 0DUN: BOOLE5  {CONSOLE SLU}  HSLU: {HOST SLU} 'RECORD CASE BOOLEAN OF )TRUE: (ADR: INTEGER); )FALSE:(REG: ^CSDB) 'END; $  QEN $BEGIN &CH:=CSLU.REG^.RDB; &READCH:=TRUE; &IF CH IN [' '..'~'] THEN BEGIN (IF ALPHALOCK OR SYS THEN ALPHAMAP(CH); (IF H: ^QUEUE; {Ring buffer for receiver}  H: ^HANDLER; {Receiver interrupt service routine, with Q pointers}  CLK: ^CLALFDUPLEX OR SYS THEN WRITECH(CH) &END ELSE IF ORD(CH)=DC2 THEN BEGIN READCH:=FALSE; (ALPHALOCK:=NOT ALPHALOCK END (ELSE IF (KHANDLER; {'New' line clock interrupt service routine}   FUNCTION OCTAL(S:STRING): INTEGER; {Interpret 6 digit string as intORD(CH)1 THEN RUBOUT; (DEL: WHILE I>1 DO RUBOUT; (CR: WRITELN &END;}  VAR MEM: RECORD CASE BOOLEAN OF TRUE:(ADR: INTEGER); FALSE:(DAT: ^INTEGER) END;  BEGIN MEM.ADR:=OCTAL(S); MEM.DAT^:=X; END; "UNTIL ORD(CH)=CR; "S[0]:=CHR(I-1); {Horse string length into correctitude}  END;    PROCEDURE ALPHAMAP(VAR CH:CHAR);  BEGIN IF CH IN ['a'..'z'] THEN CH:=CHR(ORD(CH)-32) END;   PROCEDURE WRITECH(CH: CHAR); FUNCTION RECVBYT(VAR C:CHAR):BOOLEAN; "{Pull a byte, if possible, from HOST handler ring buffer. " TRUE -> byte was transfer {Write Char to console} "BEGIN IF ORD(CH) IN [1..126,160..254] THEN BEGIN {Delete NUL, and both DELs} $REPEAT UNTIL CSLU.REed. FALSE -> nothing availble, or error}  BEGIN WITH H^ DO BEGIN "IF STATUS.ERR THEN $BEGIN RECVBYT:=FALSE; {Function false..G^.XCS.DUN; CSLU.REG^.XDB:=CH END END;   PROCEDURE WRITELN; {Write , to console} "BEGIN WRITECH(CHR(CR)); WRITECH(.} &ABORT:=TRUE; WRITECH(CHR(BEL));  IF STATUS.OVF THEN NOTICE('Software overrun occured'); &IF STATUS.OVR THEN NOTICECHR(LF)) END;   PROCEDURE PROMPT(S: STRING); {Write a string to console} "VAR I:INTEGER; "BEGIN WRITECH(CHR(EOL)); FOR I:('Hardware overrun occured'); &IF STATUS.BRK THEN NOTICE('Cont''s break received'); &IF STATUS.PTY THEN NOTICE('Parity error d=1 TO LENGTH(S) DO WRITECH(S[I]) END;   PROCEDURE NOTICE(S:STRING);  BEGIN WRITELN; PROMPT(S); WRITELN; END;  etected'); &CODE[-1]:=0; {Turn off all error bits} $END ELSE IF QHEAD=QTAIL THEN {Buffer is empty} RECVBYT:=FALSE ELSE &BEGI FUNCTION READCH(VAR CH:CHAR;SYS:BOOLEAN):BOOLEAN; "{Read a char from console, if possible.}  BEGIN "IF CSLU.REG^.RCS.DUN THN C:=Q^[QTAIL]; RECVBYT:=TRUE; (IF QTAIL=QUEUESIZE THEN QTAIL:=0 ELSE QTAIL:=QTAIL+1 END;  END END;   PROCEDURE XMITCHR(C:C6 $CODE[ 3] :=OCTAL('066700'); { ADD QBASE, R0 } $CODE[ 4] :=OCTAL('177756'); $CODE[ 5] :=OCTAL('113710'); { MOVB @#RD{Purge receiver} "CSLU.REG^.RCS.INT:=FALSE; {Turn it off} "CSLU.REG^.XCS.INT:=FALSE; {Xmitter too} {Set up new clock handler, B, (R0) } $CODE[ 6] :=OCTAL('177522'); $CODE[ 7] :=OCTAL('053767'); { BIS @#RCS, QSTAT } $CODE[ 8] :=OCTAL('177520'); to prevent reentry when priority goes to other tasks} "NEW(CLK); { ;ENTER AT LEVEL $CODE[ 9] :=OCTAL('177752'); $CODE[10] :=OCTAL('100421'); { BMI 4$ } $CODE[11] :=OCTAL('142720'); { BICB #200, (R0)+ 7} "CLK^[0] :=OCTAL('005167'); { COM 1$ ;COUNT ENTRIES} "CLK^[1] :=OCTAL('000016'); HAR); {Send character to HOST synchronously}  BEGIN REPEAT UNTIL HSLU.REG^.XCS.DUN; HSLU.REG^.XDB:=C; END;   PROCEDURE XMITS } $CODE[12] :=OCTAL('000200'); $CODE[13] :=OCTAL('166700'); { SUB QBASE, R0 } $CODE[14] :=OCTAL('177732'); $CODE[15] :TR(S:STRING); {Send string synchrounously, no delimiters added}  VAR CURSOR:INTEGER; =OCTAL('020027'); { CMP R0, #QUEUESIZE } $CODE[16] :=QUEUESIZE; $CODE[17] :=OCTAL('101401'); { BLOS 2$ } $CODE[18]  BEGIN CURSOR:=1; WHILE CURSOR<=LENGTH(S) DO "BEGIN XMITCHR(S[CURSOR]); CURSOR:=CURSOR+1; END; END;   PROCEDURE RESTART; :=OCTAL('005000'); { CLR R0 } $CODE[19] :=OCTAL('020067'); {2$: CMP R0, QTAIL } $CODE[20] :=OCTAL('177722'); $CODE[21]{Call to start listening to HOST}  BEGIN WITH HSLU.REG^ DO BEGIN "RCS.INT:=FALSE; {Quit listening} "H^.QTAIL:=0;  :=OCTAL('001004'); { BNE 3$ } $CODE[22] :=OCTAL('012767'); { MOV #^B1000100000000000, QSTAT } $CODE[23] :=OCTAL('10 {Purge the...} "H^.QHEAD:=0; {input buffer} "H^.CODE[-1]:=0; {Reset errors} "RDB:=RDB; {Purge r4000'); $CODE[24] :=OCTAL('177714'); $CODE[25] :=OCTAL('000402'); { BR 4$ } eceiver} "RCS.INT:=TRUE; {Listen up} "WRITECH(CHR(FF)); {Clear console} "XMITCHR(CHR(CR)) {Ret the HOST}  EN$CODE[26] :=OCTAL('010067'); {3$: MOV R0, QHEAD } $CODE[27] :=OCTAL('177702'); $CODE[28] :=OCTAL('012600'); {4$: MOV (SP)+D END;   PROCEDURE SETUP; {Call one time only} BEGIN "ALPHALOCK:=TRUE; "NEW(H); {Memory space for handler...} "NEW(Q); { a, R0 } $CODE[29] :=OCTAL('000006'); { RTT } "END;  {SET UP HOST RECEIVER} "HSLU.ADR:=OCTAL('177520'); {SLU #1} "{REnd for input ring buffer.} "WITH H^ DO BEGIN  {LOAD RECEIVE HANDLER} $QBASE:=ORD(Q); $QHEAD:=0; $QTAIL:=0; $STATUS.ERR:=FAPEAT UNTIL HSLU.REG^.XCS.RDY;{Wait on ready bit} {<-- Compile iff modem dready valid} "HSLU.REG^.RCS.INT:=FALSE; {Turn off recLSE; ${The following text was generated by MACRO-11, and PAS2RT.} $CODE[ 0] :=OCTAL('010046'); {1$: MOV R0, -(SP) } $CODE[ eiver}  HSLU.REG^.XCS.INT:=FALSE; {and transmitter.} {SET UP VECTOR FOR RECEIVER} "PATCH('120', ORD(H)+8); "PATCH('122', OC1] :=OCTAL('016700'); { MOV QHEAD, R0 } $CODE[ 2] :=OCTAL('177764'); TAL('200'));  {Turn off all CONSOLE interrupts} "CSLU.ADR:=OCTAL('177560'); {SLU #0, or 8532 keyboard} "CH:=CSLU.REG^.RDB; 7 6'); { 4$: RTT ;AND WAIT FOR ZERO} "PATCH('000100', ORD(CLK));  {MAKE FLOPPY INTERRUPTABLE} ould be injected easily.} (END; $CLOSE(BINFILE) "END;  PROCEDURE SENDTXTFILE; "VAR REPTCNT: INTEGER; "BEGIN $REPEAT &"PATCH('000252',0); {QX controller status word}  {PRINT AN INITIAL CHARACTER TO EACH PORT} "RESTART {Turn on receiver} READ(TXTFILE,CH); REPTCNT:=1; &CASE ORD(CH) OF (NUL: REPTCNT:=0; (DLE: BEGIN READ(TXTFILE,CH); REPTCNT:=ORD(CH)-32; CH:=' ' E END;   PROCEDURE SHUTDOWN; {Must call before leaving program to O/S}  BEGIN "HSLU.REG^.RCS.INT:=FALSE; {Host ND &END; &WHILE REPTCNT>0 DO BEGIN REPTCNT:=REPTCNT-1; XMITCHR(CH) END; &WHILE EOLN(TXTFILE) AND NOT EOF(TXTFILE) DO (BEGIN service OFF!} "PATCH('000100',CLK^[7]); {Repair line clock vector} PATCH('000252',OCTAL('000340')); {RepaiXMITCHR(CHR(CR)); XMITCHR(CHR(LF)); {<-TEMPORARY!} PURGE; TALLY; *REPTCNT:=0; CLK^[14]:=3; {48 TO 64 MS wait after each line} r QX controller vector} "CSLU.REG^.RCS.INT:=TRUE; {Turn on ...} "CSLU.REG^.XCS.INT:=TRUE; {Console s*REPEAT ABORTCHK UNTIL CLK^[14]=0; *READ(TXTFILE,CH); {Purge delimiter} END; &ABORTCHK; $UNTIL ABORT OR EOF(TXTFILE); $CLOService} "EXIT(TERMINAL) {Ascend to Nirvanna}  END; "  PROCEDURE ABORTCHK;  VAR X:CHAR; BEGIN IF READE(TXTFILE) "END;   BEGIN {SENDFILE} "REPEAT $PROMPT('Local source file name: '); READS(SRC); $IF LENGTH(SRC)>0 THEN &BEG"CLK^[2] :=OCTAL('001405'); { BEQ 2$ ;SKIP IF ON} "CLK^[3] :=OCTAL('106746'); { MFPS -(SP) ;CH(X,TRUE) THEN ABORT:=(ORD(X)=NUL) OR ABORT END;   PROCEDURE PURGE; {Wait for either from host, or from operator}FAKE-A-INTERRUPT} "CLK^[4] :=OCTAL('106427'); { MTPS #1 ;SERVICE AT LEVEL 0} "CLK^[5] :=1;   BEGIN REPEAT "REPEAT ABORTCHK UNTIL RECVBYT(CH) OR ABORT  UNTIL (ORD(CH)=LF) OR ABORT END;   PROCEDURE TALLY;  BEGIN WR { ;INT SERV EXPECTS CARRY SET} "CLK^[6] :=OCTAL('004737'); { JSR PC, @(PC)+ ;JUMP TO IT} "CLK^[7] :=FETCH('ITECH('.'); LINECNT:=LINECNT+1; IF LINECNT MOD 50=0 THEN WRITELN; END;   PROCEDURE SENDFILE(BINARYMODE: BOOLEAN);  000100'); { .WORD 0 ;Old clock vector} "CLK^[8] :=OCTAL('005127'); { 2$: COM (PC)+ ;TURN OFF FLAG"PROCEDURE SENDBINFILE; { Binary file xmitter is HOST dependent. <<<<<<<< } "VAR $BUF: PACKED ARRAY [0..7] OF PACKED ARRAY [0} "CLK^[9] :=0; { 1$: .WORD 0} "CLK^[10]:=OCTAL('005767'); { TST 3$ ;TIMER FOR LOCAL U..127] OF 0..15; "BEGIN $WHILE (BLOCKREAD(BINFILE,BUF,1) = 1) AND NOT ABORT DO &FOR I:=0 TO 7 DO (BEGIN *FOR J:=0 TO 127 DOSE} "CLK^[11]:=OCTAL('000004'); "CLK^[12]:=OCTAL('001402'); { BEQ 4$} "CLK^[13]:=OCTAL('005327'); { DEC ,BEGIN .XMITCHR(CHR(BUF[I,J]+ORD('@'))); .ABORTCHK; IF ABORT THEN BEGIN I:=10; J:=128 END; ,END; *XMITCHR(CHR(CR)); {Send (PC)+ ;TO USE, PUT TIME INTO} "CLK^[14]:=0; { 3$: .WORD 0 ;CLK^[14]} "CLK^[15]:=OCTAL('00000 a with each 128 char block} *PURGE; {Wait for reply before proceeding} *TALLY; {Check-sum c8 ENDTXTFILE; *IF ABORT THEN BEGIN NOTICE('Transfer aborted'); .XMITCHR(CHR(NUL)) END {Send Abort-file character. <<<<<<<< } ,EGEDUMP; {Write 2 blks of nulls for EDIT compatibility} *IF NOT ABORT THEN PULLFILE; *IF ABORT THEN ,BEGIN NOTICE('Transfer LSE BEGIN NOTICE(CONCAT(SRC,' transferred to ',TGT)); .XMITCHR(CHR(CNTRLZ)) END; {Send end-of-file character. <<<<<<<< } aborted'); CLOSE(TXTFILE,PURGE) END ,ELSE BEGIN NOTICE(CONCAT(SRC,' transferred to ',TGT)); .CLOSE(BLKFILE,LOCK) END (END $E(END $END  END;   PROCEDURE TAKEFILE;  CONST TIMEOUT= 180; {3 secs max wait for each char <<<<<<<<}  VAR INDEX: INTEGERND  END;   PROCEDURE COMMAND;  VAR CMD:CHAR;  BEGIN WRITECH(CHR(FF)); REPEAT $HSLU.REG^.RCS.INT:=FALSE; {Stop listenin; PAGE: PACKED ARRAY [0..1023] OF CHAR; " "PROCEDURE PAGEDUMP; {Null fill page buffer, and write} "BEGIN $FILLCHAR(PAGE[INg} $WRITECH(CHR(HOME)); $PROMPT('Terminal: S(end file, R(eceive file, T(erminal mode, Q(uit '); $REPEAT UNTIL READCH(CMD,TRUEDEX],1024-INDEX,0); INDEX:=0; $IF BLOCKWRITE(BLKFILE,PAGE,2) <> 2 THEN &BEGIN NOTICE('Disk output error'); ABORT:=TRUE END "E); WRITELN; ALPHAMAP(CMD); ABORT:=FALSE; $CASE CMD OF &'Q': SHUTDOWN; &'R': TAKEFILE; ND; " "PROCEDURE PULLFILE; "BEGIN $S:=CONCAT('PLEASE SEND ',SRC); {Adjust to HOST. <<<<<<<< } $XMITSTR(S); RESTART; {Sends&'S': BEGIN PROMPT('Send file: B(inary or T(ext '); .REPEAT UNTIL READCH(CH,TRUE); WRITELN; ALPHAMAP(CH); 0CASE CH OF 2'B': to HOST} $PROMPT('Receiving'); PURGE; CLK^[14]:=TIMEOUT; $WHILE (CLK^[14]>0) AND (NOT ABORT) DO &BEGIN (IF RECVBYT(CH) SENDFILE(TRUE); 2'T': SENDFILE(FALSE) 0END; END $END; "UNTIL CMD='T'; "RESTART  END;  PROCEDURE SENDBREAK;  BEGIN WITH THEN *BEGIN ,CLK^[14]:=TIMEOUT; {Reset timeout counter} ,IF ORD(CH)<>LF THEN {Delete all 's} .BEGIN 0PAGE[INDEX]:= HSLU.REG^ DO BEGIN "CLK^[14]:=14; {TIMEOUT 200 DIV 16} "RCS.INT:=FALSE; {Quit listening} "XCS.BREAK:=TRUE; CH; INDEX:=INDEX+1; 0IF ORD(CH)=CR THEN BEGIN TALLY; IF INDEX>920 THEN PAGEDUMP END .END *END; (ABORTCHK; &END; $WRITELN;  {Send break} "WHILE CLK^[14]>0 DO; {for 200 ms.} "XCS.BREAK:=FALSE; "RESTART {Start listening}  END END; IN (IF BINARYMODE THEN RESET(BINFILE,SRC) *ELSE BEGIN SRC:=CONCAT(SRC,'.TEXT'); RESET(TXTFILE,SRC) END; (IF IORESULT<>0 THEN $HSLU.REG^.RCS.INT:=FALSE; $IF NOT((INDEX=0) OR ABORT) THEN PAGEDUMP "END; (  BEGIN {TAKEFILE} NOTICE(CONCAT(SRC,' not found!')); &END; "UNTIL (LENGTH(SRC)=0) OR (IORESULT=0); "IF LENGTH(SRC)>0 THEN $BEGIN &PROMPT('Hos"PROMPT('Host source file name: '); READS(SRC); "IF LENGTH(SRC)>0 THEN $BEGIN &REPEAT (PROMPT('Local target file name: '); t target file name: '); READS(TGT); &IF LENGTH(TGT)>0 THEN (BEGIN LINECNT:=0; *S:=CONCAT('HERE COMES ',TGT); {Adjust to HOST.READS(TGT); (IF LENGTH(TGT)>0 THEN *BEGIN TGT:=CONCAT(TGT,'.TEXT'); REWRITE(BLKFILE,TGT); ,IF IORESULT<>0 THEN NOTICE(CONCAT( <<<<<<<< } *XMITSTR(S); RESTART; {Sends to HOST} *PROMPT('Transmitting'); PURGE; *IF BINARYMODE THEN SENDBINFILE ELSE SSRC,' is illegal!')); &END; &UNTIL (IORESULT=0) OR (LENGTH(S)=0); &IF LENGTH(TGT)>0 THEN (BEGIN *INDEX:=0; LINECNT:=0; *PA9  DC2 to alphalock, ^EOM to command, ^NUL to break.');  WRITELN;  REPEAT "IF READCH(CH,FALSE) THEN {Poll keyboard for anything áU]h ۢۢ צSoftware overrun occured  from operator} $IF ORD(CH)=EOM THEN COMMAND &ELSE IF ORD(CH)=NUL THEN SENDBREAK (ELSE XMITCHR(CH); "IF RECVBYT(CH) THEN WRI Hardware overrun occured ۢ צCont's break received ۢצParity error detected ۢ.á"TECH(CH); {Poll handler for anything from HOST}  UNTIL FOREVER;  END.  @áۢۢ1 ػ تP++ȡ+++T*8 TERMINAL آآ  B" ةآآآآ01004 6آ016700آ177764آ066700آ177756آ113710آ177522053767آ177520آ 177752آ 100421آ 142720آ 000200آ 166700آ177732آ020027آ@آ101401آ005000آ020067آڪP.--ɡ--.-0..%V8ڪP--T٪P,,ؚT177722آ001004آ012767آ104000آ177714آ000402آ010067 &Ǡػ<  تP+آ177702آ012600آ000006177520120שצ122צ200,+,ȡ+++V 2تPR ^۩ڍڍצ177560צ005167צ000016צ001405צ106746!á ړr    ڳPɡצ106427צ004737צ000100צ005127  צ005767 צ000ڿ ڹš š   "$&(*,.02468:<>@BDFHJLN004 צ001402 צ005327צ000006צ000100צ000252*000  BEGIN  SETUP;  PROMPT('TERMINAL V01-02... terminal emulator and file transfer utility.');  WRITELN;  PROMPT(' TypePRTVXZ\^`bdfhjlnprtvxz|~: ansferred to `Ƃ1ǰƂ  @ ;Terminal: S(end file, R(eceive file, T(erminal mode, Q(uit  عt~zצSend file: B(inary or T(ext   2-BT& 100ש000252צ000340N 퍫 퍡 퍡 "$0TQS|zxTáe آšآe :Ɓƃ .2á퓄Ńʁȡ>́ʁȡ" @ ǀ ƁƂƀƁՁצATERMINAL V01-02... terminal emulator and file transfer utility.צ; Type DC2 to al򥁱6tUI =  )"   ;š phalock, ^EOM to command, ^NUL to break. á á ƁƁƀDH .  á 𥀄]6pצLocal sBLj"R H j6J:y or T(ext   2-BT& ource file name: Z ZšeءZ+ZZP.TEXTUPZ"ˡ#ZPצ not found![ "$0TQS|zxTáe آšآe :Ɓƃ ZÞ"ÍZšHost target file name: 1 1š HERE COMES 1[P TransmittingO^ءצTransfer aborted 5ZP transferred to `1ǰ n v ٲˡצDisk output error N PLEASE SEND Z\Pצ ReceivingǴ퓄= 1Ǵ ˡ" á ǘš퍓b^צHost source file name: Z ZšצLocal target file name: 1 1š]1̂Ƃ1PƂ.TEXTUƂP٥1"ˡ(̂ƂZPƂצ is illegal!\Ƃ "åÍ1šq퓡 צTransfer aborted @̂ƂZPƂצ tr;  MAXSEG = 15; {MAX CODE SEGMENT NUMBER} DIRBLK = 2; {DISK ADDR OF DIRECTORY} EOL = 13; {END-DI.RBLOCKS[1],2048,2); {LOAD DIR} "MONTHS[ 0] := '???'; MONTHS[ 1] := 'Jan'; "MONTHS[ 2] := 'Feb'; MONTHS[ 3] := 'Mar'; "MONTOF-LINE...ASCII CR} TYPE DATEREC = PACKED RECORD 1MONTH: 0..12; {0 IMPLIES DATE NOT MEANINGFUL} 1DAY: 0..31; HS[ 4] := 'Apr'; MONTHS[ 5] := 'May'; "MONTHS[ 6] := 'Jun'; MONTHS[ 7] := 'Jul'; "MONTHS[ 8] := 'Aug'; MONTHS[ 9] := 'Sep'; " {DAY OF MONTH} 1YEAR: 0..100 {100 IS TEMP DISK FILE FLAG} /END {DATEREC} ; VID = STRING[VIDLENG]; MONTHS[10] := 'Oct'; MONTHS[11] := 'Nov'; "MONTHS[12] := 'Dec'; MONTHS[13] := '???';  DIRRANGE = 0..MAXDIR; TID = STRING[TIDLENG]; BLKRANGE = 1..512;  FILEKIND = (UNTYPEDFILE,XDSKFILE,CODEFILE,TEX"MONTHS[14] := '???'; MONTHS[15] := '???';  END {DIRINIT} ;   FUNCTION NOYES:BOOLEAN;  BEGIN "READLN(INSTRING);  IF LETFILE, 1INFOFILE,DATAFILE,GRAFFILE,FOTOFILE); DIRENTRY = RECORD 2DFIRSTBLK: INTEGER; {FIRST PHYSICAL DISK ADDR} 2DLASNGTH(INSTRING)=0 THEN NOYES:=FALSE "ELSE NOYES:=INSTRING[1]='Y';  END;   FUNCTION GETUNIT:BOOLEAN;  BEGIN "GETUNIT:=FALSE%{TERAK CORPORATION believes that the information contained herein is %accurate. In no event will TERAK be liable for any losTBLK: INTEGER; {POINTS AT BLOCK FOLLOWING} 2CASE DFKIND: FILEKIND OF 4UNTYPEDFILE: {ONLY IN DIR[0]...VOLUME INFO} 6(DVID: ses or damages, %whether direct or indirect, resulting from the use of such %information, including, without limitation, losseVID; {NAME OF DISK VOLUME} 8DEOVBLK: INTEGER; {LASTBLK OF VOLUME} 8DNUMFILES: DIRRANGE; {NUM FILES IN DIs arising from %claims of patent, copyright, and trademark infringement. No license %is granted hereby for the use of any pateR} 8DLOADTIME: INTEGER; {TIME OF LAST ACCESS} 8DLASTBOOT: DATEREC); {MOST RECENT DATE SETTING} nt or patent rights of %TERAK. TERAK reserves the right to update the information contained %herein at any time without furthe4XDSKFILE,CODEFILE,TEXTFILE,INFOFILE, 4DATAFILE,GRAFFILE,FOTOFILE: 6(DTID: TID; {TITLE OF FILE} 8DLASTBYTE: 1.r notice. % %The information contained herein is proprietary to TERAK CORPORATION %and must be treated as confidential. It m.512; {NUM BYTES IN LAST BLOCK} 8DACCESS: DATEREC) {LAST MODIFICATION DATE} 0END {DIRENTRY} ; VAR I,UNITNUM,LARGay not be disclosed to %others or used for any purpose except as expressly consented to by %TERAK. 6COPYRIGHT 1980 BY TERAEST,FREEBLKS,USEDAREA,USEDBLKS: INTEGER; &DETAIL,DIROK: BOOLEAN; GS: STRING; INSTRING: STRING[255]; MONTHS: AK CORPORATION ="ALL RIGHTS RESERVED"} {$L-}  PROGRAM DIRECTORY; CONST MAXDIR = 77; {MAX NUMBER OF ENTRIES IN A DIRRAY [0..15] OF STRING[3]; &DI: RECORD CASE BOOLEAN OF ,TRUE: (RECTORY: ARRAY [DIRRANGE] OF DIRENTRY); ,FALSE:(RBLOCKS: ARRARECTORY} VIDLENG = 7; {NUMBER OF CHARS IN A VOLUME ID} TIDLENG = 15; {NUMBER OF CHARS IN TITLE ID} Y[1..4] OF ARRAY[1..512] OF CHAR) *END; LIST: TEXT; &  PROCEDURE DIRINIT;  BEGIN "DIROK:= FALSE; "UNITREAD(UNITNUM,< EBLKS+FREEAREA; &IF DETAIL THEN (BEGIN *WRITE(LIST,'< UNUSED > ', 4FREEAREA:4,' ':11,FIRSTOPEN:6); ory... Directory listing file generator... V01-02'); "IF GETUNIT THEN "BEGIN $WRITE('Full detail? '); DETAIL:=NOYES; $REWR*WRITE(LIST,CHR(EOL)) (END $END;  END {FREECHECK} ;   PROCEDURE LISTDIR;  BEGIN "FREEBLKS := 0; USEDBLKS := 0; "LARGESITE(LIST,'DIR.LST.TEXT'); $DIRINIT; $IF IORESULT <>0 THEN WRITELN('?I/O error?') ELSE LISTDIR; $WRITELN; WRITELN('***** DONE T := 0; DIROK := FALSE; "WITH DI.RECTORY[0] DO "BEGIN $WRITE(LIST,DVID,':'); $IF DLASTBOOT.MONTH > 0 THEN &WRITE(LIST,' ':2*****'); CLOSE(LIST,LOCK); $IF DIROK THEN WRITE('Your listing is in "DIR.LST.TEXT" .'); "END  ELSE WRITELN('?Illegal unit,DLASTBOOT.DAY:2,'-', (MONTHS[DLASTBOOT.MONTH],'-',DLASTBOOT.YEAR:2); $WRITE(LIST,CHR(EOL),CHR(EOL)) "END; "FOR I := 1 TO DI number?');  END.  .RECTORY[0].DNUMFILES DO $WITH DI.RECTORY[I] DO &BEGIN (WRITE('.'); (FREECHECK(DI.RECTORY[I-1].DLASTBLK,DFIRSTBLK); (USEDAR DIRECTOR EA := DLASTBLK-DFIRSTBLK; (USEDBLKS := USEDBLKS+USEDAREA; (IF DACCESS.YEAR IN [1..99] THEN (BEGIN *WRITE(LIST,DTID,' ':TIDLE NG-LENGTH(DTID)+1,USEDAREA:4); *IF DACCESS.MONTH > 0 THEN ,WRITE(LIST,' ':2,DACCESS.DAY:2,'-', 4MONTHS[DACCESS.MONTH],'-',DACCESS.YEAR:2); *IF DETAIL THEN ,BEGIN .IF DACCESS.MONTH = 0 THEN WRITE(LIST,' ':11); .WRITE(LIST,DFIRSTBLK:6,DLASTBYTE:6); .; "WRITE('Generate directory file of what unit? '); READLN(INSTRING); "IF LENGTH(INSTRING)=0 THEN BEGIN GETUNIT:=TRUE; UNITNUMGS := 'ILLEGAL'; .CASE DFKIND OF 0XDSKFILE: GS := 'Bad file'; 0CODEFILE: GS := 'Codefile'; 0TEXTFILE: GS := 'Textfile'; :=4 END "ELSE "BEGIN $IF INSTRING[1]='#' THEN UNITNUM:=ORD(INSTRING[2])-48 $ELSE UNITNUM:=ORD(INSTRING[1])-48; $IF UNITNUM 0INFOFILE: GS := 'Infofile'; 0DATAFILE: GS := 'Datafile'; 0GRAFFILE: GS := 'Graffile'; 0FOTOFILE: GS := 'Fotofile' .END; .IN [0..1] THEN &BEGIN (UNITNUM:=UNITNUM+4; WRITE('Do you mean logical unit ',UNITNUM,' ?'); (GETUNIT:=NOYES; &END $ELSE GETWRITE(LIST,' ':2,GS) ,END; *WRITE(LIST,CHR(EOL)); (END; &END; "DIROK:=TRUE; "FREECHECK(DI.RECTORY[I-1].DLASTBLK,DI.RECTORYUNIT:=UNITNUM IN [4..5]; "END  END;   PROCEDURE FREECHECK(FIRSTOPEN,NEXTUSED: INTEGER); "VAR FREEAREA: INTEGER;  BEGIN "[0].DEOVBLK); "WRITE(LIST,CHR(EOL),DI.RECTORY[0].DNUMFILES,' files, ', 2USEDBLKS,' blocks used, ', 2FREEBLKS,' unused'); "IFFREEAREA := NEXTUSED-FIRSTOPEN; "IF FREEAREA > LARGEST THEN LARGEST := FREEAREA; "IF FREEAREA > 0 THEN $BEGIN FREEBLKS := FRE DETAIL THEN WRITE(LIST,', ',LARGEST,' in largest area'); "WRITE(LIST,CHR(EOL));  END {LISTDIR} ;   BEGIN "WRITELN('Direct= ??????תצ???044á 4Y4צ&Generate diP ks used,  צ unused4צ,  צ in largest area  rectory file of what unit? 44ás4#á 40 40JDo you mean lO^ogical unit  צ ?0tٕšګšLڂDԦ< UNUSED > ӟe  f M آ:آ šS آ  -ԥآ -آ    M ȡM .M 낫٢  ٢ ٢ ٢ šS ٢  -ԥ٢ -٢   ٢ á  ٣  ILLEGALתPw Bad fileP| צCodefilePk TextfileתPZ צInfofilePI DatafileתP8 צGraffileP' FotofileתPpaRC4% ԥ   M M  ԥM  צ files,  צ blocks used,  צ unused4צ,  צ in largest area  ! {TERAK CORPORATION believes that the information contained herein is %accurate. In no event will TERAK be liable for anyVƈƊՀ9Directory... Directory listing file generator... V01-02צ Full detail?  losses or damages, %whether direct or indirect, resulting from the use of such %information, including, without limitation, l ???תצJanFebתצMarAprתצMay Ԧ DIR.LST.TEXT"ˡ!צ ?I/O error?***** DONE *****JunתצJulAugת צSep Octת צNov Decת צ1%Your listing is in "DIR.LST.TEXT" .)צ?Illegal unit number?ƈ3lr:> <-(1,23)O  צ<-(79,0)HOME BACKSPACEצTAB LINEFEED RETURosses arising from %claims of patent, copyright, and trademark infringement. No license %is granted hereby for the use of any patent or patent rights of %TERAK. TERAK reserves the right to update the information contained %herein at any time without fun TEST rther notice. % %The information contained herein is proprietary to TERAK CORPORATION %and must be treated as confidential.  It may not be disclosed to %others or used for any purpose except as expressly consented to by %TERAK. 6COPYRIGHT 1980 BY TERAK CORPORATION ="ALL RIGHTS RESERVED"}  PROGRAM TEST;  VAR I:INTEGER;  PROCEDURE W; VAR I:INTEGER; BEGIN FOR I:=0 TO 5000 DO; END;  PROCEDURE OUT(S:STRING;I:INTEGER);  BEGIN WRITELN; WRITE(S,CHR(I)); W; END;   BEGIN  PAGE(OUTPUT); Ljȡ٪PR, ȡc צ-_______ FOR I:=0 TO 23 DO "BEGIN WRITE(I:5,'_____________________________________________'); $IF I<23 THEN WRITELN ELSE WRITE(CHR(25______________________________________ɡ  צBEEPצ CRS ADR TO...F )); END;  OUT('BEEP',7);  OUT('CRS ADR TO...',0);  WRITE(CHR(30),CHR(70+32),CHR(22+32),'<-(70,22)'); W;  WRITE(CHR(30),CHR(0 צ <-(70,22)  <-(0,0)  צ+32),CHR(0+32),'<-(0,0)'); W;  WRITE(CHR(30),CHR(1+32),CHR(23+32),'<-(1,23)'); W;  WRITE(CHR(30),CHR(79+32),CHR(0+32),'<-(79,0<-(1,23)O  צ<-(79,0)HOME BACKSPACEצTAB LINEFEED RETUR)'); W;  OUT('HOME',25);  OUT('BACKSPACE',8);  OUT('TAB',9);  OUT('LINEFEED',10);  OUT('RETURN',13);  OUT('FORESPACE',28);N  FORESPACEצREVERSE LINEFEEDצ EOL CLEAR EOS CLEAR צ ALL CLEAR  H צ-_______  OUT('REVERSE LINEFEED',31);  OUT('EOL CLEAR',29);  OUT('EOS CLEAR',11);  OUT('ALL CLEAR',12);  END.  ______________________________________ɡ  צBEEPצ CRS ADR TO...F  צ <-(70,22)  <-(0,0)  צ? ses or damages, %whether direct or indirect, resulting from the use of such %information, including, without limitation, losseHR(27),CHR(72)); END;  WRITE('BEEP',CHR(7)); W;  WRITE(' CLICK',CHR(6)); W;  WRITE(' CRS ADR TO...'); W;  WRITE(CHR(s arising from %claims of patent, copyright, and trademark infringement. No license %is granted hereby for the use of any pate27),CHR(70),CHR(22+32),CHR(70+32),'<-(70,22)'); W;  WRITE(CHR(27),CHR(70),CHR(0+32),CHR(0+32),'<-(0,0)'); W; nt or patent rights of %TERAK. TERAK reserves the right to update the information contained %herein at any time without furthe WRITE(CHR(27),CHR(70),CHR(23+32),CHR(1+32),'<-(1,23)'); W;  WRITE(CHR(27),CHR(70),CHR(0+32),CHR(60+32),'<-(60,0)'); W;  WRITr notice. % %The information contained herein is proprietary to TERAK CORPORATION %and must be treated as confidential. It mE(' HOME',CHR(27),CHR(72)); W;  OUT('BACKSPACE',8);  OUT('TAB',9);  OUT('LINEFEED',10);  OUT('RETURN',13);  OUT('REVERSE LIO^ay not be disclosed to %others or used for any purpose except as expressly consented to by %TERAK. 6COPYRIGHT 1980 BY TERAӟK CORPORATION ="ALL RIGHTS RESERVED"}  PROGRAM TEST;  VAR I:INTEGER;  PROCEDURE W; VAR I:INTEGER; BEGIN FOR I:=0 TO 5000 DO; END;  PROCEDURE OUT(S:STRING;I:INTEGER);  BEGIN WRITELN; WRITE(S,CHR(I)); W; END;   PROCEDURE MORE;  BEGIN  WRITELN;  WRITELN('PROTECT ON',CHR(27),CHR(93)); W;  WRITELN('PROTECTED CHARACTERS'); W;  WRITE('PROTECT OFF:',CHR(27),CHR(91)); W;  WRITELN(CHR(27),CHR(70),CHR(52),CHR(32),'PANNING');  FOR I := 1 TO 15 DO WRITE(CHR(4));  FOR I := 1 TO 5 DO WRITELN('PANNING'); W;  WRITELN('STOP PANNING'); W;  WRITE(CHR(27),CHR(72)); W;  FOR I := 1 TO 5 DO WRITE('REVERSE PAN',CHR(13),CHR(11),CHR(11)); W;  WRITE('STOP PANNING'); W;  FOR I := 1 TO 15 DO WRITE(CHR(5));  FOR I := 1 TO 6 DO WRITELN; W;  WRITELN(CHR(27),CHR(87),'EOL CLEAR',CHR(27),CHR(75)); W;  WRITE('EOS CLEAR',CHR(27),CHR(74)); W;  OUT('ALL CLEAR',12);  END;   BEGIN  PAGE(OUTP%{TERAK CORPORATION believes that the information contained herein is %accurate. In no event will TERAK be liable for any losUT);  FOR I:=0 TO 23 DO "BEGIN WRITE(I:5,'_____________________________________________'); $IF I<23 THEN WRITELN ELSE WRITE(C@  TEST F < <-(60,0) HOMEH BACKSPACEצ TAB LINEFEED RETURN REVERSE LINEFEED צ FORESPACECצ CURSOR OFFצ CURSOR ON L~ CRS ADR TO...F F  <-(70,22)RECVBYT CODE  O^Ljȡ٪PR, PROTECT ON]5PROTECTED CHARACTERS PROTECT OFF:[F4 PANNINGȡȡ"PANNING STOP PANEFEED',11);  WRITE('FORESPACE',CHR(27),CHR(67)); W;  WRITELN; OUT('CURSOR OFF',21);  OUT('CURSOR ON',22);  MORE;  END.  NNINGHȡ<צ REVERSE PAN   צ STOP PANNINGȡȡWצ EOL CLEARK EOS CLEARJ ALL CLEAR - ȡm צ-_____________________________________________ɡ HBEEP CLICK CRS ADR TO...F F  <-(70,22)F  צ<-(0,0)F  <-(1,23)A : BOOLEAN; {DONE...true-> character received} 0BUNK: 0 .. 127; 0RDY: BOOLEAN {Data terminal ready (static ready signal) }! {TERAK CORPORATION believes that the information contained herein is %accurate. In no event will TERAK be liable for any  END;   CSDB = PACKED RECORD /RCS: RECVCS; /RDB: CHAR; /JNK: CHAR; /XCS: XMITCS; /XDB: CHAR  END;   QUEUE  losses or damages, %whether direct or indirect, resulting from the use of such %information, including, without limitation, l= PACKED ARRAY [0..QUEUESIZE] OF CHAR; {Ring buffer for receiver}   HANDLER = RECORD -QBASE: INTEGER; {Address of riosses arising from %claims of patent, copyright, and trademark infringement. No license %is granted hereby for the use of any ng buffer} -QHEAD: INTEGER; {Index for insertion} -QTAIL: INTEGER; {Index for extraction} patent or patent rights of %TERAK. TERAK reserves the right to update the information contained %herein at any time without fu-STATUS: RECVCS; {Status of reception} -CODE: ARRAY [0..29] OF INTEGER +END; /  {  ^F  ***************************rther notice. % %The information contained herein is proprietary to TERAK CORPORATION %and must be treated as confidential. *********************************************}  VAR   WRKSTR: STRING[255]; {This allows RECVSTR to return up to 255 cIt may not be disclosed to %others or used for any purpose except as expressly consented to by %TERAK. 6COPYRIGHT 1980 BY hars} WRKCHR: CHAR;   Q: ^QUEUE; {Ring buffer for receiver}  H: ^HANDLER; {Receiver interTERAK CORPORATION ="ALL RIGHTS RESERVED"}  { TERAK 8510 serial interface I/O service routines fD. Kodimer ZSee LOGO for Rerupt service routine, with Q pointers}   SLU: RECORD CASE BOOLEAN OF 1TRUE: (ADR: INTEGER); 1FALSE:(REG: ^CSDB) vision}  PROGRAM SERIALIO;  CONST  "QUEUESIZE = 199; {Receiver ringbuffer size, bytes}  CR = 13; LF = 10;   TYPE  /END;    {  ^F  ************************************************************************}   FUNCTION OCTAL(S:STRING):  RECVCS = PACKED RECORD 0JUNK: 0 .. 63; 0INT: BOOLEAN; {Interrupt enable} 0DUN: BOOLEAN; {DONE...true-> characterINTEGER;  VAR R,I: INTEGER;  BEGIN R:=0; I:=0; "WHILE I b R0 } $CODE[ 4] := OCTAL('177756'); $CODE[ 5] := OCTAL('113710'); { MOVB @#RDB, (R0) } $CODE[ 6] := OCTAL('177522'); $yte was transfered. FALSE -> nothing availble or error}  BEGIN IF H^.STATUS.ERR THEN CODE[ 7] := OCTAL('053767'); { BIS @#RCS, QSTAT } $CODE[ 8] := OCTAL('177520'); $CODE[ 9] := OCTAL('177752'); $CODE[10] ${Error flag was set...Do what you will here...QSTAT contains a strobe of $the receiver status register. Bits are defined in R:= OCTAL('100421'); { BMI 4$ } $CODE[11] := OCTAL('142720'); { BICB #200, (R0)+ } $CODE[12] := OCTAL('000200'); $COECVCS type. $for example, H^.STATUS.OVR, if true, indicates overrun occured} "BEGIN RECVBYT:=FALSE; {Function false...} "H^.QDE[13] := OCTAL('166700'); { SUB QBASE, R0 } $CODE[14] := OCTAL('177732'); $CODE[15] := OCTAL('020027'); { CMP R0, #QHEAD:=H^.QTAIL; {Throw away all data in ring buffer}  END ELSE IF H^.QHEAD = H^.QTAIL THEN {Buffer is empty} RECVBYT:=FALSE EUEUESIZE } $CODE[16] := QUEUESIZE; $CODE[17] := OCTAL('101401'); { BLOS 2$ } $CODE[18] := OCTAL('005000'); { CLR R0LSE $BEGIN C:=Q^[H^.QTAIL]; RECVBYT:=TRUE; &IF H^.QTAIL = QUEUESIZE THEN H^.QTAIL := 0 ELSE H^.QTAIL:=H^.QTAIL+1; END;  END;  } $CODE[19] := OCTAL('020067'); {2$: CMP R0, QTAIL } $CODE[20] := OCTAL('177722');   PROCEDURE RECVSTR(ENDCHR1,ENDCHR2:INTEGER); {Receive string delimited by "character with value of either ENDCHR1 or ENDCHR$CODE[21] := OCTAL('001004'); { BNE 3$ } $CODE[22] := OCTAL('012767'); { MOV #^B1000100000000000, QSTAT } $CODE[23]2 (not included in string, "but returned in WRKCHR), synchronously}   {Note...String is returned in WRKSTR to allow 255 char := OCTAL('104000'); $CODE[24] := OCTAL('177714'); $CODE[25] := OCTAL('000402'); { BR 4$ } $CODE[26] := OCTAL('010067');acters to be returned. ! Else, if string is passed as parameter, overflow occurs at 81 char.}  {Also Note...Could hang h {3$: MOV R0, QHEAD } $CODE[27] := OCTAL('177702'); $CODE[28] := OCTAL('012600'); {4$: MOV (SP)+, R0 } $CODE[29] := OCTALere forever if other machine is asleep. Solution is (the loop counter or real time clock which could be added if req'd.} C =I+1; UNTIL I>999; {Purge} "SLU.REG^.RCS.INT:=FALSE; {Off!} END; "  {Note... if an SLU.RCS interrupt should be requested during the instruction  which turns off the INT bit, the processor will halt due to interrupt bus fault.  In the above, we are assO^uming that the Host machine is thru talking.}   {Note... if program is interrupted due to a ^NULL, the O/S will execute a  R5 VAR DUMSTR:STRING[1];  BEGIN DUMSTR:='*'; WRKSTR:=''; "REPEAT REPEAT UNTIL RECVBYT(WRKCHR); "DUMSTR[1]:=WRKCHR; {Put characESET instruction, which will turn off serial input interrupt enable.}   { The routines availble in this package are... ( (Rter into string variable} "IF (WRKCHR IN [' '..'~']) AND (LENGTH(WRKSTR)<255) THEN .{Accept only printing characters} WRKSTRECVBYT Function...true if character returned (allows async input) (RECVSTR Procedure...collect chars into WRKSTR until either:=CONCAT(WRKSTR,DUMSTR);  UNTIL ORD(WRKCHR) IN [ENDCHR1,ENDCHR2]; END;   FUNCTION XMITBYT(C:CHAR):BOOLEAN; {TRUE -> byte was ENDCHR rec'd (XMITBYT Function...true if character was transmitted  transfered}  BEGIN WITH SLU.REG^ DO BEGIN "{REPEAT UNTIL XCS.RDY; {Wait on ready bit} {<-- Compile iff modem ready valid} "I(XMITSTR Procedure...Send whole string (note...no delimiters added) (XMITCHR Procedure...Synchronous XMITBYT (CLEAR MustF XCS.DUN THEN {Check the done bit} $BEGIN XMITBYT:=TRUE; XDB:=C; END ELSE XMITBYT:=FALSE; END; END;   PROCEDURE XMITSTR(S: be called one time at start of program before I/O (SHUTDOWN Must be called one time at end of program after I/O}  !BEGIN STRING); {Send string synchrounously, no delimiters added}  VAR CURSOR:INTEGER;  BEGIN CURSOR:=1; WHILE CURSOR<=LENGTH(S) DO ! CLEAR; #REPEAT %XMITSTR('Hello? Anybody out there? Can anybody hear me?'); %RECVSTR(CR,LF); {Get line ended by either CR O"BEGIN REPEAT UNTIL XMITBYT(S[CURSOR]); CURSOR:=CURSOR+1; END; END;   PROCEDURE XMITCHR(C:CHAR); {Useful to send characters R LF } #UNTIL POS('Yes, but would you please talk a little louder?',WRKSTR) > 0; ({Using POS function is slightly forgiving ofsynchronously}  BEGIN REPEAT UNTIL XMITBYT(C); END;   superfluous characters} #SHUTDOWN; !END.   PROCEDURE XMITCCH(I:INTEGER); {Useful to send control characters synchronously}  BEGIN REPEAT UNTIL XMITBYT(CHR(I)); END;   PROCEDURE SHUTDOWN; {Must call before leaving program}  VAR I: INTEGER;  BEGIN I:=0; REPEAT IF RECVBYT(WRKCHR) THEN I:=0; I:D ses or damages, %whether direct or indirect, resulting from the use of such %information, including, without limitation, losseBSEQUENT FILES AND WRITE THEM } "OBLK := RBLK; "LNGTH := TRUE; "WHILE LNGTH DO $BEGIN $WRITE ('Input TEXT file? '); $READLs arising from %claims of patent, copyright, and trademark infringement. No license %is granted hereby for the use of any pateN (FNAME); $IF LENGTH (FNAME) > 0 THEN &BEGIN &RESET (INP, CONCAT (FNAME, '.TEXT')); &RBLK := 2; nt or patent rights of %TERAK. TERAK reserves the right to update the information contained %herein at any time without furthe&WHILE (NOT EOF (INP)) AND (NUMT=1) DO (BEGIN (NUMT := BLOCKREAD (INP, BLOCK, 1, RBLK); (NUMT := BLOCKWRITE (OUTP, BLOCK, 1,r notice. % %The information contained herein is proprietary to TERAK CORPORATION %and must be treated as confidential. It m OBLK); (RBLK := RBLK + 1; OBLK := OBLK + 1; (END; &CLOSE (INP); &END $ELSE LNGTH := FALSE; $END; "CLOSE (OUTP, LOCK); "ay not be disclosed to %others or used for any purpose except as expressly consented to by %TERAK. 6COPYRIGHT 1980 BY TERAWRITE ('More? '); "READLN (MORE); "IF (MORE <> 'Y') THEN GO := FALSE;  UNTIL NOT GO  END.  K CORPORATION ="ALL RIGHTS RESERVED"}  PROGRAM CONCATXT;  TYPE A = ARRAY [0..511] OF INTEGER;  VAR INP, OUTP :FILE; $GO, LNGTH :BOOLEAN; $FNAME :STRING; $MORE :CHAR; $NUMT, $RBLK,OBLK :INTEGER; $BLOCK :A;  BEGIN  GO := TRUE;  { PRINT MESSAGE }  WRITELN ('This program will concatenate any number of TEXT files');  WRITELN ('and output them to a specified TEXT file. The .TEXT');  WRITELN ('extension is assumed on filenames. When all input files');  WRITELN ('have been specified, type .'); "REPEAT "{ GET OUTPUT FILENAME } "WRITE ('Output to what TEXT file? '); "READLN (FNAME); "REWRITE (OUTP, CONCAT (FNAME, '.TEXT')); "{ GET FIRST FILE AND WRITE IT } "WRITE ('Input TEXT file? '); "READLN (FNAME); "RESET (INP, CONCAT (FNAME, '.TEXT')); "NUMT := 1; "RBLK := 0; "WHILE (NOT EOF (INP)) AND (NUMT=1) DO $BEGIN $NUMT := BL%{TERAK CORPORATION believes that the information contained herein is %accurate. In no event will TERAK be liable for any losOCKREAD (INP, BLOCK, 1, RBLK); $NUMT := BLOCKWRITE (OUTP, BLOCK, 1, RBLK); $RBLK := RBLK + 1; $END; "CLOSE (INP); "{ GET SUE h CONCATXT  Ɓ/+ƁWTצ6This program will concatenate any number of TEXT filesצ4and output them to a specified TEXT file. The .TEXTצ8extension is assumed on filenames. When all input filesצ#have been specified, type .Output to what TEXT file? UP̂ƂUPƂ.TEXTUƂצInput TEXT file? UP+̂ƂUPƂ.TEXTUƂ+ 4++SSצInput TEXT file? UPUš+̂ƂUPƂ.TEXTUƂ+ Ä9++SצMore? ~~YˡTT+TK eT`̂ƂUPƂ.TEXTUƂצInput TEXT file? UP+̂ƂUPƂ.TEXTUƂ+ F ! @$ <GH, x@H @Hx @0@` D@@d* < "*0b B"*"2!x A"K$&b@ A I$D``0?(bL?@!"ID@! ED@x! @@ ` 8"@`H$ @DHH0H@BBD  0@ D$! BBDD@HB !AB" BB#<a"2ˆ! @ p@ | B! 0$B!@ 80@$B"A!@  `H4q"0DD1808`$"#! @   s"2#CIe$B88 I2$ (   AH ( `ȈH2 H` DHL$" Id@`FHd |  @@8@8@0@$"@  @B,"$"HC  !*$"H"B  )F"$J$D @ 9 a@A 9B$ED@Ay0DBdM @ADBD  "@"$  "$`G A "D`!K><! DAB[0ٞ  D ABЀذن@D @@O `a0D CЀرن` IЀسن`H!BЇزنg&$@?@@0|@B@CB@@ `BBD"BH 2~!"D#"3!Fضَ'$"DЀضټ#A$$Ѐضٸ`#@2 D ?D?"D"D@"HBD ~| #IMBHAشٰ`# DB !Ę`ؼٰ`#! DB A@ظٰ`&  "B AAHH8H1 `ذٰ`&  "A$ A `gذϾo& "A& B /L0Ϝo&@D"A"9BAH A @H  B DD  "DDD"" D"a""BB 0BD"1""B AB#"$!@#$BD!D@$B" `$B  AB!A$!   "Ad A"ADb  H"? H B"?3 `OD$ 30 C@d !PAB  0HPA8@ DHA @  $(A` @30@p@@ "@30C@ @! @30?H @B!@@30? $ $A@ @ $A!@ $"H0@! A@( !C@& B @3 !@Q"8"@I" "@bI" B !! 3 ( 2"! 3  B( "A 3@DDB(D@"E" F@DB" D@$B! D 3CDB(BD 3" DD"HB"( 3~! FB"HB"(@$B!!@D`"BA @b AA @"A "B"HB$p"#"DD@P"!"DDD1A@AA@@@HH  ! @H$! $P AH(rUDVBTT???I @ p@| B! 0$B!@  80@$B"A!@  `H4q"0DD1808`$"#! @   "2#CIe$B88 I2$ (   AH ( `ȈH2 H` DHL$" Id@`FHd |  @@8@8 @0@$"@  @B,"$"HC  !*$"H"B  )F"$J$D @ 9 a @A 9B$ED@Ay0DBdM @ADBD "@"$  "$`@ `BBD"BH 2~!"D#"3@$ <GH, x@H @H?D?"D"D@ "HBD ~| #IMBHApx @0@` D@@d* < "*0b B"*"2!x A"K$&b@ A I$D``0?(bL?@!"ID@! ED@x! @@ ` 8"@`H$ @DHH0H@BBD  0@ D$! BBDD@HB AB" BB <a"2ˆ! J @#$BD!D@$B" `$B  AB!A$!   "Ad A"ADb  H"? H B"?3 `OD$ 30 C@d !PAB  0HPA8@ DHA @  $(A` @30@p@@ "@30C@ @! @30?H @B!@@30? $ $A@ @ $A!@ $"H0@! A@( !C@& B @3 !@Q"8"@I" "@bI" B !! 3 ( 2"! 3  B( "A 3@DDB(D@"E" F@DB" D@$B! D 3CDB(BD 3" DD"HB"( 3~! FB"HB"(@$B!!@D`"BA @b AA @"A "B"HB$p"#"DD@P"!"DDD1A@AA@@@HA "D`!K><! DAB[0ٞ  D ABЀذن@D @@O `a0D CЀرن` IЀسن`H!BЇزنg&$@?@@0|@B@CB@!Fضَ'$"DЀضټ#A$$Ѐضٸ`#@2 D @H$! $P شٰ`# DB !Ę`ؼٰ`#! DB A@ظٰ`&  "B AAH(rUDVBTTH`H8H1 `ذٰ`&  "A$ A `gذϾo& "A& B /L0Ϝo&@D"A"9BAH A @H  B DD  "DDD"" D"a""BB 0BD"1""B AB#"$!K b??? ! `x @0L  "@"$  "$`@ `BBD"BH 2~!"D#"3@$ <GH, x@H @H?D?"D"D@ "HBD ~| #IMBHAp@` D@@d* < "*0H`H8H1  B"*"2!x A"K$&b@ A I$DH A @H  B DD  "DDD""``0?(bL?@!"ID@! ED@x! @@ ` 8"@`H$ @DHH0H@BBD  0@ D$! BBDD@HB AB" BB <a"2ˆ! @ p@| B! 0$B!@  80@$B"A!@  `H4q"0DD1808`$"#! @   "2#CIe$B88 I2$ (   AH ( `ȈH2 H` DHL$" Id@`FHd |  @@8@8 @0@$"@  @B,"$"HC  !*$"H"B  )F"$J$D @ 9 a @A 9B$ED@Ay0DBdM @ADBD