`L i=L\Ʃx ? N'i  ͭЅ?0ȱ Ѕ?iȱi lԠԠ͠ԠϠŠͮŠ SYSTEM.APPLE   L$JLјJ 8彐.mĿ"Š>?( X֮ˍL հ˩($8` Ґh Hǹxhx N`8Ύ߽0|ϩHhHh ӈ ө ө ӘVYԦΝYԮߝꪽԦ ө  Ͱ()I يJJJ(jǩF؅G(  7ֈ k( F G  Xj0 Ю $Ӱ8 xH ߩ`Ǚx kh kL~ѩ@(LYLWҭH͍h (ͥpi)ͥˤ˹HH(x rh(`~Ȍ``hhh )hJ¥jJJhhihhhJi֍hhha [U8ſƅh)x h H('eƍ8ƅи ĘHH`ߠ ߮ Q AUGEMENU.TEXTvgQ AUGEINIT.TEXTvgQ AUGEENT.TEXTvgQ AUGEPRNT.TEXTvgå AUGELIST.TEXTvgåAUGELIST2.TEXTgå (C)-1982.AUGEgåIACDOC& SYSTEM.APPLEvg&O SYSTEM.PASCALvgiOPSYSTEM.MISCINFOEPcSYSTEM.LIBRARYc SYSTEM.FILERvg)SYSTEM.STARTUPgLOGO.PICr=vgAUGE.PICr=vgAUGESTART.TEXTg&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`+*xH&x'8*7Ixix&&  ') + &п x) ++`FG8`0($ p,&") (jJJ>L+ "?I>  N `  ` x V Nx .x- z `V0^*^*>` aI꽌ɪVɭ&Y&&Y& 꽌ɪ\8`& ө ө ө ӽ`Hh`Q꽌ɪɖν*Ͻ%ϙEΈ 꽌ɪ`8` Hh݌`  $(,048<@DHLPTX\`dhlptx|Հ؈䤨谴T}iU･~R콥S~8vw\vȥ]vv\w]V𽥃WlXx |ƄRSL{ȱȱńRRLSҠXx ~~~~LSҠXx P~Qȑ~LSҠXxX XY |0 L\Xx t|ut}|=0 8|8|}8||ȥ}|MHLHlLSH|8|}8z|~{|@|:~8|~(~8 ~8~Z[ 8~Z[LѠP~ ~i jik|Lhj ~|it}iu8ttXutY|i h0 L LllL=LC/ L ߰8L ߦt~ hI=+ L ߤt~I= ~ LȄHHL;hh tuLhhVtWu\z]{XiXYt8xtut8xtu8tTERFAC3LABEL MOD 'NOT &OF OR (PROCEDURPROGRAM !PACKED +REPEAT RECORD -SET *SEGMENT !SEPARATE6THEN TO TYPE UNIT 2UNTIL USES 1VAR WHILE WITH ))))?)`vߗ߸)))@#AND 'ARRAY ,BEGIN CASE CONST DIV 'DO DOWNTO END ELSE EXTERNAL5FOR FILE .FORWARD "FUNCTION GOTO IF IMPLEMEN4IN )INe ~a{8 ~ȱa {8 LT0:A[_ ҕ~L+݈qȱi~8A ݅ȹ݅ȱ~Ɔ4i Lȱ|ȱ}|ȩȥ}ȩLݠȑȑ~uHtH`,BMcބޥHH8(iPH ۠'(hH'O'OhhmhLۭJL80%`M8$LLLhhhhhhhhץHH` ܩȑآL ܥ8ؘ ܩ؈ȩؠ#hthuhhhheȱÈ jh`@ fנ f׭0`L` CLL۠LۥHH j ڥhhLۦ vې` ۤOȄ`H$)A[hIH80(hI`i(L8(hI`LۥJ) )i i`¥ĥ`` - 9HL r 9 MȽ`H 9٠L rH $h`   -y6=CLjO808 0PLڥ8 0 ۥ``) ` )? Lvۢ 8` GڅFڅl```LۥH ۠' `H 9٠ hlQ`) թ` 9 Ȣ`JJJJ ϱ` r,p 0*P$ ۤ b ۢ`H - 9٠L r׊H 9h ɢ`) 2 r׭0` r׹)` ( `) ' r׹J)?L I@L3؊  L3؎,QLxת,c*A[ Lע0H)@hILө Ъhhh(`N`hhhhhhHH)> ` Yܠ0* )` r׮ ؎`(54#ƊgƈЪ 6`י ֙QRTW = Э*0 LqŐ`8Hh`HHH*@^]U)j7 [ )L3~ lJf)jjAUIL3ة0 $ڐ> L׈ ϐ8 (ֹH 7֥ +ֹP 7 7)*Ȫ`FG8`0($ p,&"VU>)Q>jj``P@J I*I `\xDŽ XׅІ X?;78H<8H  8`Ί aՍxՍՍՍե>?Ռ8T8ՌWuՌvՠ ýI꽌ɪ꽌ɭ蠪ϮәVE]ӾV]H)]ӾV]ԙ)]ӾT]ԙ)]ӦΨ 8$hU>`ȅSϭ߅83IߐiżQHPH ~P~ȱP~~P꽥QLSҠ RhPhQLE RR8tSut\ȱt]X i RHLfRtȱRuVt tVuWRTȱRU｠RXȱRYRRR콆SLSҠ8|}`|ȱ|L8||tȥ}|utetȱtet|8|}Ƅ`t et HHH> o>HBtCu\8t\]u]\Z][ 8\Z][Lѥ]H\HuHtHAH@H > ޽Р SYSTEM.PASCAL Insert boot disk with SYSTEM.PASCAL on it, then press RESET#usthL'hح/0 !"opqr)VV#$6| 4 v$PASCALSYUSERPROGDEBUGGERPRINTERRINITIALIGETCMD FILEPROC 0LސLh)thh)htLީ lhvhwhthuEw0uwtv/1'u0+!hthuhthuHHLMhHHLMҩ%lHHLMhhh |~hve| z~~8|eztl8冨Lߤ 0 8`hh ߦt~LL'   UF_f^L#ޠ UhvhwhthuXY^LOޱtvtuvw_LްLL~hvhwv~`ޅvaޅwhthutbޅtcޅutvv ȱtvtv %l HHL;ҩHHL;ҢhtExx0tEtttx u|f}jtz) wzf{jv8vtw݅x݅yyHxHxyyHxHxu9݅xy9݅yyHxHxyt yHxHHviHLMҩHHLMҩHHL?? lXLLdeeƄL;ҥ8傅ń 8冪8冪ƂL;hh&eȹ|ȹ}f)1|)uf}|jjj)?tłetu9 fHHLMҦfHHLM @hhHHHHhzh{h|h}}Lݥ{)L8z|~{}Lݥ|)h |he|Ȅ~ Ȅtl ڦ|8|e| h9 0 ~ʚLM ڦ|| hI9~ʚLM |0| h~ʚLM҅ztzx{yxtezʥ|x}y~xF|}H|HLMҠX hh&ńL;0HxH{HzHezHHL.h|h}hzh{hxhyx~ȱx|80~~ iff~z ~=݅~=H~HLMhthuh|h}hzh{z ݅v%tt݅w%uu|80tuutvwwvi t&uv&whxhyx~ȱxvI%~t~wI%u~xȥxLMhhYLShhhihjhkXi&jhȑjL;ҠhhjL@ٱhjL;LѺtutLLMҠ Uhe^xhe_yxHxHL;Ҡ Uhe^he_HHL;hh Uѥ_ ^&L٥^_ ץhexheHxHL;ҠXXz{hh &hexhef"f fefd8de8&&`ffefd&&`hhhh ץIiIiHHLMhhhh ץHHLMhthuhvhwxyEw0wy)xv!y0uEy0yutxyLMLXYXXYYHXHLXYYHXHXXYeXXLMhthuhh8tuHHLMҩedff dedeeefefdff`hh0 hhL}hh"IiIiIiIi ץHHLMҺHHLBנdeLѥIiIi报IiIiƊ8冥凰 ` ei捠8XYLSҥXiXYLS hthuhvhwt&uZvȥ[vZetZ[eu[8\Z][LL; hthuZtȥ[tL;hthutZȱt[潩L;ҩlLhh0HHLMҨIiIiHHLMhthuhheteuHHLMhIihIiHHetjktLhjhjhhL;hthuhettheuuHtHLMhhhthuhettheuutLMhhhihjhk ULhthuhh%uH%tHLMhthuhhuHtHLMhhIHIHLMҩXXhhQX0XōiX`0\XE0XLXŌC?8XX&XeYe  Íáɡ 럚肚X  šš  ġš  šš!ꂚꂫꕫëS  ! "ˡ! "ˡ ë  qT8T "ˡUĄ쓡"á  :"ë á 쓡ת$ (   d˯7 H Pצצ22ȡ523 ,ȫ$* "ë넡, ~ *Í2~ š˄ `1 b~ éÍ~  , %ɡšɡš  PꟚšw#ńE z 0 ń Ȅ! ~Í`~W ˡ! !~q|3?Bp  v\EL "$&(*,.02468:<>@BDFHJLNPRBx-~}cy*צ LEXTOKEN IS: 02"KKKK@LLNOOTQ<< xH$V ,  9   &*$á09ō>##$ á> á>>á>낫š ꓡ5š땫Ě@6"á1ꓡ삫Ú š K6"á61 ɚ V @VBBChCfDEE>FFFhGGXHHH"JbJJתPńȄ ,ń.áš蕿@šQȡ2 š:X f Ą ɡ 쾿  .Tá " * ȡ*ńȄ4šáR há1á4   Q lMȡš ȡ뾿  + d>š oɡa   áá0Oš *š  4TzY 000á'4á 0z00 rT\  ɡ'áצ-32768 ^ 逫-ġ>o00ń0ˡ +á! "ˡ  +Uz    00áQP 0á0 é000+-Í-ë0 á1 š5    šš$ !邚邫镫ë퓡h  ! "ˡ ɡ!  ! "ˡf á3 á,  )á á ávˡ á cń# Ȅ ꚹ6áÄ7  .*3 ȡ 23aĩ3zȄ 23aA22š*á ?צ:22ȡá;2á!2ȡ5252š[ץ22š2222ȡ2š5252á4w4]ץ11á4\1šV42233z 3042221é42é1Ä2*á444ń55P.TEXTׯ]צ.CODEJ.BACKׯ7צ.INFO$.GRAFׯצ.FOTO8FNo user programתP8F0:::::&:(xáצAssembleצCompile what text? ( ׯ,á(+(צ.TEXT888Ä8E$ á"ˡ"& E ##&EáN R3b9Q[Ä-D8铡6!~? *~?=FצPut in :P?FP'Ǡȡ*EEתE&VX X9   /13579;=?E&* 5?š?ˡ?ء "ˡ6ߕނ߂ɡ F b6ب"́$ʁ$ ʁ$ ʁ$ ʁ$ʁ$!"ʁ$ʁ$ʁ$ʁ$FZ7OQ QQQRš.[öO3fj <4  šˡ 퓄 Ä퓡w š   ɍL  "ˡ.ˡ   d쓡 צ to continue) <! ȡ   צ0H" ġ  *@#3$$&ˡ 3 36% "ˡ$צ Can't find ::9 ƀצ:9 ƀ:SYSTEM.SWAPDISK&:(7,*SYSTEM.WRK.CODE[*]ת{צTo what codefile? ( צE,á2צ$̶8FNo debugger in systemתP8F6:::&:(xáצAssembleצCompile what text? ( ׯ,á(+(צ.TEXT888Ä8???תY6!  ת&צP%[VTUWX%Y7888% š tWelcome ?, to Apple II Pascal 1.1Based on UCSD Pascal II.18 6øYצ???JanתצFebMarתצAprMayתצJunJulתצAug Sepת צOct Novת צDec ???תצ?????? *SYSTEM.WRK.TEXTײ& צ*SYSTEM.WRK.CODE ,  7 :9CONSOLE:ת(:9YצSYSTERM:(8:99988:9  6 ۪1٦׷)צ: ܢܢH d    Y0&תת.ת Ɓf(ߡʁ% ʁbʁ%́bʁ%́%Y;??ٟá'C צCONSOLESYSTERMצGRAPHICPRINTERצREMINREMOUTz>77:: צ:SYSTEM.LINKERƁ&̨<́b ́cʁcȡ~ؤ́dʁdתʁd0ʁdʁd؞&"á*ʁd ضá0?ʁdצ*SYSTEM.STARTUP(߫7́%́eʁ%ʁeȡlضʁ%ʁbQ́fƁfʁdƁfƁ&ʁ%ʁݢʁݢʁʁݢʁݢʁݢʁݢ  ʁ تٞ&"á ~٤  :SYSTEM.ASSMBLERת :SYSTEM.COMPILERת :SYSTEM.EDITORת :SYSTEM.FILERתʀ=ʀ* ʀ́ʁܢGʁܢHʁܢIʁܢ%O tƀ&́ʁܢʁʁܢʁܢ%́ݲ ʁݢʁݢʁݢʁݢʁݢ ʁݢʁݢ ʁݢ ʁݢ ʁݣ  ʁݢʁܢ́ʁݢ٢ š٢ ٢٢ 4$  ؗ(/  ؗ(tDoo odoo'z*SYSTEM.MISCINFOתPƀƀerror: (צUnimplemented instruction(צFloating point error(uString overflowת(]Programmed HALTת(EProgrammed break-pointת(&nS5  oYC: *( vol not foundת(file not foundת(צ dup dir entry(צfile already open(צ file not open(צbad input format(disk write protectedת(bצillegal block #(Jצillegal buffer address(+$fO7  y^Hצ IO צSystem IO error(צ unknown cause( parity (CRC)ת(צillegal unit #(illegal IO requestת(צdata-com timeout(vol went off-lineת(file lost in dirת(צ bad file name(צno room on vol( vol not foundצUnknown run-time error(צValue range error(צNo proc in seg-table(Exit from uncalled procת(Stack overflowת(צInteger overflow(Divide by zeroת(צNIL pointer reference(צProgram interrupted by user( "ˡ$צ Can't find ::9 ƀצ:9 ƀ:SYSTEM.SWAPDISK&:(7,*SYSTEM.WRK.CODE[*]ת{צTo what codefile? ( צE,á2צ$צCurrent date is C -C-C 99ȡצ"(C) Apple Computer Inc. 1979, 1980צ(C) U.C. Regents 1979%System re-initialized 6:rNP  צP%[VTUWX%Y7888% š tWelcome ?, to Apple II Pascal 1.1Based on UCSD Pascal II.1:(šR.%+(]ˡ([8]+(\"á%[צ Terminator=[צ , change it?)צNew terminator:[UO צ: ) Running...ء ء   Swapping is VonoffצToggle swapping? VVzNew exec name+00.0.0ȡ#+.//a/zȄ +./ ..+EXEC/ׯjUTVP+\"á(TS.OQ[QQP+  Hm% á.צNested exec commands illegal"צError opening execd Z6PO6 "ء PKצExecuteצ what fileצ? Pš7`  7 š+ š%SYSTEM.WRK.CODE׷sצSYSTEM.WRK.CODEFš5.CODEׯ.:(7,*SYSTEM.WRK.CODE[*]תצTo what codefile? ( צO,á<צ$88š8(8X+,,"ˡ  Can't open ,   áث what text? ( ׯ&,á (+(צ.TEXT888Ä8 "ˡ$צ Can't find ::9 ƀצ:9 ƀ:SYSTEM.SWAPDISK&Ʋڤ  R   88( áצ Assemblingצ Compiling...á999':::::&:(áצAssembleצCompilec(s) not available 1 \ @ ڤ  áڤ !~ e ת*U  !! !:!!ڤ  ڤ  áܡ #צMust L(ink firstƁ1ƀ:צ.Conflict between intrinsic and user segment(s)ƀצ*SYSTEM.LIBRARY ,צ Can't load required intrinsic(s)Nƀ/צ#Required intrinsi"ˡCۡ>"áIllegal file nameצNo file ́3́4ʁ4́5ʁ5ˡ  not codeʁ41ʁ5"ˡ Bad block #01Ɓ1aݡ9צ Linking...ݢ`ڤá Zxȡ2ݤˡ"ޢ`ݤۼ: TڪƁ Ɓ "á9̂.ʁ ʁ"ˡ  Ɓ Ɓ Vj ުPڶڳ@@YyÍ, 4ۢڤ ɡ$ڪP-19:!1ׯ)Illegal filenamenTޢ ȡSڤ ˡ@۳-ܢ0ۤ צCurrent date is C -C-C 99ȡצ"(C) Apple Computer Inc. 1979, 1980צ(C) U.C. Regents 1979%System re-initializedSȡU/U[,-Z N:98:9á.Y(Y*SYSTEM.ATTACH   áá'*SYSTEM.STARTUP % áá  6   ˡFצJCommand: E(dit, R(un, F(ile, C(omp, L(ink, X(ecute, A(ssem, D(ebug,? [1.1]P')%?áSF=Command: U(ser restart, I(nitialize, H(alt, S(wap, M(ake execתP')%W 6!W,z3 (not saved) No workfileS%  O ?(&Ɓ.񄓡9&צThrow away current workfile ?  ءצ*SYš š۾.ˡצ([šܕ!!(š۾:ˡ١.TEXTת .CODEת!!ȡ(ܾܾ š!!Ȅ!!P!x!P %',@@JBGD> Z`<@X áޢá ~תޢޢޢ024<& צ š š۾.ˡצ([šܕ!!(š۾:ˡ١.TEXTת .CODEת!!ȡ(ܾܾ š!!Ȅۤ  dÄÍ"ߢ ˄"ɡۤ  dáߢ  dá ߢ C#ޣC˄ ߢ C ߢ ۤ ߢޣ ޣߢ ޣޢ ޢۤ ޢ áޢá ~תޢޢޢ024<& צ ) ! 767䚹 :V@28˄ޢߢšáޢ ޣ ߢ  dޣޢޣޣߢ  dÍÍޢˡ ݓۤ ۤ Äݓۢת   ١  n ١ á9 ٓ/! !!١ˡá ~ݤݚ ˄ܟń ١á  ޤ wš  iá Ä,ޤ  ɡ"áޤ PġMáš7 ܂ۻݪ d #(   !š Í 7ÄU ǐɄ:6ń~66! šá٢.ٕ۶š ڸ۸۶ š۸ ڸ:   ȡQ  ȡ   ȡ? ȡ  ġ  á ڢڢڢڣ ڣ ١ڢ ڣ ڣ١ ڢڣڣ ڣ áڣڣš ڢڣڣ hڢ ڢ١ڢ!ڣڣ ڢ!ڣڣ ڢÄڣ &ڢ ڣ ڢ! ڢ!ڣڣ ڢڢ ڣڢÄڢ  쓡 Xצ Linking...  ˡ&צ Restarting...צ U not allowedxRpUT-Há6OKTU7AX0NNP3 "jC(,. C fpP @$ j4 6L $.1]P')%?áSF=Command: U(ser restart, I(nitialize, H(alt, S(wap, M(ake execתP')%W 6!W,z3쓡 Xצ Linking...  ˡ&צ Restarting...צ U not allowedxRpUT-Há6OKTUR PASCALIO TURTLEGRTURTLEGR URTLEY: INTEGER; $FUNCTION TURTLEANG: INTEGER; $FUNCTION SCREENBIT(X,Y: INTEGER): BOOLEAN; $PROCEDURE DRAWBLOCK(VAR SOURCE; ROWSIZE,XSKIP,YSKIP,WIDTH,HEIGHT, 8XSCREEN,YSCREEN,MODE: INTEGER); $PROCEDURE WCHAR(CH: CHAR); $PROCEDURE WSTRING(S: STRING) MOVETO(X,Y: INTEGER); $PROCEDURE PENCOLOR(PENMODE: SCREENCOLOR); $PROCEDURE TEXTMODE; $PROCEDURE GRAFMODE; $PROCEDURE FILLSCREEN(FILLCOLOR: SCREENCOLOR); $PROCEDURE VIEWPORT(LEFT,RIGHT,BOTTOM,TOP: INTEGER); $FUNCTION TURTLEX: INTEGER; $FUNCTION T $TYPE $ SCREENCOLOR=(none,white,black,reverse,radar, 3black1,green,violet,white1,black2,orange,blue,white2); $ $PROCEDURE INITTURTLE; $PROCEDURE TURN(ANGLE: INTEGER); $PROCEDURE TURNTO(ANGLE: INTEGER); $PROCEDURE MOVE(DIST: INTEGER); $PROCEDURE$ $ ݞ$' ݑ$ $݂ō $݂ġ ݂$ $ $ȡ%  0 ފ$čV   .ˡ:  Eɡ  -ݑ š 0 0 ߿`ġ(   ݂. ݕ ؂݂3  ݕ 0 . ݑ0 ݕ݂ ؂ ɡ  |, R -   $ $ ݞ$' ݑ$ $݂ō $݂ġ ݂$ $ $ȡ%  0 ފ$čV   .ˡ:  E.áBڲzؼ0ݞ$ڲzjeEÍɍEáޢ >ۓɡ ؼ݀$ ؼݞ$ۡܡ ؼ$ Dɍ -   "ˡ\ݣ ݣ šݢ ݣ ݢݣݣ ݣ ݣݣńݢݣݢݢݢˡݢݢ ۚݢܚ  / |á +-Í-ڲzؼ 0ݢݣޢÄɡ3ڕġ$ڕšš"šޣ Ąޣ ݣ ˡRݣ &ݢ ݢݢ!ݣ "ˡݣ ˄ݢ!ۂBEGIN RECNUM := RECNUM-1; .BYTE := BYTE+FRECSIZE; .WHILE BYTE > FBLKSIZE DO ' "PROCEDURE FSEEK(VAR F: FIB; RECNUM: INTEGER); PROCEDURE FREADREAL(VAR F: FIB; VAR X: REAL); "PROCEDURE FWRITEREAL(VAR F: FIB; X: REAL; W, D: INTEGER); IZE < FBLKSIZE THEN ,BEGIN N := FBLKSIZE DIV FRECSIZE; .WHILE RECNUM-N >= 0 DO 0BEGIN RECNUM := RECNUM-N; 2BYTE := BYTE+N*FRECSIZE; 2WHILE BYTE > FBLKSIZE DO 4BEGIN BLOCK := BLOCK+1; 6BYTE := BYTE-FBLKSIZE 4END 0END ,END; *WHILE RECNUM > 0 DO ,LOCK,N: INTEGER; "BEGIN SYSCOM^.IORSLT := INOERROR; $IF F.FISOPEN THEN &WITH F,FHEADER DO (BEGIN BLOCK := 0; BYTE := FBLKSIZE; *IF (RECNUM < 0) OR NOT FSOFTBUF OR 2((DFKIND = TEXTFILE) AND (FRECSIZE = 1)) THEN ,GOTO 1; (*NO SEEK ALLOWED*) *IF FRECS ' "PROCEDURE FSEEK(VAR F: FIB; RECNUM: INTEGER); PROCEDURE FREADREAL(VAR F: FIB; VAR X: REAL); "PROCEDURE FWRITEREAL(VAR F: FIB; X: REAL; W, D: INTEGER);   IMPLEMENTATION $ "PROCEDURE FSEEK(*VAR F: FIB; RECNUM: INTEGER*); $LABEL 1; $VAR BYTE,B '",IACBASE:-SYSTEM (C)-1982 BY FRANK POHLEMANN; $PROCEDURE CHARTYPE(MODE: INTEGER); $ "IMPLEMENTATION E $PROCEDURE TEXTMODE; $PROCEDURE GRAFMODE; $PROCEDURE FILLSCREEN(FILLCOLOR: SCREENCOLOR); $PROCEDURE VIEWPORT(LEFT,RIGHT,BOTTOM,TOP: INTEGER); $FUNCTION TURTLEX: INTEGER; $FUNCTION TSǯ?Ǭ?ǰ?Ǯ?ǩ?áǫ?Ǭ?r2 ٢ؚڢؚڢٚ ۚܢښܢٚܢؚɡšܢɡܢǿšܢǿɡܢɡܢcY}zeNEDh0h1hhhhh.h/h,h-h*h+h(h)(ȱ(*ȱ*,ȱ,.ȱ. HH1H0H(ȹ(*ȹ*,ȹ,.ȹ.`   ""##  Iif E J j 8  e e  `(J 8 e  ` Z Z< $ %$PQ $  ߩ $ Li`t^ JL` T$Q%P)Q I L`#JI`'  I` I0ݩ(0/,",i8i#Hiihifi`i,i,3iPII4ifH8H hIiH h hL8SETáSYSTEM.CHARSET  @! @4` - G`` 8`*UH)JJh & & f)4#ihh h2ɡhh h.آآآǿآآǿآآD ٚ SYSTEM.CHARؑؑ!ٹا ZZا Zا Zا ZZfا ZZا Z:ا Zا ZZb8 ؂ɡLjB|?a QZR|?ٽ RZP}?4 SZX~? TZD~? UZO? VZC?[` WZ ?& XZ)?ؽ YZR?  ZZR?2 ZZá.ٹ# BZOi?޽ CZ(k?7 DZCm?[ EZEn? FZGp? GZTr?  HZ s?yx IZ;t?hн JZLv?D KZNw?F LZ x?Re MZOy?Pp NZ z?g OZ;{?K PZ 4ZI? 5ZTL?Xs 6ZUO? 7Z)Q? 8ZNT?; 9Z)V?% :ZEY? ;Z[?Lo <Z(]?г =ZP_? >Z(b? ?ZLd?  @ZTf?] AZUh?D? 'ZO!? (ZC$? )Z '?| *Z)+?+L +ZR.?l ,ZR1?ս -ZA5?D .Z8?& /Z;?: 0Z>?> 1ZA?4 2Z.D?v 3Z.F? ZG>? ZT>ca Z >*r Z;>aq ZL>^ ZN>9 Z ? ZO?ٽ Z ?ƨ !Z; ?vm "ZB?F' #ZR?ս $ZP?y %ZX? &Z ZN1>н Z)C>oc ZET> Zf>Y Z(w>g ZP>탽 Z(>K  ZL>ȱ ZT>z7 ZU>ٰ ZO>? Z(>| ZC>}̽ ZE> 6تP+,+,ȡ+++V 0 Z Zʎ^ Z) ><0l   ڪP."ˡ[̄$ʄ$N.ʄ$M ń.ʄ$M  ʄ$̄$.ʄ$M .ʄ$M Y@ ) )`%)8`)    L)ˢ   â LE % %  )  `8`&e epɀj f f&e e pɀjff %) % )`% L=`0(%$ $ @' &    0&!"   #"  ` ` `SN-(' . hhhhhhHH `  HH8H8  hhhL .+ rhh hehe ɡ& Invalid #aP  ˄8&Destroy Gצ: ?  J ٪ # ת á 1 0 ء,ˡ   ߓ`&צPut " ȡ3پ!}ȄپaپzȄ پaAצI T  ܪ۪ڪ-ˡ[ ġR&    צ ? (Y/N) - -F&צ ? expected1(& Ş"˶ I/O error # 4!צ Filer error # ء\&),áY 6(saveת(Wildcard not allowedת(צ"Bad form (Wild Non-Wild) card(Ill file/vol nameת(}Ill change (Vol file) nameת(UBad dest for files foundת(4,"iEbUġ#(צ  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 ת(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(Gצצkת{צcתת(WצSתԦת(KצOת  n`Äצ(ڹצParity (CRC) error(Bad unit numberת(Bad I/O operationת( Timeout error4Copyright (C) 1979, Regents University of Californial5 FILEHAND H v-DRIVE $-P-v$-FNAM D.SETSINE1`--SETSINE2SETDEFAU-SETPORT -P -2(MAKEPOOF=2. F | R T DL X,j X & Z,DX p,vp,DY vBKGND PEEKSTRO,ADDRESS ,vDIRSRCe*e+)*)fjfjfj+*fjfjfj8 8) )` (J(F ((Lee Lw  )Lb I1Lb )QLb        xhXhhhhhhhhHH v # " `' & 8 ! 0"ee8 !  e e8"#0 88$ % 0"ee8$ %  e e8&'0 8heheHHL<  B  ""##8&$iT8&UU !  U"# UT`+%$Y)!p v hhhhhhhhhhH8 )%HHH`5>hhh)hh h h h hhhh : in unit  ء ߓ  ٨š5K ˡ*   ġ" ء " N۪ڪƁK""áN׷9& צ ? "  ڪ٪ت&:&Pɡ(š --> 4ثضÍצ$*á-: %š " ݢÄݢÄ ۡ "ˡ ݢ ڶ /ݢ0/0 /0צ Ɓ3"ڕš"قܡCצC#ÄÄ~Íj%á*Put in G:'Insert destination disk;GK,,G,:, ׯ>צRemoveǀ RemoveE+Gޤ removed%á % ń,&Update directory ? ,(*צChange*[")ǐ ),, d,,[,["𥀈{á򥀿Dá" G"+!+~G?KÄ?G;KׯɄS{c\ڥs[KG2G:[ Remove oldRƁ-צChangeChange to what׷{צSW,,W,צ:,(,,(,{A=gPܓÄ)jjSjצ:jˡjj(jAj(ܓfOGK ׷Ȅff@ Զ nުݪ"צPWkKGš?=ɍ :g=#g=ɍ=*á =*jjjצ:j($hh=ɡX="#š=P="="=h"h=h"h"=P=gg=á?gg=ɡ, 󍓡 char. max >- Illegal formatT<=ڲ= ݪצc&.צ what fileצ what vol ?  , gg#š=jgjPgۓ$=?'ز=g(=g=&=g&Pɡۡצ ...too long <ٹFצ file name < scan string #צ vol name  M8!ۡ1á    - k'{[{ c󓍄E''S'צ:'{!'0'c?'(&K&not processed á á(3!:W~(gڲ= ggڤ ''k'ȡKk'k-'' ܡšڡK N Y˄ &"&& & ܡ&'&צc& آצ ? ) ,áYø۪     0ު(áܲ~ %&ܥKO &&ȡuáצ fܪ(G[!nء CGGá+á &"ˡ~[צ[ ˡ  .  sآWצ:آ(Y?::á ;&Pġ - عEXå[ׯGC81(o* MJLN0A$6Uۡ &Pɡ צ, áצ /0 0 òCń /C"ݢݢ///://tLצTransferTo whereׯ󓄡=H3Transferצblocks# of blocks to transfer צTransferׯ( Ɓ-צMakeǐh"))** **"&G:[ madeצT  ߪ Ɓ8 55 *SYSTEM.WRK. 5١ ƃƃ"ƃ ,  N, Vols on-line: ȡ &G ȡR~צ; צ #  :צRoot vol is - ?ƅ0ʅ/ƅ0- ڍʅ- .ƃʅ. ƃ/ƃ  ƃ files;ƃצ, ƃʅ( ƃ blocks usedƃ, ƃʅ* ƃ unusedƃצ, ƃʅ+ ƃצ in largest"/.ʅ/ʅ/̅)ʅ(ʅ)̅(ƃʅ/ƃצʅ/ƃʅ) ƃʅ/  ƃ-ƃƅ0ʅ/ ƅ0ƃ-ƃʅ/   ءQƃʅ/ ƃʅ/  ƃƃƅ0ʅ/ƅ0ƃfile3ƃʅ/ ƃ ƃng ofצ׷١糖 צ#1:(ƃ"١̅.̅-̅,̅+̅*̅) ̅(צ Ä - %̅,ړצListƅ-~$ʅ.áWriting.ʅ.̅.ʅ- ̅/ʅ- ʅ,ÍP$&,􍓡~%K:, %,,,|-ٕڶ+šڸ+*ڂ*ŶB < UNUSED >     -p.ƃƅ'Dir listia ȡ$GCػ*c+C ػ?צ:@Ä Cצ The date is C -C-C 6 ),%ö1>--<00..99>Cˡ_צ Today is C -C-C  New date ?  +Cػ*škGGȡ"GؾAĥGؾZȄ GإGؾAצ.CODEצCode (١%צNo  file loaded '- &*- ȡ%ܾz ܾ0ŶȄ: \+%Date set: <1..3á@ .  ڲ צ& * (&Getצǐ%G.[.&ؓń=.צ.TEXT.צ.CODE ..Ȳ.׷:.TEXTצText ײ&(צ*SYSTEM.WRK.TEXTצ*SYSTEM.WRK.CODEצ*SYSTEM.LST.TEXT**.*צ.BACK*צRemove  ء&צWorkfile cleared%Tf & ݪܪ  : .  ǀצ not named2 Workfile is :.񄓡 (not saved) No workfilev$.ת&תת(%Ɓ.񄓡9&צThrow away current workfile ?  ء.[G&TEXT&  "hKצ*..CODEOld code removed, Text file saved  & 0צCODE  "צCode file saved62!o.צ #[.GC .צE&Save as :. ? 瓡צSave asצ[š C?/צTEXT#CODE#饀! 5 4454=5  d66.6.6 65ݪ   p "٪ؓצ *SYSTEM.WRK.,C:[.,:צPrefix is - ;: / צ Zero dir ofצH צDuplicate dir ?   Are thereצblks on the diskצ# of blocks on the disk צNew vol name ?  饀:˥׷!צ:DGצ : correct ? G CK "צ: zeroed p0šצFile(s) endangered:Mȡl\tTITLE 0 & L (*&brB\ "%>'&t##))h'+*,"--.. //F0`0z0004P5n70L4H5D)@:BZ2" (@,(NXF0N>w\ G&צSYSTEM.WRK.TEXT צSYSTEM.WRK.CODE &PĶ (Dɞ(ń?Íצ0???JanFebMarAprMayJunJulAugSepOctNovDec?????????0צ Bad CodeTextInfoDataGrafFoto ~%"!צPrefix titles byl;G& Prefix is ;:`$\ X/T3P0L4H5D)@:BZ2" (@,(NXF0N>w\ G&צSYSTEM.WRK.TEXTiler: W, B, E, K, M, P, V, X, Z [1.1]7ڡ$&B% ȡ~٤ܦ׷u ȡhܲ~ؤVWarning units   &  צ have the same name,,'&R87תVצOFiler: G(et, S(ave, W(hat, N(ew, L(dir, R(em, C(hng, T(rans, D(ate, Q(uit [1.1]7+צ&Filer: G, S, N, L, R, C, T, D, Q [1.1]7?áVOFiler: B(ad-blks, E(xt-dir, K(rnch, M(ake, P(refix, V(ols, X(amine, Z(ero [1.1]7+&F'  š 6  צback  ġ ɡ6 G : crunched#צPlease re-boot{ X5تPFP') x " " ġ  6צCrunch@צFrom end of disk, blockצStarting at block # 2 % forward ת  ȡoTTT TWT ɡTTWT#VV צBad blocks markedH`]t4 ۢˡMoving ۢۢצ SYSTEM.PASCAL G?   š Vá41Mark bad blocks ?š$צ (files will be removed !)צ (Y/N) YbcCZ BAD.xxxxx.BADתV̂dVʂdȡV̂eʂeWʂeXT̂fTʂfġ1Z TʂeoT0ʂeʂeSVR̂dVʂdȡצBlock V ƁdVƁdV"á dV"Ɓdd  may be okz is badV2ˡYV šOUVˡ9TTTM šTVTVVUVxamine blocks onצH&Block-range ? S  SRR  RRˡR ġ RSSRō4%SVR̂dVʂdȡ V2VVš#1 Fix them ? Ǡ  T UScan forצblocksScan for how many blocks ܕšۏ"ˡ`ۂȡQ"ˡ92צBlock  צ is badۂġ צ bad blocks1 3צEؤ áצ Directoryڢڢ  v 1ˡZ ȡ<ڤ š+ؓښڤ ȡ2ؓ R j2צBad block scan ofצHB0צ&Error encountered - program terminatedJتP-ƁY --+",-,+ˍ- ZצAUGE.PICLjȡ  Apple User Group Europe~?><~?@Y@@`><>@@@@@@@E@@@`px~p|~?`|x|~?~?<@%@@`~?>8><~?>>p>`>`><@%@@`@6????? @@`0  0  @@@@@@||@%@a@`~?>@@@@@@@%@Y@@@``|`x|x 0x|| @@@`~?>8><~?>>p|>`>`><@@@a@8<?@@00  ` @@@@@@%@Q@`~?~@A@@@@@@%@Y@@@@`~?>~~?x~`~?x`x`~=@y@ P R E S E N T S(LOGO.PICLjȡ pȡ %Please make sure to read the supplied#documentation first, especially the$section on how to set up the system.  "+",-,+ˍ- ZצAUGE.PICLjȡ  Apple User Group Europe P R E S E N T S(LOGO.PICLjȡ pȡ %Please make sure to read the supplied#documentation first, especially the@@@@@}8>3333333 ?@@ @p 8 `@`@@@@@`x|~?x~?~p~?<<~?|~>>@%@@`<><><< >>` >` >`><@E@`><~@@@@|@I@Q@@@@@Y@Q@@`<>~<~~~`~`~~?@@@@`|x|x@x@| @@@%`@7`@7@``@30>??3>3333 [333@@A0@@`><>@ @@`><~?@}@Q@@@@@@a@@`>>>8><>>>>`>p>`>~?@ @@`>>x~>>|~?|`|`~?<@@@%0@@@@800333>333 [>33@@!?xg{cgwwg{|p@p@@`><>@@@`><~@A@a@@@@@@@@`|><><|>>p>x>`>~?@E@@`><|~?><~?~~?`~?`~<@y@@`@@38>0>833303?33 3[033@@x< t8< p````@@|><~@@@`><>@@@@@@@ @@@Ep` p` @pp@a80?0>333[>33@@0@@@`<>~<|~||`|`~^?@@@@@xxx`pp~p|@ppxx@sx``xp~p8`x~|||p|@pxa`xx?p@px?`@xx|`p`x?xpxp`p~p|@ppxpsx|`~x?p~p8x|~||p|@pxa@@x?p@px@`x@x|@pxx`xx@pxp|@xpx`?px|`p?xp?||~?x@ppp|@ppx@@`` AO Mxp`|@ 0 0 @ 0 @@@@@@8@`~?~@!@y@@Q@@@@@@%@Q@x?`@?|xx~x@xxc`~@xp@xxsx~x`p|@p~pppx~@x@px``@?p|@|px~x||x`?@p|@xpxopp|?pxp?x|xx`@xx~|xx``p|pp@pppx~|px?@@x`@?@@?p|@p8|x?~xx`?@p|@pxgpx`@xpp~xp`pxx~~~`x~x@`?`@`?pp@@|@p@x~x|x@~x`@?`~p|~p8xx~`xpp|@pxcp?|~xxp`~xp`xx?x~|px|x`~|?`@`?p|@ppx|pcx@xxp?`~p|xp8px@|pp|@pxx`xx??x|?x/p`@xp?||N^QQhlemann'); !STATUS; !SETCHAIN('AUGEMENU');  END. I] THEN J:=J+1; "CLOSE(FILEMAP); "WRITELN('(The file is',TRUNC((J/MAXDATA)*100):4,'% full)'); !END; (* Status *) " "  BEGIN !PAGE(OUTPUT);GOTOXY(0,12); !WRITELN('Welcome, IACBASE: to Pascal 1.1'); !WRITELN; !WRITELN('copyright 1982 by frank poDATA] OF BOOLEAN; ! !VAR FILEMAP:FILE OF INDEXTYPE; )I,J:INTEGER; ) !BEGIN "J:=0; " "(*$I- *) " "RESET(FILEMAP,MAPNAME); "IF IORESULT<>0 THEN EXIT(STATUS); " "(*$I+ *) " "SEEK(FILEMAP,0);GET(FILEMAP); "FOR I:=1 TO MAXDATA DO #IF FILEMAP^[   PROGRAM STARTLIST;  USES CHAINSTUFF;    (*$Copyright 1982 by Frank Pohlemann *) " "(* Apple User Group Europe e.V. M330 *) " ! !PROCEDURE STATUS;  !CONST MAPNAME='AUGELIST.INDEX'; 'MAXDATA=100;  !TYPE INDEXTYPE=PACKED ARRAY[1..MAXN^QQx|?~||xx?@?@pxx@qxp@`||p~?@x@p@x|x@xx?@ppp|@ppxx|~xx~p|@xp   PROGRAM MENULIST;  USES CHAINSTUFF;   "(*$Copyright 1982 by Frank Pohlemann *) " "(* Apple User Group Europe e.V. M330 *) "   VAR CHECKSET:SET OF CHAR; % PROMPT:CHAR;   PROCEDURE RECONFIRM; ! !BEGIN "PAGE(OUTPUT); "GOTOXY(0,5);WRSTRING[20]; 1SYSTEM:SYSTYPE; 1LANGUAGES:LNGTYPE; 1PERIPHERALS,INTEREST:STRING[80]; 1PURCHASE:STRING[10]; 0END; 0 0  VAR DATA:FILE OF LISTENTRY; $FILEMAP:FILE OF INDEXTYPE; *I:INTEGER; &DUMMY:LISTENTRY; $ZEROMAP:INDEXTYPE; ' '  PROCEDURE RAY[1..16] OF BOOLEAN; 'LNGTYPE =PACKED ARRAY[1..8] OF BOOLEAN; %INDEXTYPE =PACKED ARRAY[1..MAXDATA] OF BOOLEAN; % &LISTENTRY=RECORD 1MNUMBER:INTEGER; 1NAME,PRENAME:STRING[40]; 1MISCNAME:STRING[40]; 1STREET,TOWN:STRING[40]; 1ZIP:STRING[20]; 1TEL:   PROGRAM INITLIST;  USES CHAINSTUFF;   "(*$Copyright 1982 by Frank Pohlemann *) " "(* Apple User Group Europe e.V. M330 *) "   CONST FILENAME ='AUGELIST.DATA'; & MAPNAME ='AUGELIST.INDEX'; 'MAXDATA =100; ' '  TYPE SYSTYPE =PACKED ARN^Q!UNTIL FALSE; (* until exit through 'Q' *)  END. GIN SETCHAIN('AUGELIST');EXIT(PROGRAM) END; 0'P': BEGIN SETCHAIN('AUGEPRNT');EXIT(PROGRAM) END; 0'E': BEGIN SETCHAIN('AUGEENT');EXIT(PROGRAM) END; 0'N': BEGIN SETCHAIN('AUGEINIT');EXIT(PROGRAM) END; 0'Q': RECONFIRM; !END; !PAGE(OUTPUT); CHECKSET:=['I','i','P','p','E','e','N','n','Q','q'];  REPEAT !GOTOXY(0,0);WRITE('IACBASE: I)nfo P)rnt E)nt N)ew Q)uit'); !GET(KEYBOARD); !IF KEYBOARD^ IN ['a'..'z'] THEN PROMPT:=CHR(ORD(KEYBOARD^)-32) !ELSE PROMPT:=KEYBOARD^; !CASE PROMPT OF 'I': BEITELN(' - Exit to PASCAL command level:'); "WRITELN;WRITE(' type to confirm'); "GET(KEYBOARD); "IF KEYBOARD^ IN ['Y','y'] THEN BEGIN #WRITELN;WRITELN;WRITELN(' [ ok., goodbye! ]'); #EXIT(PROGRAM); "END; !END; (* Reconfirm *) " "  BEGIN INITIALIZE; ! !VAR I:INTEGER; %A,B,C,D:STRING; ! !BEGIN "A:='';B:='';C:='';D:=''; "FOR I:=1 TO 10 DO A:=CONCAT(A,' '); "FOR I:=1 TO 20 DO B:=CONCAT(B,' '); "FOR I:=1 TO 40 DO C:=CONCAT(C,' '); "FOR I:=1 TO 80 DO D:=CONCAT(D,' '); "WITH DUMMY DO BEGIN #MNUMBER:=0; #NAME:=C;PRENAME:=C;MISCNAME:=C; #STREET:=C;TOWN:=C;ZIP:=B;TEL:=B; #PERIPHERALS:=D;INTEREST:=D;PURCHASE:=A; #NAME:=COPY(CONCAT('-',NAME),1,40); #FOR I:=1 TO 16 DO SYSTEM[I]:=FALSE; #FOR I:=1 TO 8 DO LANGUAGES[I]:=FN^Q"REWRITE(FILEMAP,MAPNAME); "IF IORESULT<>0 THEN ERROR; "FILEMAP^:=ZEROMAP;PUT(FILEMAP); "CLOSE(FILEMAP,LOCK); " "(*$I+ *) " ! WRITELN;WRITELN(''); !END;  END. ,FILENAME); "IF IORESULT<>0 THEN ERROR; "FOR I:= 1 TO MAXDATA DO BEGIN #IF TRUNC(I/10)=I/10 THEN WRITE('.'); #DATA^:=DUMMY;PUT(DATA); #IF IORESULT<>0 THEN ERROR; "END; "CLOSE(DATA,LOCK); "WRITELN;WRITELN('Installing new indexfile...'); ITELN;WRITELN('-please confirm to proceed by'); !WRITE(' typing '); !UNITCLEAR(1);GET(KEYBOARD); !IF KEYBOARD^ IN ['Y','y'] THEN BEGIN "FILECHECK; "PAGE(OUTPUT);GOTOXY(0,10); "WRITELN('Installing new datafile...'); " "(*$I- *) " "REWRITE(DATA!PAGE(OUTPUT);GOTOXY(0,5); !WRITELN('*** WARNING ***');WRITELN; !WRITELN('This program will erase permanently'); !WRITELN('the contents of any files named '); !WRITELN(FILENAME,' or'); !WRITELN(MAPNAME); !WRITELN('already existing on disk !'); !WR#WRITELN(MAPNAME,' !'); #WRITELN('-erase it ?'); #UNITCLEAR(1);GET(KEYBOARD); #IF NOT (KEYBOARD^ IN ['Y','y']) THEN EXIT(PROGRAM); #CLOSE(FILEMAP); "END; " !(*$I+ *) " !END; (* Filecheck *) ! ! !  BEGIN !SETCHAIN('AUGEMENU'); !INITIALIZE; ET(KEYBOARD); #IF NOT (KEYBOARD^ IN ['Y','y']) THEN EXIT(PROGRAM); #CLOSE(DATA); "END; "RESET(FILEMAP,MAPNAME); "IF IORESULT=0 THEN BEGIN #PAGE(OUTPUT);GOTOXY(0,10); #WRITELN(CHR(7),'>>> There already exists a file named'); PROCEDURE FILECHECK; ! !BEGIN ! !(*$I- *) ! "RESET(DATA,FILENAME); "IF IORESULT=0 THEN BEGIN #PAGE(OUTPUT);GOTOXY(0,10); #WRITELN(CHR(7),'>>> There already exists a file named'); #WRITELN(FILENAME,' !'); #WRITELN('-erase it ?'); #UNITCLEAR(1);GALSE; "END; "FOR I:=1 TO MAXDATA DO ZEROMAP[I]:=FALSE; !END; (* Initialize *) ! !PROCEDURE ERROR; ! !BEGIN "WRITELN('>>> I/O ERROR (program aborted)'); "(*$I- *) "CLOSE(DATA);CLOSE(FILEMAP); "(*$I+ *) "EXIT(PROGRAM); !END; (* Error *) ! !   (*$S+ *)   PROGRAM ENTERLIST;  USES CHAINSTUFF;   "(*$Copyright 1982 by Frank Pohlemann *) " "(* Apple User Group Europe e.V. M330 *) "   CONST FILENAME ='AUGELIST.DATA'; (MAPNAME ='AUGELIST.INDEX'; (MAXDATA =100; &  TYPE S "CHECKSET:=['Y','y','N','n']; "FOR I:=1 TO 16 DO BEGIN #CASE I OF 1: S:='16K'; -2: S:='32K'; -3: S:='48K'; -4: S:='64K'; -5: S:='1 drive'; -6: S:='2 drives'; -7: S:='3 or more drives'; -8: S:='8 inch floppies'; -9: S:='Z80 - Card'; ,10: S:='68S);WRITELN(INTEREST); #WRITELN('Has an apple since:',PURCHASE); "END; !END; (* Display *) ! " !PROCEDURE GETSYS(VAR A:SYSTYPE); ! !CONST CLEAR=' '; ! !VAR I :INTEGER; %S :STRING; %CHECKSET:SET OF CHAR; ! !BEGIN#WRITELN(STREET);WRITELN(ZIP,' ',TOWN);WRITELN; #WRITELN('Tel.: ',TEL); #WRITELN('----------------------------------------'); #DECSYS(SYSTEM);WRITELN;DECLNG(LANGUAGES);WRITELN; #WRITELN('----------------------------------------'); #WRITELN(PERIPHERALENLOC:=SCREENLOC+LENGTH(S); #END; !END; (* Declng *) ! ! !PROCEDURE DISPLAY(D:LISTENTRY); ! !BEGIN "PAGE(OUTPUT);GOTOXY(0,4); "WITH D DO BEGIN #WRITELN('M',MNUMBER);WRITELN; #WRITELN(PRENAME);WRITELN(NAME); #WRITELN(MISCNAME);WRITELN; '; .4: S:='Fortran'; .5: S:='Pilot'; .6: S:='Assembler'; .7: S:='Cobol'; .8: S:='others'; $END; $IF (SCREENLOC+LENGTH(S)+1) > 39 THEN BEGIN %WRITELN;SCREENLOC:=0;SECOND:=FALSE; $END; $IF SECOND THEN WRITE('/') $ELSE SECOND:=TRUE; $WRITE(S);SCRE&SCREENMARG:INTEGER; &S :STRING; " "BEGIN "IF PRSELECT THEN SCREENMARG:=79 "ELSE SCREENMARG:=39; "SCREENLOC:=0;SECOND:=FALSE; "FOR I:=1 TO 8 DO #IF PLIST[I] THEN BEGIN $CASE I OF 1: S:='Integer Basic'; .2: S:='Applesoft'; .3: S:='Pascal%WRITELN;SCREENLOC:=0;SECOND:=FALSE; $END; $IF SECOND THEN WRITE('/') $ELSE SECOND:=TRUE; $WRITE(S);SCREENLOC:=SCREENLOC+LENGTH(S); #END; !END; (* Decsys *) ! ! ! !PROCEDURE DECLNG(PLIST:LNGTYPE); ! !VAR SECOND :BOOLEAN; &I, &SCREENLOC, - Card'; -10: S:='6809 - Card'; -11: S:='Printer'; -12: S:='Plotter'; -13: S:='80 columns Card'; -14: S:='PAL - Coder'; -15: S:='Monitor'; -16: S:='** SPECIAL **'; $END; $IF (SCREENLOC+LENGTH(S)+1) > SCREENMARG THEN BEGIN =39; "SCREENLOC:=0;SECOND:=FALSE; "FOR I:=1 TO 16 DO #IF PLIST[I] THEN BEGIN $CASE I OF 1: S:='16K'; .2: S:='32K'; .3: S:='48K'; .4: S:='64K'; .5: S:='1 drive'; .6: S:='2 drives'; .7: S:='3 or more drives'; .8: S:='8 inch floppies'; .9: S:='Z80SDUMMY[I]:=TRUE; "FOR I:=1 TO 8 DO LNGDUMMY[I]:=TRUE; !END; ! ! !PROCEDURE DECSYS(PLIST:SYSTYPE); ! !VAR SECOND :BOOLEAN; %I, %SCREENLOC, %SCREENMARG:INTEGER; %S :STRING; ! !BEGIN "IF PRSELECT THEN SCREENMARG:=79 "ELSE SCREENMARG:"IF IORESULT <> 0 THEN BEGIN #WRITELN('Unable to open datafile...'); #EXIT(PROGRAM); "END; "RESET(FILEMAP,MAPNAME); "IF IORESULT <> 0 THEN BEGIN #WRITELN('Unable to open indexfile...'); #EXIT(PROGRAM); "END; " "(*$I+ *) " "FOR I:=1 TO 16 DO SYMAP :FILE OF INDEXTYPE; $SYSDUMMY:SYSTYPE; $LNGDUMMY:LNGTYPE; $PRSELECT:BOOLEAN; $ " " !PROCEDURE INITIALIZE; ! !VAR I:INTEGER; ! !BEGIN "PAGE(OUTPUT);GOTOXY(0,10); "PRSELECT:=FALSE; " "(*$I- *) " "RESET(DATA,FILENAME); ,PRENAME:STRING[40]; 4MISCNAME:STRING[40]; 4STREET,TOWN:STRING[40]; 4ZIP:STRING[20]; 4TEL:STRING[20]; 4SYSTEM:SYSTYPE; 4LANGUAGES:LNGTYPE; 4PERIPHERALS,INTEREST:STRING[80]; 4PURCHASE:STRING[10]; 3END; / %  VAR DATA :FILE OF LISTENTRY; $FILEYSTYPE =PACKED ARRAY[1..16] OF BOOLEAN; *LNGTYPE =PACKED ARRAY[1..8] OF BOOLEAN; (INDEXTYPE =PACKED ARRAY[1..MAXDATA] OF BOOLEAN; ' STRING10 =STRING[10]; )STRING20 =STRING[20]; )STRING40 =STRING[40]; 4 - )LISTENTRY=RECORD 4MNUMBER:INTEGER; 4NAME09 - Card'; ,11: S:='Printer'; ,12: S:='Plotter'; ,13: S:='80 columns Card'; ,14: S:='PAL - Coder'; ,15: S:='Monitor'; ,16: S:='** SPECIAL **'; #END; #GOTOXY(0,2);WRITELN(CLEAR); #GOTOXY(0,2);WRITE(S,' ?'); #REPEAT GET(KEYBOARD) UNTIL KEYBOARD^ IN CHECKSET; #IF KEYBOARD^ IN ['Y','y'] THEN A[I]:=TRUE; #IF KEYBOARD^ IN ['N','n'] THEN A[I]:=FALSE; "END; !END; (* Getsys *) ! " !PROCEDURE GETLNG(VAR A:LNGTYPE); !CONST CLEAR=' '; " !0(STREET); $CLR;GOTOXY(0,1);WRITELN('Town'); $PATCH40(TOWN); $CLR;GOTOXY(0,1);WRITELN('Zipcode'); $PATCH20(ZIP); $CLR;GOTOXY(0,1);WRITELN('Phone Number'); $PATCH20(TEL); $PAGE(OUTPUT);GOTOXY(0,10); $DECSYS(SYSDUMMY); $GOTOXY(0,0);WRITELN('Enter: <$PATCHINT(MNUMBER); $CLR;GOTOXY(0,1);WRITELN('Name'); $PATCH40(NAME); $CLR;GOTOXY(0,1);WRITELN('Prename'); $PATCH40(PRENAME); $CLR;GOTOXY(0,1);WRITELN('additional ID (i.e. company)'); $PATCH40(MISCNAME); $CLR;GOTOXY(0,1);WRITELN('Street'); $PATCH4"PROCEDURE EDIT(VAR A:LISTENTRY); " "CONST CLEAR=' '; " #PROCEDURE CLR; # #BEGIN $GOTOXY(0,1);WRITELN(CLEAR);WRITELN(CLEAR); #END; " "BEGIN #WITH A DO BEGIN $CLR;GOTOXY(0,1);WRITELN('Member''s number:'); #END; "END; " "PROCEDURE PATCH80(VAR A:STRING); " "VAR B,C:STRING; (I:INTEGER; " "BEGIN #B:='';READLN(C); #IF LENGTH(C)>0 THEN BEGIN $FOR I:=1 TO 80 DO B:=CONCAT(B,' '); $A:=COPY(CONCAT(C,B),1,80); #END; "END; " $A:=COPY(CONCAT(C,B),1,20); #END; "END; " "PROCEDURE PATCH40(VAR A:STRING40); " "VAR B:STRING[40]; &C:STRING; &I:INTEGER; " "BEGIN #B:='';READLN(C); #IF LENGTH(C)>0 THEN BEGIN $FOR I:=1 TO 40 DO B:=CONCAT(B,' '); $A:=COPY(CONCAT(C,B),1,40);=1 TO 10 DO B:=CONCAT(B,' '); $A:=COPY(CONCAT(C,B),1,10); #END; "END; % "PROCEDURE PATCH20(VAR A:STRING20); " "VAR B:STRING[20]; &C:STRING; &I:INTEGER; " "BEGIN #B:='';READLN(C); #IF LENGTH(C)>0 THEN BEGIN $FOR I:=1 TO 20 DO B:=CONCAT(B,' ');)end; &TERMINATE #end; " "BEGIN #READLN(INS); #X:=STRtoINT(INS,A); #IF X<=0 THEN A:=0; "END; " "PROCEDURE PATCH10(VAR A:STRING10); " "VAR B:STRING[10]; &C:STRING; &I:INTEGER; " "BEGIN #B:='';READLN(C); #IF LENGTH(C)>0 THEN BEGIN $FOR I:CH)-ord('0') 5else begin 8INT:=32767; 8INX:=-1; 8TERMINATE 5end; 2SN:=true /end /else case CH of 2'+': if SN then TERMINATE :else SN:=true; 2'-': if SN then TERMINATE :else begin =MN:=true; =SN:=true :end; /end (*case*) ,else TERMINATE .'9']; &Modifier:=['+','-']; &SN:=false; MN:=false; &INT:=0; &SEARCH; &for INX:=INX to LEN do begin )CH:=ST[INX]; )if CH in Numeric+Modifier ,then if CH in Numeric /then begin 2if (INT<3276) 2or ((INT=3276) and (CH<'8')) 5then INT:=INT*10+ord(r INX:=1 to LEN do begin ,CH:=ST[INX]; ,if CH in Numeric then exit(SEARCH) /else if (CH in Modifier) and (INX, (choose from below) '); $WRITELN('Programming languages used:'); $GETLNG(LANGUAGES); $PAGE(OUTPUT);GOTOXY(0,0);WRITELN('> Enter new record'); $WRITELN('Peripherals'); $PATCH80(PERIPHERALS); $CLR;GOTOXY(0,1);WRITELN('Special interests'); $PATCH80(INTEREST); $CLR;GOTOXY(0,1);WRITELN('Has an Apple since (mm/yy, i.eN^1å!INITIALIZE; !HELLO; !MENU; !GOODBYE;  END. D^)>96 THEN PROMPT:=CHR(ORD(KEYBOARD^)-32) $ELSE PROMPT:=KEYBOARD^; $CASE PROMPT OF 'E': ENTER; 3'Q': EXIT(MENU); $END; #END #ELSE PAGE(OUTPUT); "UNTIL FALSE; (* until exit through 'Q' *) !END; (* Menu *) ! ! !  BEGIN (* Main program *) NU; ! !VAR COMMANDSET:SET OF CHAR; )PROMPT:CHAR; ! !BEGIN "COMMANDSET:=['E','e','Q','q']; ! REPEAT #GOTOXY(0,0);WRITE('New names: E)nter Q)uit '); #GOTOXY(23,0);GET(KEYBOARD); #IF KEYBOARD^ IN COMMANDSET THEN BEGIN $IF ORD(KEYBOAR Europe e.V. M330'); !END; (* Hello *) ! ! !PROCEDURE GOODBYE; ! !BEGIN "PAGE(OUTPUT); "SETCHAIN('AUGEMENU'); "CLOSE(DATA,LOCK); "CLOSE(FILEMAP,LOCK); "GOTOXY(0,10); "WRITELN('That''s all, folks !'); !END; (* Goodbye *) ! ! !PROCEDURE ME#SEEK(FILEMAP,0);GET(FILEMAP); "END; !END; (* Enter *) ! ! !PROCEDURE HELLO; ! !BEGIN "PAGE(OUTPUT);GOTOXY(0,10); "WRITELN(' IACBASE: Data Entry'); "WRITELN; "WRITELN(' copyright 1982 by frank pohlemann'); "WRITELN(' Apple User Group); #REPEAT GET(KEYBOARD) UNTIL KEYBOARD^=' '; #EXIT(ENTER); "END "ELSE BEGIN #DISPLAY(DATA^); #GOTOXY(0,2);WRITELN('This image was written out to file:'); #SEEK(DATA,I);PUT(DATA); #FILEMAP^[I]:=TRUE; #SEEK(FILEMAP,0);PUT(FILEMAP); N BEGIN #GOTOXY(0,0);WRITE('>>> File is full (press )'); #REPEAT GET (KEYBOARD) UNTIL KEYBOARD^=' '; #EXIT(ENTER); "END; "SEEK(DATA,I);GET(DATA); "EDIT(DATA^); "IF DATA^.NAME[1] ='-' THEN BEGIN #GOTOXY(0,0);WRITE('>>> Invalid name (press )'. 09/81)'); $PATCH10(PURCHASE); #END; "END; ! !BEGIN "PAGE(OUTPUT); "WRITELN('> Enter new record'); "FOUNDPLACE:=FALSE;I:=0; "REPEAT #I:=I+1; #IF NOT FILEMAP^[I] THEN FOUNDPLACE:=TRUE; "UNTIL (FOUNDPLACE) OR (I=MAXDATA); "IF NOT FOUNDPLACE THE   (*$S+ *)    PROGRAM PRINTLIST;  USES CHAINSTUFF;   "(*$Copyright 1982 by Frank Pohlemann *) " "(* Apple User Group Europe e.V. M330 *) "   CONST FILENAME ='AUGELIST.DATA'; (MAPNAME ='AUGELIST.INDEX'; (MAXDATA =100; &  TYPE ! ! ! !PROCEDURE DECLNG(PLIST:LNGTYPE); " "VAR SECOND :BOOLEAN; &I, &SCREENLOC, &SCREENMARG:INTEGER; &S :STRING; " "BEGIN "SCREENMARG:=79; "SCREENLOC:=0;SECOND:=FALSE; "FOR I:=1 TO 8 DO #IF PLIST[I] THEN BEGIN $CASE I OF 1: S:=ENLOC+LENGTH(S)+1) > SCREENMARG THEN BEGIN %WRITELN(TERMINAL);SCREENLOC:=0;SECOND:=FALSE; $END; $IF SECOND THEN WRITE(TERMINAL,'/') $ELSE SECOND:=TRUE; $WRITE(TERMINAL,S);SCREENLOC:=SCREENLOC+LENGTH(S); #END; "WRITELN(TERMINAL); !END; (* Decsys *).7: S:='3 or more drives'; .8: S:='8 inch floppies'; .9: S:='Z80 - Card'; -10: S:='6809 - Card'; -11: S:='Printer'; -12: S:='Plotter'; -13: S:='80 columns Card'; -14: S:='PAL - Coder'; -15: S:='Monitor'; -16: S:='** SPECIAL **'; $END; $IF (SCRE :STRING; ! !BEGIN "SCREENMARG:=79; "SCREENLOC:=0;SECOND:=FALSE; "FOR I:=1 TO 16 DO #IF PLIST[I] THEN BEGIN $CASE I OF 1: S:='16K'; .2: S:='32K'; .3: S:='48K'; .4: S:='64K'; .5: S:='1 drive'; .6: S:='2 drives'; ELN('>>> No entries in file...'); #EXIT(PROGRAM); "END; "QUICKSORT(NUMLIST,LISTPNT); "QUICKSORT(NAMELIST,LISTPNT); !END; (* Initlists *) ! ! !PROCEDURE DECSYS(PLIST:SYSTYPE); ! !VAR SECOND :BOOLEAN; %I, %SCREENLOC, %SCREENMARG:INTEGER; %S+1; $STR(DATA^.MNUMBER,HELP); $HELP:=CONCAT(ZERO,HELP); $NUMLIST[LISTPNT].INDEX:=COPY(HELP,LENGTH(HELP)-39,40); $NUMLIST[LISTPNT].POINTER:=I; $NAMELIST[LISTPNT].INDEX:=DATA^.NAME; $NAMELIST[LISTPNT].POINTER:=I; #END; "IF LISTPNT=0 THEN BEGIN #WRIT!PROCEDURE INITLISTS; ! !VAR ZERO:STRING; %HELP:STRING[160]; (I:INTEGER; ( !BEGIN "ZERO:=''; "FOR I:=1 TO 80 DO ZERO:=CONCAT(ZERO,'0'); "LISTPNT:=0; "FOR I:=1 TO MAXDATA DO #IF FILEMAP^[I] THEN BEGIN $SEEK(DATA,I);GET(DATA); $LISTPNT:=LISTPNTNDEX>X DO J:=J-1; $IF I<=J THEN BEGIN %SWAP:=L[I];L[I]:=L[J];L[J]:=SWAP; %I:=I+1;J:=J-1; $END; #UNTIL I>J; #IF LEFTI THEN SORT(I,RIGHT); "END; " !BEGIN "SORT(1,N); !END; (* Quicksort *) ! ! E QUICKSORT(VAR L:LISTTYPE;N:INTEGER); ! "PROCEDURE SORT(LEFT,RIGHT:INTEGER); " "VAR I,J:INTEGER; (X:STRING[40]; %SWAP:SORTENTRY; & "BEGIN #I:=LEFT;J:=RIGHT; #X:=L[(LEFT+RIGHT) DIV 2].INDEX; #REPEAT $WHILE L[I].INDEX 0 THEN BEGIN #WRITELN('Unable to open indexfile...'); #EXIT(PROGRAM); "END; " "(*$I+ *) " "DELIMITER:=''; "FOR I:=1 TO 80 DO DELIMITER:=CONCAT(DELIMITER,'='); !END; ! ! !PROCEDUR"WRITELN; " "(*$I- *) " "RESET(TERMINAL,'PRINTER:'); "IF IORESULT <> 0 THEN BEGIN #WRITELN('No printer connected to system...'); #EXIT(PROGRAM); "END; "RESET(DATA,FILENAME); "IF IORESULT <> 0 THEN BEGIN #WRITELN('Unable to open datafile...'); / % %  VAR DATA :FILE OF LISTENTRY; $FILEMAP :FILE OF INDEXTYPE; $NUMLIST, $NAMELIST:LISTTYPE; $LISTPNT :INTEGER; $TERMINAL:INTERACTIVE; #DELIMITER:STRING; )ALL:BOOLEAN; $ $ !PROCEDURE INITIALIZE; ! !VAR I:INTEGER; ! !BEGIN ENAME:STRING[40]; 4MISCNAME:STRING[40]; 4STREET,TOWN:STRING[40]; 4ZIP:STRING[20]; 4TEL:STRING[20]; 4SYSTEM:SYSTYPE; 4LANGUAGES:LNGTYPE; 4PERIPHERALS,INTEREST:STRING[80]; 4PURCHASE:STRING[10]; 3END; 3 3 *LISTTYPE=ARRAY[1..MAXDATA] OF SORTENTRY; SYSTYPE =PACKED ARRAY[1..16] OF BOOLEAN; *LNGTYPE =PACKED ARRAY[1..8] OF BOOLEAN; (INDEXTYPE =PACKED ARRAY[1..MAXDATA] OF BOOLEAN; 4 - )SORTENTRY=RECORD 4INDEX:STRING[40]; 4POINTER:INTEGER; 3END; 3 )LISTENTRY=RECORD 4MNUMBER:INTEGER; 4NAME,PR'Integer Basic'; .2: S:='Applesoft'; .3: S:='Pascal'; .4: S:='Fortran'; .5: S:='Pilot'; .6: S:='Assembler'; .7: S:='Cobol'; .8: S:='others'; $END; $IF (SCREENLOC+LENGTH(S)+1) > 39 THEN BEGIN %WRITELN(TERMINAL);SCREENLOC:=0;SECOND:=FALSE; $END; $IF SECOND THEN WRITE(TERMINAL,'/') $ELSE SECOND:=TRUE; $WRITE(TERMINAL,S);SCREENLOC:=SCREENLOC+LENGTH(S); #END; "WRITELN(TERMINAL); !END; (* Declng *) ! ! !PROCEDURE PRINT(D:LISTENTRY); ! !BEGIN "WITH D DO BEGIN #WRITELN(TERMINAL,'M',MNUMBERUNTIL FALSE; (* Until exit through 'Q' *) !END; (* Menu *) ! ! ! !  BEGIN (* Main program *) !INITIALIZE; !HELLO; !INITLISTS; !MENU; !GOODBYE;  END. #GET(KEYBOARD); #IF NOT (KEYBOARD^ IN COMMANDLIST) THEN PAGE(OUTPUT) #ELSE BEGIN $IF ORD(KEYBOARD^)>96 THEN PROMPT:=CHR(ORD(KEYBOARD^)-32) $ELSE PROMPT:=KEYBOARD^; $CASE PROMPT OF 'A': ALPHALIST; 3'N': NUMBERLIST; 3'Q': EXIT(MENU); $END; #END; "!'); !END; (* Goodbye *) ! ! !PROCEDURE MENU;  !VAR COMMANDLIST:SET OF CHAR; *PROMPT:CHAR; * !BEGIN "COMMANDLIST:=['A','a','N','n','Q','q']; "REPEAT #GOTOXY(0,0); #WRITE('Print: A)lpha N)umbers Q)uit ');GOTOXY(28,0); RITELN('>>> Please wait while'); "WRITELN(' sorting lists...'); !END; (* Hello *) ! ! !PROCEDURE GOODBYE; ! !BEGIN "PAGE(OUTPUT); "SETCHAIN('AUGEMENU'); "CLOSE(DATA,LOCK); "CLOSE(FILEMAP,LOCK); "GOTOXY(0,10); "WRITELN('That''s all, folks (* Numberlist *) ! " !PROCEDURE HELLO; ! !BEGIN "PAGE(OUTPUT);GOTOXY(0,10); "WRITELN(' IACBASE: File Printout'); "WRITELN; "WRITELN(' copyright 1982 by frank pohlemann'); "WRITELN(' Apple User Group Europe e.V. M330'); "GOTOXY(0,16); "W"REPEAT GET(KEYBOARD) UNTIL (KEYBOARD^=' ') OR (ORD(KEYBOARD^)=27); "IF ORD(KEYBOARD^)=27 THEN EXIT(NUMBERLIST); "WRITELN;WRITELN(' -Printing...'); "FOR I:=1 TO LISTPNT DO BEGIN #SEEK(DATA,NUMLIST[I].POINTER);GET(DATA); #PRINT(DATA^); "END; !END; PROCEDURE NUMBERLIST; ! !VAR I:INTEGER; ! !BEGIN "PAGE(OUTPUT); "WRITELN('Printout of file (sorted by number):'); "SETFLAG; "WRITELN;WRITELN(' -please set up printer, press '); "WRITE(' [ to quit]'); NTIL (KEYBOARD^=' ') OR (ORD(KEYBOARD^)=27); "IF ORD(KEYBOARD^)=27 THEN EXIT(ALPHALIST); "WRITELN;WRITELN(' -Printing...'); "FOR I:=1 TO LISTPNT DO BEGIN #SEEK(DATA,NAMELIST[I].POINTER);GET(DATA); #PRINT(DATA^); "END; !END; (* Alphalist *) ! " !ag *) " " !PROCEDURE ALPHALIST; ! !VAR I:INTEGER; ! !BEGIN "PAGE(OUTPUT); "WRITELN('Printout of file (sorted by name):'); "SETFLAG; "WRITELN;WRITELN(' -please set up printer, press '); "WRITE(' [ to quit]'); "REPEAT GET(KEYBOARD) U"WRITELN(' -Do you want full information on every'); "WRITELN(' file or name & address only ?'); "WRITE(' [,]'); "REPEAT GET(KEYBOARD) UNTIL KEYBOARD^ IN CHECKSET; "IF KEYBOARD^ IN ['F','f'] THEN ALL:=TRUE "ELSE ALL:=FALSE; !END; (* Setfle since:',PURCHASE,')'); #END; "IF ALL THEN WRITELN(TERMINAL,DELIMITER) "ELSE WRITELN(TERMINAL); !END; (* Display *) ! ! !PROCEDURE SETFLAG; ! !VAR CHECKSET:SET OF CHAR; ! !BEGIN "CHECKSET:=['F','f','N','n']; TEM); $WRITELN(TERMINAL,'-Languages used:'); $DECLNG(LANGUAGES); $WRITELN(TERMINAL,'-Interesting peripherals:'); $WRITELN(TERMINAL,PERIPHERALS); $WRITELN(TERMINAL,'-Special interests:'); $WRITELN(TERMINAL,INTEREST); $WRITELN(TERMINAL,' (Has an appl); #WRITELN(TERMINAL,PRENAME,NAME); #WRITELN(TERMINAL,MISCNAME);WRITELN(TERMINAL); #WRITELN(TERMINAL,STREET,ZIP,' ',TOWN); #WRITELN(TERMINAL,'Tel.: ',TEL); "END; "IF ALL THEN #WITH D DO BEGIN $WRITELN(TERMINAL,'System configuration:'); $DECSYS(SYSN^å $STR(DATA^.MNUMBER,NEWWORD); $NEWWORD:=COPY(CONCAT(NEWWORD,' '),1,8); " INSERTIT(NEWWORD,NUMROOT,I); #END; "END; !END; (* Builtreenum *) ! ! ! !PROCEDURE BUILDNAME; " "VAR FOUNDPLACE:BOOLEAN; &I :INTEGER; &INCSTR :STRING[1] BEGIN (* chase down tree further *) $IF N>P^.NUM THEN INSERTIT(N,P^.RIGHTLINK,R); $IF NP^.NAME THEN SEARCHNAME:=SEARCHNAME(N,P^.RIGHTLINK); #IF NP^.NUM THEN SEARCHNUM:=SEARCHN$OSEARCH :WORDSTRING; $NUMROOT :NUMNODEPTR; $NAMEROOT:NAMENODEPTR; $DATA :FILE OF LISTENTRY; $FILEMAP :FILE OF INDEXTYPE; $SYSDUMMY:SYSTYPE; $LNGDUMMY:LNGTYPE; $ERROR, $GOAHEAD, $POSSIBLE, $SCANFLAG, $PRSELECT:BOOLEAN; $TERMINAL:INTERACTIVETEGER; 4NAME,PRENAME:STRING[40]; 4MISCNAME:STRING[40]; 4STREET,TOWN:STRING[40]; 4ZIP:STRING[20]; 4TEL:STRING[20]; 4SYSTEM:SYSTYPE; 4LANGUAGES:LNGTYPE; 4PERIPHERALS,INTEREST:STRING[80]; 4PURCHASE:STRING[10]; 3END; / % %  VAR OCMD :CHAR; &NAMENODEPTR =^NAMENDE; 4 - *NUMNODE =RECORD 4NUM:WORDSTRING; 4LEFTLINK,RIGHTLINK:NUMNODEPTR; 4RECNO:INTEGER; 3END; 3 *NAMENDE =RECORD 4NAME:WORDSTRING; 4LEFTLINK,RIGHTLINK:NAMENODEPTR; 4RECNO:INTEGER; 3END; * )LISTENTRY=RECORD 4MNUMBER:INSYSTYPE =PACKED ARRAY[1..16] OF BOOLEAN; *LNGTYPE =PACKED ARRAY[1..8] OF BOOLEAN; (INDEXTYPE =PACKED ARRAY[1..MAXDATA] OF BOOLEAN; 'WORDSTRING =STRING[8]; ' STRING10 =STRING[10]; )STRING20 =STRING[20]; )STRING40 =STRING[40]; 'NUMNODEPTR =^NUMNODE;    (*$S+ *)   PROGRAM MANAGELIST;  USES CHAINSTUFF;   "(*$Copyright 1982 by Frank Pohlemann *) " "(* Apple User Group Europe e.V. M330 *) "   CONST FILENAME ='AUGELIST.DATA'; (MAPNAME ='AUGELIST.INDEX'; (MAXDATA =100; &  TYPE ; &NEWWORD :WORDSTRING; &PNT :NAMENODEPNT; " #PROCEDURE INSERTIT(N:WORDSTRING;VAR P:NAMENODEPTR;R:INTEGER); # #BEGIN $IF P=NIL THEN BEGIN (* Make new node *) %NEW(P); %P^.LEFTLINK:=NIL; %P^.RIGHTLINK:=NIL; %P^.NAME:=N; %P^.RECNO:=R; $END $ELSE BEGIN (* chase down tree further *) %IF N>P^.NAME THEN INSERTIT(N,P^.RIGHTLINK,R); %IF N 39 THEN BEGIN %WRITELN Decsys *) " " " PROCEDURE DECLNG(PLIST:LNGTYPE); " "VAR SECOND :BOOLEAN; &I, &SCREENLOC, &SCREENMARG:INTEGER; &S :STRING; " "BEGIN "IF PRSELECT THEN SCREENMARG:=79 "ELSE SCREENMARG:=39; "SCREENLOC:=0;SECOND:=FALSE; "FOR I:=1 TO 8%IF (SCREENLOC+LENGTH(S)+1) > SCREENMARG THEN BEGIN &WRITELN(TERMINAL);SCREENLOC:=0;SECOND:=FALSE; %END; %IF SECOND THEN WRITE(TERMINAL,'/') %ELSE SECOND:=TRUE; %WRITE(TERMINAL,S);SCREENLOC:=SCREENLOC+LENGTH(S); $END; #WRITELN(TERMINAL); "END; (*/8: S:='8 inch floppies'; /9: S:='Z80 - Card'; .10: S:='6809 - Card'; .11: S:='Printer'; .12: S:='Plotter'; .13: S:='80 columns Card'; .14: S:='PAL - Coder'; .15: S:='Monitor'; .16: S:='** SPECIAL **'; %END; THEN SCREENMARG:=79 #ELSE SCREENMARG:=39; #SCREENLOC:=0;SECOND:=FALSE; #FOR I:=1 TO 16 DO $IF PLIST[I] THEN BEGIN %CASE I OF 1: S:='16K'; /2: S:='32K'; /3: S:='48K'; /4: S:='64K'; /5: S:='1 drive'; /6: S:='2 drives'; /7: S:='3 or more drives'; # #(*$I+ *) # #FOR I:=1 TO 16 DO SYSDUMMY[I]:=TRUE; #FOR I:=1 TO 8 DO LNGDUMMY[I]:=TRUE; "END; " " "PROCEDURE DECSYS(PLIST:SYSTYPE); " "VAR SECOND :BOOLEAN; &I, &SCREENLOC, &SCREENMARG:INTEGER; &S :STRING; " "BEGIN #IF PRSELECT #(*$I- *) # #RESET(DATA,FILENAME); #IF IORESULT <> 0 THEN BEGIN $WRITELN('Unable to open datafile...'); $EXIT(PROGRAM); #END; #RESET(FILEMAP,MAPNAME); #IF IORESULT <> 0 THEN BEGIN $WRITELN('Unable to open indexfile...'); $EXIT(PROGRAM); #END; %INSERTIT(NEWWORD,NAMEROOT,I); $END; #END; "END; (* Builtreename *) " " "PROCEDURE INITIALIZE; " "VAR I:INTEGER; " "BEGIN #RESET(TERMINAL,'CONSOLE:'); #PRSELECT:= FALSE;ERROR:= FALSE; #POSSIBLE:=FALSE;SCANFLAG:=FALSE; #WRITELN; # ELSE BEGIN (IF NEWWORD[8]='9' THEN BEGIN )WRITELN(CHR(7),'Duplicate Names.. '); )ERROR:=TRUE;GOODBYE;EXIT(PROGRAM); (END (ELSE NEWWORD[8]:=CHR(ORD(NEWWORD[8])+1); 'END; &UNTIL FOUNDPLACE; %END; % (* For trace: WRITELN(' INSERTWORD->',NEWWORD); *) A,I);GET(DATA); % (* For trace: WRITELN('#',I,':',DATA^.NAME); *) %NEWWORD:=CONCAT(COPY(DATA^.NAME,1,7),'0'); %UPPERCASE(NEWWORD); %IF NAMEROOT <> NIL THEN BEGIN &FOUNDPLACE:=FALSE; &REPEAT 'IF SEARCHNAME(NEWWORD,NAMEROOT)<0 THEN FOUNDPLACE:=TRUE 'witch is '); #IF PRSELECT THEN WRITELN('ON') #ELSE WRITELN('OFF'); #WRITELN('Toggle switch ?'); #REPEAT GET(KEYBOARD) UNTIL KEYBOARD^ IN ['Y','y','N','n']; "END; "IF (KEYBOARD^ IN ['Y','y']) OR (SCANFLAG) THEN BEGIN #CLOSE(TERMINAL); #PRSELECT:= NOT PRSELECT; # #(*$I- *) # #IF PRSELECT THEN BEGIN # RESET(TERMINAL,'PRINTER:'); $IF IORESULT <> 0 THEN BEGIN %PRSELECT:=FALSE;PAGE(OUTPUT); %WRITELN('>>> No printer connected to system. Press to continue'); %REPEAT GET(KEYBOARDCHANGE; " "VAR SEARCHNAME:WORDSTRING; &OLDNAME, &NEWNAME :STRING[40]; &I, &OLDNUMBER, &NEWNUMBER :INTEGER; # " #PROCEDURE EDIT(VAR A:LISTENTRY); #FORWARD; # #PROCEDURE CHECKIT(A:CHAR); # #BEGIN $IF ORD(A)=27 THEN EXIT(EDIT); #ENNTIL (KEYBOARD^ IN CHECKSET) OR (ORD(KEYBOARD^)=27); $IF (KEYBOARD^='Y') OR (KEYBOARD^='y') THEN A[I]:=TRUE; $IF (KEYBOARD^='N') OR (KEYBOARD^='n') THEN A[I]:=FALSE; $IF ORD(KEYBOARD^)=27 THEN EXIT(GETLNG); #END; "END; (* Getlng *) " " "PROCEDURE $CASE I OF 1: S:='Integer Basic'; .2: S:='Applesoft'; .3: S:='Pascal'; .4: S:='Fortran'; .5: S:='Pilot'; .6: S:='Assembler'; .7: S:='Cobol'; .8: S:='others'; $END; $GOTOXY(0,2);WRITELN(CLEAR); $GOTOXY(0,2);WRITE(S,' ?'); $REPEAT GET(KEYBOARD) U *) " # "PROCEDURE GETLNG(VAR A:LNGTYPE); # "CONST CLEAR=' '; " "VAR I :INTEGER; &S :STRING; &CHECKSET:SET OF CHAR; " "BEGIN #CHECKSET:=['Y','y','N','n',' ']; #FOR I:=1 TO 8 DO BEGIN REPEAT GET(KEYBOARD) UNTIL (KEYBOARD^ IN CHECKSET) OR (ORD(KEYBOARD^)=27); $IF (KEYBOARD^='Y') OR (KEYBOARD^='y') THEN A[I]:=TRUE; $IF (KEYBOARD^='N') OR (KEYBOARD^='n') THEN A[I]:=FALSE; $IF ORD(KEYBOARD^)=27 THEN EXIT(GETSYS); #END; "END; (* Getsyss'; .9: S:='Z80 - Card'; -10: S:='6809 - Card'; -11: S:='Printer'; -12: S:='Plotter'; -13: S:='80 columns Card'; -14: S:='PAL - Coder'; -15: S:='Monitor'; -16: S:='** SPECIAL **'; $END; $GOTOXY(0,2);WRITELN(CLEAR); $GOTOXY(0,2);WRITE(S,' ?'); $&CHECKSET:SET OF CHAR; " "BEGIN #CHECKSET:=['Y','y','N','n',' ']; #FOR I:=1 TO 16 DO BEGIN $CASE I OF 1: S:='16K'; .2: S:='32K'; .3: S:='48K'; .4: S:='64K'; .5: S:='1 drive'; .6: S:='2 drives'; .7: S:='3 or more drives'; .8: S:='8 inch floppieern not found (press )'); $REPEAT GET(KEYBOARD) UNTIL KEYBOARD^=' '; $WRITELN; #END; "END; (* Information *) " " "PROCEDURE GETSYS(VAR A:SYSTYPE); " "CONST CLEAR=' '; " "VAR I :INTEGER; &S :STRING; NAME[1])=27 THEN EXIT(INFORMATION); #END; #I:=SEARCHREC(SEARCHNAME); #IF I>0 THEN BEGIN $SEEK(DATA,I);GET(DATA); $DISPLAY(DATA^); #END #ELSE BEGIN $IF POSSIBLE THEN BEGIN %POSSIBLE:=FALSE;EXIT(INFORMATION); $END; $PAGE(OUTPUT); $WRITE('>>> Patt#PAGE(OUTPUT); #IF (POSSIBLE AND GOAHEAD) THEN SEARCHNAME:=OSEARCH #ELSE BEGIN $WRITELN('Info: (enter name or number)'); $WRITE('->......................');GOTOXY(2,1); $GETWSTRING(SEARCHNAME);UPPERCASE(SEARCHNAME); $POSSIBLE:=FALSE; $IF ORD(SEARCH" "PROCEDURE GETWSTRING(VAR INP:WORDSTRING); " "VAR PROMPT:STRING; " "BEGIN #READLN(PROMPT); #INP:=COPY(CONCAT(PROMPT,' '),1,8); "END; (* Getwstring *) " " "PROCEDURE INFORMATION; " "VAR SEARCHNAME:WORDSTRING; /I:INTEGER; " "BEGIN $OSEARCH:=S; $ (* For trace: WRITELN('SEARCHWORD->',S); *) $SV:=SEARCHNAME(S,NAMEROOT); $IF SV>0 THEN BEGIN POSSIBLE:=TRUE;FOUND:=TRUE END $ELSE FOUND:=FALSE #END; #IF NOT FOUND THEN SEARCHREC:=-1 #ELSE SEARCHREC:=SV; "END; (* Searchrec *) " &FOUND :BOOLEAN; &SV :INTEGER; " "BEGIN #IF S[1] IN ['0'..'9'] THEN BEGIN $POSSIBLE:=FALSE; $SV:=SEARCHNUM(S,NUMROOT); $IF SV>0 THEN FOUND:=TRUE $ELSE FOUND:=FALSE #END #ELSE BEGIN $IF POSSIBLE THEN S[8]:=CHR(ORD(S[8])+1) $ELSE S[8]:='0'; ) UNTIL KEYBOARD^=' '; %RESET(TERMINAL,'CONSOLE:'); $END; #END # #(*$I+ *) # #ELSE RESET(TERMINAL,'CONSOLE:'); "END; !END; (* Printerselect *) " " "FUNCTION SEARCHREC(S:WORDSTRING):INTEGER; " "VAR NUMPTR :NUMNODEPTR; &NAMEPTR:NAMENODEPTR; D; # #PROCEDURE PATCHINT(VAR A:INTEGER); " #var INS:string; 'X :integer; # $function STRtoINT (var ST:string; 7var INT:integer):integer; $var INX,LEN:integer; (SN,MN:boolean; (CH:char; (Numeric,Modifier:set of char; $ 'procedure TERMINATE; 'begin *STRtoINT:=INX; (* RETURN CODE *) *if MN then INT:=-INT; *exit (STRtoINT) 'end; $ 'procedure SEARCH; 'begin *LEN:=length(ST); *for INX:=1 to LEN do begin -CH:=ST[INX]; -if CH in Numeric then exit(SEARCH) 0else if (CH in Modifier) and (NAME[1])=27 THEN EXIT(CHANGE); #END; #I:=SEARCHREC(SEARCHNAME); #IF I>0 THEN BEGIN $SEEK(DATA,I);GET(DATA); $CLOSE(TERMINAL);RESET(TERMINAL,'CONSOLE:'); $DISPLAY(DATA^); $IF PRSELECT THEN BEGIN %CLOSE(TERMINAL);RESET(TERMINAL,'PRINTER:'); $END; $PAGE(OUTPUT); #IF (POSSIBLE AND GOAHEAD) THEN SEARCHNAME:=OSEARCH #ELSE BEGIN $WRITELN('Change: (enter name or number)'); $WRITE('->......................');GOTOXY(2,1); $GETWSTRING(SEARCHNAME);UPPERCASE(SEARCHNAME); $POSSIBLE:=FALSE; $IF ORD(SEARCH$CLR;GOTOXY(0,1);WRITELN('Peripherals'); $PATCH80(PERIPHERALS); $CLR;GOTOXY(0,1);WRITELN('Special interests'); $PATCH80(INTEREST); $CLR;GOTOXY(0,1);WRITELN('Has an Apple since (mm/yy, i.e. 09/81)'); $PATCH10(PURCHASE); #END; "END; % " "BEGIN #p>,: no change]'); $WRITELN('System configuration:'); $GETSYS(SYSTEM); $GOTOXY(0,1);WRITELN('Programming languages used:'); $GETLNG(LANGUAGES); $GOTOXY(0,0);WRITELN('Change: entry or for no change '); TOXY(0,1);WRITELN('Street'); $PATCH40(STREET); $CLR;GOTOXY(0,1);WRITELN('Town'); $PATCH40(TOWN); $CLR;GOTOXY(0,1);WRITELN('Zipcode'); $PATCH20(ZIP); $CLR;GOTOXY(0,1);WRITELN('Phone Number'); $PATCH20(TEL); $GOTOXY(0,0);WRITELN('Change: , [ for no change'); $CLR;GOTOX1,40); $END; #END; # #PROCEDURE PATCH80(VAR A:STRING); # #VAR B,C:STRING; )I:INTEGER; # #BEGIN $B:='';READLN(C); $IF LENGTH(C)>0 THEN BEGIN %CHECKIT(C[1]); %FOR I:=1 TO 80 DO B:=CONCAT(B,' '); %A:=COPY(CONCAT(C,B),1,80); $END; #END; " " CONCAT(C,B),1,20); $END; #END; # #PROCEDURE PATCH40(VAR A:STRING40); # #VAR B:STRING[40]; 'C:STRING; 'I:INTEGER; # #BEGIN $B:='';READLN(C); $IF LENGTH(C)>0 THEN BEGIN %CHECKIT(C[1]); %FOR I:=1 TO 40 DO B:=CONCAT(B,' '); %A:=COPY(CONCAT(C,B),; %A:=COPY(CONCAT(C,B),1,10); $END; #END; & #PROCEDURE PATCH20(VAR A:STRING20); # #VAR B:STRING[20]; 'C:STRING; 'I:INTEGER; # #BEGIN $B:='';READLN(C); $IF LENGTH(C)>0 THEN BEGIN %CHECKIT(C[1]); %FOR I:=1 TO 20 DO B:=CONCAT(B,' '); %A:=COPY(%X:=STRtoINT(INS,A); %IF X<=0 THEN A:=0; $END; #END; # #PROCEDURE PATCH10(VAR A:STRING10); # #VAR B:STRING[10]; 'C:STRING; 'I:INTEGER; # #BEGIN $B:='';READLN(C); $IF LENGTH(C)>0 THEN BEGIN %CHECKIT(C[1]); %FOR I:=1 TO 10 DO B:=CONCAT(B,' ')': if SN then TERMINATE ;else SN:=true; 3'-': if SN then TERMINATE ;else begin >MN:=true; >SN:=true ;end; 0end (*case*) -else TERMINATE *end; 'TERMINATE $end; # #BEGIN $READLN(INS); $IF LENGTH(INS)>0 THEN BEGIN %CHECKIT(INS[1]); :=ST[INX]; *if CH in Numeric+Modifier -then if CH in Numeric 0then begin 3if (INT<3276) 3or ((INT=3276) and (CH<'8')) 6then INT:=INT*10+ord(CH)-ord('0') 6else begin 9INT:=32767; 9INX:=-1; 9TERMINATE 6end; 3SN:=true 0end 0else case CH of 3'+INX>> Pattern not found (press )'); $REPEAT GET(KEYBOARD) UNTIL KEYBOARD^=' '; $WRITELN;EXIT(CHANGE); #END; #OLDNAME:=DATA^.NAME;OLDNUMBER:=DATA^.MNUMBER; #EDIT(DATA^); #NEWNAME:=DATA^.NAME;NEWNUMBER:=DATA^.MNUMBER; #IF NEWNAME[1]='-' THEN BEGIN $FILEMAP^[I]:=FALSE;SEEK(FILEMAP,0);PUT(FILEMAP); $SEEK(FILEMAP,0);GET(FILEMAP); $NEWNUMBER:=NEWNUMBER+1; $POS16 DO IF COMPARE[I] THEN VALID:=TRUE; #IF NOT VALID THEN EXIT(SCANSYS); #FIRST:=TRUE; #GOTOXY(0,2);WRITELN('> Searching....'); #FOR I:=1 TO MAXDATA DO $IF FILEMAP^[I] THEN BEGIN %SEEK(DATA,I);GET(DATA); %MATCH:=TRUE; %FOR J:=1 TO 16 DO &IF COMPARED; #GOTOXY(0,10);DECSYS(SYSDUMMY); #IF SCANFLAG THEN BEGIN PRINTERSELECT;SCANFLAG:=FALSE END; #GOTOXY(0,0);WRITELN('Scan for system configuration:'); #WRITELN(' -enter search keys (choose from below)'); #GETSYS(COMPARE); #VALID:=FALSE; #FOR I:=1 TO !PROCEDURE SCAN; ! !VAR CHECKSET:SET OF CHAR; ! "PROCEDURE SCANSYS; " "VAR COMPARE:SYSTYPE; *I,J:INTEGER; 'FIRST, 'VALID, 'MATCH :BOOLEAN; , "BEGIN #FOR I:=1 TO 16 DO COMPARE[I]:=FALSE; #IF PRSELECT THEN BEGIN SCANFLAG:=TRUE;PRINTERSELECT EN#GOAHEAD:=FALSE; "END; !END; (* Nextproc *) ! ! !PROCEDURE UPPERCASE; (* VAR A:WORDSTRING *) ! !VAR I:INTEGER; ! !BEGIN "FOR I:=1 TO LENGTH(S) DO #IF S[I] IN ['a'..'z'] THEN $S[I]:=CHR(ORD(S[I])-32); !END; (* Uppercase *) " " LEMAP,0);PUT(FILEMAP); "CLOSE(FILEMAP,LOCK); "GOTOXY(0,10); "WRITELN('That''s all, folks !'); !END; (* Goodbye *)   !PROCEDURE NEXTPROC; ! !BEGIN "IF POSSIBLE THEN BEGIN #GOAHEAD:=TRUE; #CASE OCMD OF 'I': INFORMATION; 0'C': CHANGE; #END; '); "GOTOXY(0,16); "WRITELN('>>> Please wait while'); "WRITELN(' building searchtrees...'); !END; (* Hello *) ! ! !PROCEDURE GOODBYE; ! !BEGIN "IF NOT ERROR THEN BEGIN #PAGE(OUTPUT);SETCHAIN('AUGEMENU'); "END; "CLOSE(DATA,LOCK); "SEEK(FI  !(* Part2 of: AUGELIST.TEXT *)  ! !PROCEDURE HELLO; ! !BEGIN "PAGE(OUTPUT);GOTOXY(0,10); "WRITELN(' IACBASE: Information Manager'); "WRITELN; "WRITELN(' copyright 1982 by frank pohlemann'); "WRITELN(' Apple User Group Europe e.V. M330N^1å2.TEXT *) ,7);NEWNAME:=COPY(NEWNAME,1,7); #IF OLDNAME <> NEWNAME THEN BEGIN $PAGE(OUTPUT);GOTOXY(0,10); $WRITELN('Member''s name was changed. '); $WRITELN(' - rebuilding primary searchtree....'); $BUILDNAME; #END; "END; (* Change *) " " " "(*$I AUGELISTSIBLE:=FALSE; #END; #SEEK(DATA,I);PUT(DATA); #IF OLDNUMBER <> NEWNUMBER THEN BEGIN $PAGE(OUTPUT);GOTOXY(0,10); $WRITELN('Member''s number was changed.'); $WRITELN(' - rebuilding secondary searchtree....'); $BUILDNUM; #END; #OLDNAME:=COPY(OLDNAME,1[J] THEN 'IF DATA^.SYSTEM[J] <> COMPARE[J] THEN MATCH:=FALSE; %IF MATCH THEN BEGIN &IF FIRST THEN BEGIN 'PAGE(OUTPUT);GOTOXY(0,2); 'WRITELN(TERMINAL,'- These persons match the following'); 'WRITELN(TERMINAL,' system setup:'); 'WRITELN(TERMINAL);DECSYS(COMPARE);WRITELN(TERMINAL); 'FIRST:=FALSE; &END; &WRITELN(TERMINAL); &WRITELN(TERMINAL,'M',DATA^.MNUMBER); &WRITELN(TERMINAL,DATA^.PRENAME); &WRITELN(TERMINAL,DATA^.NAME); %END; $END; #IF FIRST THEN WRITELN('>>> No matchTH(SRANGE)=0 THEN EXIT(SCANZIP); #IF ORD(SRANGE[1])=27 THEN EXIT(SCANZIP); #GOTOXY(0,8);WRITELN('ending ''value'' '); #READLN(ERANGE); #IF LENGTH(ERANGE)=0 THEN EXIT(SCANZIP); #IF ORD(ERANGE[1])=27 THEN EXIT(SCANZIP); #IF ERANGE No matching entries...'); "END; " "PROCEDURE SCANZIP; " "VAR SRANGE, &ERANGE :STRING; ,I:INTEGER; (FIRST:BOOLEAN; , "BEGIN #WRITELN('Scan for zipcodes in a specific range:'); #WRITELN(' -enter starting ''value'''); #READLN(SRANGE); #IF LENG'WRITELN(TERMINAL);WRITELN(TERMINAL,COMPARE);WRITELN(TERMINAL); 'FIRST:=FALSE; &END; &WRITELN(TERMINAL); &WRITELN(TERMINAL,'M',DATA^.MNUMBER); &WRITELN(TERMINAL,DATA^.PRENAME); &WRITELN(TERMINAL,DATA^.NAME); %END; $END; #IF FIRST THEN WRITELN('>>EN BEGIN %SEEK(DATA,I);GET(DATA); %IF POS(COMPARE,DATA^.INTEREST)>0 THEN BEGIN &IF FIRST THEN BEGIN 'PAGE(OUTPUT);GOTOXY(0,2); 'WRITELN(TERMINAL,'- These persons bear the following'); 'WRITELN(TERMINAL,' notice under ''INTERESTS'':'); or special interests:'); #WRITELN(' -enter search string'); #READLN(COMPARE); #IF LENGTH(COMPARE)=0 THEN EXIT(SCANINT); #IF ORD(COMPARE[1])=27 THEN EXIT(SCANINT); #WRITELN('> Searching....'); #FIRST:=TRUE; #FOR I:=1 TO MAXDATA DO $IF FILEMAP^[I] THMBER); &WRITELN(TERMINAL,DATA^.PRENAME); &WRITELN(TERMINAL,DATA^.NAME); %END; $END; #IF FIRST THEN WRITELN('>>> No matching entries...'); "END; "PROCEDURE SCANINT; " "VAR COMPARE:STRING; ,I:INTEGER; (FIRST:BOOLEAN; , "BEGIN #WRITELN('Scan f'WRITELN(TERMINAL,'- These persons bear the following'); 'WRITELN(TERMINAL,' notice under ''PERIPHERALS'':'); 'WRITELN(TERMINAL);WRITELN(TERMINAL,COMPARE);WRITELN(TERMINAL); 'FIRST:=FALSE; &END; &WRITELN(TERMINAL); &WRITELN(TERMINAL,'M',DATA^.MNU27 THEN EXIT(SCANPER); #WRITELN('> Searching....'); #FIRST:=TRUE; #FOR I:=1 TO MAXDATA DO $IF FILEMAP^[I] THEN BEGIN %SEEK(DATA,I);GET(DATA); %IF POS(COMPARE,DATA^.PERIPHERALS)>0 THEN BEGIN &IF FIRST THEN BEGIN 'PAGE(OUTPUT);GOTOXY(0,2); ; ! ! PROCEDURE SCANPER; " "VAR COMPARE:STRING; ,I:INTEGER; (FIRST:BOOLEAN; , "BEGIN #WRITELN('Scan for special peripherals:'); #WRITELN(' -enter search string'); #READLN(COMPARE); #IF LENGTH(COMPARE)=0 THEN EXIT(SCANPER); #IF ORD(COMPARE[1])=ECLNG(COMPARE);WRITELN(TERMINAL); 'FIRST:=FALSE; &END; &WRITELN(TERMINAL); &WRITELN(TERMINAL,'M',DATA^.MNUMBER); &WRITELN(TERMINAL,DATA^.PRENAME); &WRITELN(TERMINAL,DATA^.NAME); %END; $END; #IF FIRST THEN WRITELN('>>> No matching entries.'); "END'IF DATA^.LANGUAGES[J] <> COMPARE[J] THEN MATCH:=FALSE; %IF MATCH THEN BEGIN &IF FIRST THEN BEGIN 'PAGE(OUTPUT);GOTOXY(0,2); 'WRITELN(TERMINAL,'- These persons use the following'); 'WRITELN(TERMINAL,' programming languages:'); 'WRITELN(TERMINAL);DD:=TRUE; #IF NOT VALID THEN EXIT(SCANLNG); #FIRST:=TRUE; #GOTOXY(0,2);WRITELN('> Searching....'); #FOR I:=1 TO MAXDATA DO $IF FILEMAP^[I] THEN BEGIN %SEEK(DATA,I);GET(DATA); %MATCH:=TRUE; %FOR J:=1 TO 8 DO &IF COMPARE[J] THEN UMMY); #IF SCANFLAG THEN BEGIN PRINTERSELECT;SCANFLAG:=FALSE END; #GOTOXY(0,0);WRITELN('Scan for programming languages:'); #WRITELN(' -enter search keys (choose from below)'); #GETLNG(COMPARE); #VALID:=FALSE; #FOR I:=1 TO 8 DO IF COMPARE[I] THEN VALIing entries.'); "END; "PROCEDURE SCANLNG; " "VAR COMPARE:LNGTYPE; *I,J:INTEGER; 'FIRST, 'VALID, 'MATCH :BOOLEAN; , "BEGIN #FOR I:=1 TO 8 DO COMPARE[I]:=FALSE; #IF PRSELECT THEN BEGIN SCANFLAG:=TRUE;PRINTERSELECT END; #GOTOXY(0,10);DECLNG(LNGDWRITELN('>>> String comparison not possible'); $EXIT(SCANZIP); #END; #WRITELN('> Searching....'); #FIRST:=TRUE; #FOR I:=1 TO MAXDATA DO $IF FILEMAP^[I] THEN BEGIN %SEEK(DATA,I);GET(DATA); %IF SRANGE<=DATA^.ZIP THEN &IF ERANGE>=DATA^.ZIP THEN BEGIN 'IF FIRST THEN BEGIN (PAGE(OUTPUT);GOTOXY(0,2); (WRITELN(TERMINAL,'- These entries have got zipcodes in the'); (WRITELN(TERMINAL,' range from ',SRANGE); (WRITELN(TERMINAL,' to ',ERANGE); (WRITELN(TERM!BUILDNAME; !MENU; !GOODBYE;  END.  !BUILDNAME; !MENU; !GOODBYE;  END.  il exit through 'Q' *) !END; (* Menu *) ! ! ! !  BEGIN (* Main program *) !INITIALIZE; !HELLO; !BUILDNUM; !BUILDNAME; !MENU; !GOODBYE;  END.  MPT:=CHR(ORD(KEYBOARD^)-32) $ELSE PROMPT:=KEYBOARD^; $CASE PROMPT OF 'I': BEGIN INFORMATION;OCMD:=PROMPT END; 3'C': BEGIN CHANGE;OCMD:=PROMPT END; 3'N': NEXTPROC; 3'P': PRINTERSELECT; 3'S': SCAN; 3'Q': EXIT(MENU); $END; #END; "UNTIL FALSE; (* Unt"COMMANDLIST:=['I','i','C','c','N','n','P','p','S','s','Q','q']; "REPEAT #GOTOXY(0,0); #WRITE('> I)nfo C)hnge N)ext P)rnt S)can Q)uit'); #GET(KEYBOARD); #IF NOT (KEYBOARD^ IN COMMANDLIST) THEN PAGE(OUTPUT) #ELSE BEGIN $IF ORD(KEYBOARD^)>96 THEN PRO"CASE KEYBOARD^ OF 'S': SCANSYS; 4'L': SCANLNG; 4'P': SCANPER; 4'I': SCANINT; 4'Z': SCANZIP; "END; !END; (* Scan *) ! " !PROCEDURE MENU; ! !VAR COMMANDLIST:SET OF CHAR; *PROMPT:CHAR; * !BEGIN T:=['S','s','L','l','P','p','I','i','Z','z','N','n']; "PAGE(OUTPUT); "WRITE('Scan: S)ys L)ng P)er I)nt Z)ip N)one'); "REPEAT GET(KEYBOARD) UNTIL KEYBOARD^ IN CHECKSET; "IF KEYBOARD^ IN ['a'..'z'] THEN KEYBOARD^:=CHR(ORD(KEYBOARD^)-32); "PAGE(OUTPUT); INAL); (FIRST:=FALSE; 'END; 'WRITELN(TERMINAL); 'WRITELN(TERMINAL,'M',DATA^.MNUMBER); 'WRITELN(TERMINAL,DATA^.PRENAME); 'WRITELN(TERMINAL,DATA^.NAME); &END; $END; #IF FIRST THEN WRITELN('>>> No matching entries...'); "END; ' # !BEGIN "CHECKSE