-not a Macintosh disk-DPi`KJDBH@%) [UNP"N,L 8!"@$|Gn"`I N.@A,H<( F<B<H111.Bx<kNNF`, 8! "NH@"|J(g g`LNu"_ |a||a0@||9݁g|w|a||NH瀀 |(_@"g2<@gBA?N`Fa`||aPLNu  fBR$N"NBH@&|݁ |B$<0HN~NL@dBgg>N&|)`RNuBBBA*2h/ BBB N _"_$_"H&|݁ |B$<0NNd 0<`L$|J HA H  2I<FFI<<FFfHHFFfHHH?B@L"_2N _0H 2<@I6@o Az:<2`6@oJA~:<26" @n2BDBB(`EB@nAJEkz`z2<HAIL0.NL0.N  / p? O@ 0  0  XO _,_2_!.NBBB/ BBBN08 @ gNu@ f"_E!NH\O/ ?`@&x|N _!@"|xEz En"`CE"|xN"Ҹ< A  33"|@E E4n"`C&E"|@.N _LHNFLN*8&E@<<'CJJKK f`  f `><$CS*<FF4>BRIBC Gff&<CBSC`D GnKG45BQf` f `Ns |0< BXHQ!4 _$_"_!XOHH/8/ $ f0<? QN ! N.x $_$ g ! N.x !C !!LLyp!N\OFN  l0P߀ Aǀ`  6lo6@ 0_an*>]> j 56, l602  ۰Poo A` &ll6p@ 0?۷a?^ ꭕ 5o6, l602 8!ED91kE"0369? CoNGNOS BOOT FAILED TRY A NEWER MACHINE AND BOOT PROM _"_NN/A lNNu _.NHL$ orD?|?@?e\SFk!!QSWk:CL<HL|hH>L|4H>L|H>SWjTO>SGk\!Q`TSFk QSWk8L|H|L|H|4L|H|hL|H|LSGkQLx _O NNVH8=| f=|G* G, &N(N n"n$n 0.  S@ZeJ S@BBDBG S@gg.BC CJDg720faL`fa:` 320f8<S@`JDg  fa$` fa`  U@o$SBjt`(N&N><`JGg (Ev#$#$QNukJDg`g 3$f(N`BnLN^ _NUNPACK H>8$O&j.(j4,*8:*,BB6*2SCCn`8CL0@D@04"F K0HEY@2< Vb,g`aJaBVgbHE6SCCo`p`HE4RBCo8B@ j(0 j$L| _pN am znNu _"_$_$0H2< @`Q`BQBNNV;n *N^.NuEVINIT NVH,. ^J]g n0`4B?N. f n0`/.//. /.N6(n)FLN^ _NEAD_BLONV/ (n Jno./.?././ /.Nj nJPg`RSn`(_N^ _NEAD_SEQHNT"|E.|r |BBByBygRBf~NuLHPPNqNqpS_n.0<QLHPPNqNqpS_n|~By&JM*Np|azJGfb|a|,Mpa`JGfH|a<<AaJGf0Avtp BQvr BQH@02N\LhL"4NtB@6Kd a"JDf`02IP g a JDf`Nub SBg pxNuBDNu><Nu4< vB@bp2IPSCfSBfNuppB@(4<dBC(4< CBC(C"H4<BACSBf(CAg><NuJoNV?-,N.H|)?NN^ _TONRAP NV.HgVS@g`J.f& -`мS//<N/<NB+_`-m` . ѭ` -`o<Np`B . \J.f/-\/<N4/<N+_\-m\ -\l<N,N^ _PONGETSPACNV .мS//<N/<N-_ .=@ N^.NuINDSPARNVH.. Bg/N0Hހ m0.@I/./<N 8//<Np @n ?.Bg?<BgNLN^ _ NETMMU NVH+| d+|l+|(+||+|+|t+|(|;TV(|;T|(|.;Tz&| n!SLN^.NuETVARS NVH/Nt;| .䐼/+@ .м/м+@+|`*<(< E"D +@\&|?-|0-VS?NHnHmJNJngp+@JBBg/-BgNz+_ -Э+@XBB<0<H/BgNPN+_P+mPBG` m @I G~V GTVgd Gl|p@ @8`$ Gf|p@BT`| p@BT H< @"@=A?.??<BgNRG Gox mI|p@BT mIP|p@/-P/<N* 8LN^NuOOTINITNVH(nB BgNBgNHH,BgN0HѬ f,/, N"BgNBgNHH,BgN0HѬ f,/, NBgNrBgNjHH,BgN0HѬ f:Jf< N/, NBgN2BgN*HH,BgNb0HѬ g<NLBN,BN+_ n/BN|  _r Ё0p//-`N/-/-`N&m`:=E E0o<N0<H+@l+| -lЭd n2HҀ -Ё"-Ҁ(Bg Э/N0Hѭ -Є+@B</-BgN+_+mh -dЭh+@p -lЭp, n0HІ+@ -Э+@ -Э+@?<f/-/-?<Nb-m/ /./-N n LN^ _ NUILD_SYNVH(nBGBF. gB `P-n n0. PoB."` n0. A-H&n/+/<N  n0>+<+/, NBgN<BgN4HH-@BgNj0H(٬ JVJ_gB."`4JGW WJGV WgJFf n `H n n/B."n/BgN2  _ BNB-_JGf n Q/ n P/Nr` Q@H/ n P/NZ|B. n=h-nA-H n-P/./.p/N JGgR-mBg n/( n r Ё/ n P/ nP/ | ? Q@?N9_Jlg< N, nQ f|"LN^ _NOADSEG NVHBBg/-tBgN+_x -x"-Ҁ+At(|`p}//<Nn -Пx((|p}//<NN -Пx(?<}/-x/-t?<N&|BSLN^.NuLLOC_SCNVHAC 0BgHnNz_m+m-gBBg/-BgNP+_`+m-gBBg/<BgN, м,BgBgBHnBgHnHnBg/.N g<NACD 0BgHnN  g B-n`.BgBgBHnBgHnHnBg/.Nx g<Nf .@+@ -Э+@` B -@+@ -м@+@?</-/-?<N@ <逐.JfB` .ЇP-@JfB` .ЇP-@-g -Ї/ -Ї//./.N`/-/-BBN(|p((|t(LN^.NuOAD_DEB SYSTEM.DEBUG2 SYSTEM.DEBUGNVH nCJp"S@n2&n (nBBgHnN dgZB /, N NBgN BgN HH(BgN0H* f&.B</BgN&B /, N //NlLN^ _ NOAD_UNPNVBgBgBHn</. /.Bg/.N g<NN^ _ NOAD_LLDNVH(n 0-N|>Jg,, .* Ю(H//<N( Д-@`,.(.H//<N-_?//?<N. .P/NdLN^ _NNSTALL_NVH(n=n ~`/, N BgN p_BgN fHH(BgN 0H-@Jg .Ѭ `<N~ .fBN (BN ( GfAB0pB5pB`ACZ 0z`BgN _ .ARE EoHn?<?<HnNAC 0HnHzNg(AB0pp @AB @AB`2HnHzNPgAB0pB5pB`App| 5pgnBg?/.Hn @AHp @AHp</.NX g<NF?. @A/0 @A"0Ҽ/?<NHRGinoLLN^ _ NOADCODEkrni NVBBg/-BgN+_?<e/-/-?<NN^.NuAKESUPSNVH(m . R A T&@-kLN^ _ NINDMAINNVBg/-NF0HѭB</-BgNx+_?<g/-/-?<N\Bg/-|N 0Hѭ|B</-|BgN>+_?<{/-/-|?<N"N^.NuLLOC_OPNV A0C ArC 0AC 0/NLHnHm/NFBgHn0N g< NHnHn/NBgHnrN g<N^/NZBg/.Hn$/N;_N/./.Hm/N-UgNj/.$?-N/N@/N2 n /B/.$0-NH//NR  _ /NBNj+_N^ _PONOADSYS $ SYSTEM.UNPACK SYSTEM.OS SYSTEM.LLDN :NV,_NUvN ,+|v mv PVD@UNHmHmNHm?- -|Э//-NzNZN N]N NuN^NuOADER NVHAv(HA^&HHn?-.0-0H".Ҁ// / NrJng<NLN^.NuEAD_PAGNV0.HBH"-DҀ-A0.HBH@J@=@/.NvAv0.HЈ-@ N^ _TONIND_SENNVBH nCJp"S@n2 n BBgA/A/Nz-m2Av(H&L U.=m6B|`A^-HHAv(BE`:HnN?-.0-0H".ҀH҅///.HNhؼJnNg<NRE Eom6l^Bn So4 X/ U/0S@?A/?<$Hn/. N n gRn G0.D@@20HҌ-A n-P`/ /?A/?<$Hn/. NRFinBo$ n g< G0.D@@20HҌ-A/.HnP?<NN n/B?.vN4  _ LN^ _ ND_SEARCNVH n-h .S/0-:H/N ;@Z-n p+@V;m:\BF` AvIBBlRF Fo=mHnNBgHn?->N>H/p6/NNZBp6/A/NACp S@n0HnN^J.gHHnHnN .Wgz n/B?.N  _ `SFRGm>fBGBNJFfELN^ _PONOOKUP_ENVH.<A"G";n .;m.,?.?-.N;n0BN&Av(HJg<NH;l~:+lD;lB;l>;l@;l<;T8;l26+l.2 2f<N m8lB?,N&_+SH+kL+kPLN^.NuNITMEDINV m8lBg/.HnN2_`/.HnHnNn .gB/.N-_N^.NuPENINPUNVH(.BGBF Go<NR Av:0JEf<N8 EHl@ AvH"Ұ n n Jf<NHH " n ``RGE`LN^ _ NIND_POSNV-mV/.0-:H/N+_VJV]2-ZHV]g<N0-:H/-V/N2 .;@\ -Vg/-VHnHnN/.N"N^.NuILLBUF NV0-\m:f -VR2-:H//NNT0-\AvpRm\N^NuETBYTE NVHBgNHH<BgNH>JGl H м> G=@LN^NuETWORD NVHBgN0H//<ND,BgN0H.Jl޼ Ї-@LN^NuETLONG NVH,. 0-:m\>HǼl>JGo0-\AvA//.H/NH߮Hǜm\0-:HnJV]2-ZHV]g<N -VR/HnHnNn-nA^(H/0-:H/N*l-EJoZHn?-.0-0H".Ҁ/?././ NjJng<N~0-:H/./N(ٮ .Ѯ .ѭV`:Jo -VR2-:H//NNhJfLN^ _PONOVEMULTNVH(n0,k @nH0;N *6BN\BgHlN_`n/,N`dBgN_`XBgN9_`LBN)_`@/,/,N:`2&l.,/ ?-.0-0H", Ҁ/?,/ /NP`<NhLN^.NuRIVER_C//0/2/ AH@B@2/Ё/@" /WXNuNV// /"/N:/A" N^/WXNuNV// /"/N/@" N^/WXNuH>*jD,jD$HBJBf6B@H@g4HB04"B@H@`$&BBxԂрҁmRQJjDjDL|NuNuNuJoNu$_0 _"_J @o4$ Tg,2ABAgSBgS@2@ISA QS@kQN$_0 _"_J`!QN$_02 _`QNHBB oJ0/2/gk gRBSAn` R gSBRAk?B/oL\NuHBB oJ0/2/gk fRBSAn` R fSBRAk?B/oL\NuHr`HBA oJ"oJB@f`fQ AA/oL\NuH"o J oJv`:H"o J oJBC`&H o J"oJv`H o J"oJBCB@BA@m4`4`fQ@n C`cC"/oL\NuH0/ oC"4JBAR`$aJBBB`QQ oC"0/H#//IL._NuH oJB@BA"o JBBBlBA`$HR` fQ`RS@`?A"/oL\NuH o0/2/SA"o JBBA@m`Q/o L NuB`$_02 _ @o0 Ao*BBAm"6@SCBoSA`@"H`RCoN$_0"_ _J/ S@m*BABB@m6B$I”@`!Q`QNuG5TK4̆V{tITOR.OBJ̆^Hg :a$&kT%k:)$ "#." #"##%& ! , M Q U Y _c0{ ((#t]aeiqX  !@"#$% &t'/ 05192A $F.1 .1m$*Ask.TEXTLLo$*AskDir.TEXTLםL $*Install.TEXTLYZ$*Other Files.TEXTN]].8$MBOXER.TEXT YHh$MCB2SAMPLE.TEXTպH$MCLOCK.TEXT}H$MKEYBOARD.TEXTYGw$MREADER.TEXT.:$PBOXER.TEXT GL $PCB2SAMPLE.TEXT$hH@$PCLOCK.TEXT(.?$PKEYBOARD.TEXTZ2g.I$PREADER.TEXT"(37? $UBOXER.TEXT 1PeT00$UBOXER.TEXT 1PeT00$UBOXER.TEXT 1PeT00$UCLOCK.TEXT~؝H$UCLOCK2.TEXT~~TIXX$UKEYBOARD.TEXT2gT$UKEYBOARD2.TEXT2sT@@$UPALETTE.TEXT1ZATa(($UREADER.TEXT T $UREADER2.TEXT!yfCltt$UTIMER.TEXTcbH $XBOXER.TEXT /Hc$XCB2SAMPLE.TEXTH7$XCLOCK.TEXT7p$XKEYBOARD.TEXT.IHFD.TEXTnFNNNNNNNN(*Other Files.TEXTTEXTt.TEXT~]3]]NV n  M *Install.TEXTTEXTxSn`N^ _PONН]4L_YZNV n  Q *Ask.TEXTTEXT. . ̎]5LLoNV n  U *AskDir.TEXTTEXT. . ̎]6LםLNV n  Y MBOXER.TEXTTEXT. . ̎]7YHhNV n  _ UBOXER.TEXTTEXTxSn`N^ _PONН]81PeĝTNV n  c UBOXER2.TEXTTEXTxSn`N^ _PONН]93A͝TGNV n n {n PBOXER.TEXTTEXT. . ̎]: ӝGLNV n   XBOXER.TEXTTEXT. . ̎];/؝HcNV n   UPALETTE.TEXTTEXTxSn`N^ _PONН]<1ZAݝTaNV n  MCB2SAMPLE.TEXTTEXT. . ̎]=պHNV n  UCB2SAMPLE.TEXTTEXTn`N^ _PONН]>%>1NV n  UCB2SAMPLE2.TEXTTEXT`N^ _PONН]?HTNV n : #:PCB2SAMPLE.TEXTTEXT. . ̎]@$hH@4"NV n  ]XCB2SAMPLE.TEXTTEXT. . ̎]AH7NV n  a MCLOCK.TEXTTEXT. . ̎]B}HNV n  e UCLOCK.TEXTTEXTxSn`N^ _PONН]C~؝HNV n  i UCLOCK2.TEXTTEXTxSn`N^ _PONН]D~~ TIUNV n , q, PCLOCK.TEXTTEXT. . ̎]E(.?NV n   XCLOCK.TEXTTEXT. . ̎]F7pNV n   UTIMER.TEXTTEXTxSn`N^ _PONН]GcbHNV n  MKEYBOARD.TEXTTEXT. . ̎]HYGwNV n  UKEYBOARD.TEXTTEXTSn`N^ _PONН]I2g$TNV n   UKEYBOARD2.TEXTTEXTn`N^ _PONН]J2s*TNV n   PKEYBOARD.TEXTTEXT. . ̎]KZ2g0.INV n  XKEYBOARD.TEXTTEXT. . ̎]L.I4HNV n   MREADER.TEXTTEXT. . ̎]M9.:NV n   UREADER.TEXTTEXTxSn`N^ _PONН]N@TNV n   UREADER2.TEXTTEXTxSn`N^ _PONН]OyfFClXfNV n : : PREADER.TEXTTEXT. . ̎]P(3M7?NV n  /$UBOXER2.TEXT 3AT$UCB2SAMPLE.TEXT%>1(($UCB2SAMPLE2.TEXTHtt$UCLOCK.TEXT~؝H$UCLOCK2.TEXT~~TIXX$UICONREF.TEXT$' Gl$UICONREF2.TEXT% $UKEYBOARD.TEXT2gT$UKEYBOARD2.TEXT2sT@@$UPALETTE.TEXT1ZATa(($UREADER.TEXT T $UREADER2.TEXT!yfCltt$UTIMER.TEXTcbH $XBOXER.TEXT /Hc$XCB2SAMPLE.TEXTH7$XCLOCK.TEXT7p$XKEYBOARD.TEXT.IH$XREADER.TEXT#-zH$XREADER.TEXT#-zH$PEXAMPLE.OBJLQƥQƼBg4$PGENERIC.TEXTdϜn$PKEYBOARD.TEXTdZ2g.In$PMC.TEXTd󜈉 n$preader.TEXTd(37? n$PRECIPES.TEXTd/ n$PSAMDIALOG.TEXTd1-yn$PSAMPLE.TEXTd&H#n$PRECIPES.TEXTd/ n$PSAMDIALOG.TEXTd1-yn$PSAMPLE.TEXTd&H#nFFD.TEXTnF@@@@@@@@$($UBOXER2.TEXT$MRESOURCE.TEXTU$uoldresource.TEXTy${D109T5}$R)${D127T1}K${D164T4}m${F173}$BUILD/MAKE/CTKLIB.TEXTv$libtk/UDRAW.TEXT$ufixutext.OBJ$MWRITERESFILE.OBJ$XWRITERESFILE.text$MACFORTH.TEXT$m8boxer.texty$MSAMRULER.TEXT$PSAMRULER.TEXT$twotext.TEXT>$UCLOCK2.TEXTQ$URULER.TEXT$x6boxer.text $ example/edit.OBJu$ Intrfc/Graf3D.Text$ Obj/QuickDraw.Obj$ Serial/PipeImpl.Text$ callpas.obj$ TKALERT.TEXT$ USCRAPIO.TEXT~$ MD/GE.68K.TEXT$ MD/RULERFONT$TERMBUGA.TEXT$B/KEYS.TEXT$work/Ascii.TEXT1$work/Terminal.TEXT$DEHEXIFY.TEXTS$T/TALLY.TEXT~$Obj/MacPrint.Obj$v.TEXTw$t.TEXTƜ$xref.help.textay|$xref.OBJ`zؚzz.8${T11}buttons#${T11}obj*{(${T11}PHRASEsX)*(jjxP(`8pH X0h@xP(, XREADER.TEXTTEXT. . ̎]Q-zSHNV n  5 UICONREF.TEXTTEXTxSn`N^ _PONН]R' YGlNV n  9UICONREF2.TEXTTEXTSn`N^ _PONН]S]UNV n  A*install..TEXT..TEXT _NV n  Q*install..TEXT..TEXT _geNV n  U3. "6F^9. D!$ǐ^eKCdon't change the opening rectangle 3. "6F^; This is a file of info for building the Recipes program ; ;First is the tool number and tool volume (the tool volume defaults to the prefix volume) 200 ; ;There are no files that need to be assembled $ ; ;There are no building blocks/other units that need to be compile $ ;Link in UFixUText and map its segments UFixUText +M FixText1 +M FixText2 $ ;Install parameters (handles documents; more than 1 doc; change open rect) Y Y Y 0 40 720 330 Recipe $ This line will end the input to the InstallTool program. URECIPES2.TEXTTEXT. . ̔PHiKO+KOJNV n  Y:  EXEC(sample) SET sample TO UPPERCASE(sample) IF sample='BOXER' THEN $RETURN 'UPALETTE=.TEXT' ENDIF IF sample='CLOCK' THEN $RETURN 'UTIMER=.TEXT' ENDIF IF sample='READER' THEN $RETURN 'UICONREF=.TEXT' ENDIF RETURN '' ENDEXEC 3. "6F^9DED!$ǐ^ $$BYY̛R6 TD$EXEC(sample,dir,others) $ $CLEAR SCREEN $ F{} $ $ { Ask about each sample program on the diskette } $RESETCAT '-LOWER-X=.TEXT' $REPEAT $$WRITELN $$SET sample TO UPPERCASE(NEXTFILE) $$IF sample <> '' THEN ($SET sample TO COPY(sample,2,POS('.',sample)-2) ($IF <-LOWER-*Ask(Do you want to install U[sample]?,Y) = 'Y' THEN ,$SET dir TO <-LOWER-*AskDir(Where do you want to put U[sample]?) ,B{}-LOWER-M[sample].TEXT,[dir]$ ,B{}-LOWER-U[sample]=.TEXT,[dir]$ ,Y{} ,B{}-LOWER-P[sample].TEXT,[dir]$ ,B{}-LOWER-X[sample].TEXT,[dir]$ ,$ ,$SET others TO <-LOWER-*Other Files([sample]) ,$IF others <> '' THEN 0B{}-LOWER-[others],[dir]$ 0$IF POS('=',others) <> '0' THEN 4Y 0$ENDIF ,$ENDIF ($ENDIF $$ENDIF $UNTIL sample = '' $ Q{} $ $DOIT $WriteLn 'Installation Completed.' $ENDEXEC 3. "6F^9EXD!$ǐ^lLne default answer. (b+pJ̫̑xv̐pJ@̫̫̐p(bEXEC(prompt,default,ln,temp) ${ Ask the user the yes/no question, prompt, giving default as the default answer. &Returns 'Y' or 'N'. } SET default TO COPY(UPPERCASE(default),1,1) IF (default <> 'Y') AND (default <> 'N') THEN $SET default TO '' ENDIF SET ln TO '' WHILE ln = '' DO $IF default <> '' THEN (SET temp TO CONCAT(' [', default, ']') $ELSE (SET temp TO '' $ENDIF $SET temp TO "[prompt] (Y or N)[temp] " $REQUEST ln WITH temp $SET ln TO TRIMBLANKS(ln) $IF ln = '' THEN (SET ln to default $ENDIF $SET ln TO UPPERCASE(ln) $IF (ln <> 'Y') AND (ln <> 'N') THEN (SET ln TO '' $ENDIF ENDWHILE RETURN ln ENDEXEC 3. "6F^9n)D!$ǐ^  nL-' THEN (SET ln TO "[ln]-" $ELSEIF (ln = '#PREFIX') OR (ln = '-#PREFIX') THEN (SET ln TO '' $ELSEIF(f.}pJ̫̑xv̐pJ@̫̫̐pSE ,S(f.}pJ̑R̢P̑xv̐FFFpp̫.FPFP\̑N̐ÆFFxpJ@̫-̫ĀZ̢PxFPF̑N̫̐FFxFF.@ppJŊ̫-̫EXEC(prompt,ln,temp,default) ({ Given a prompt such as 'Enter directory to which to copy sources', this ,exec file returns a directory as '--' or '' (means the prefix volume); ,the that is entered is used as the default the next time this is run. } ${ Set up the prompt string & default (if any) } RESET COMMBUFR, 'TK Install' READLN (COMMBUFR) default IF (default <> '') AND (default <> 'EOF') THEN $SET temp TO CONCAT('[', default, ']') ELSE $SET temp TO '[prefix volume]' $SET default TO '' ENDIF SET prompt TO "[prompt] [temp] " WHILE TRUE DO $REQUEST ln WITH prompt $SET ln TO UPPERCASE(TRIMBLANKS(ln)) ({ Put the input into the proper form } $IF (ln = '#PREFIX') OR (ln = '-#PREFIX') THEN (SET ln TO '' $ELSEIF COPY(ln,1,1)='-' THEN (SET ln TO "[ln]-" $ELSEIF ln = '' THEN (IF default <> '' THEN ,SET ln TO "-[default]-" (ELSE ,SET ln TO '' (ENDIF $ELSE (SET ln TO "-[ln]-" $ENDIF +{ ln now is of the form '--' or ''} $IF temp = '' THEN (RETURN temp $ENDIF $SET temp TO COPY(ln,1,Length(ln)-1) $IF Exists(temp) THEN (REWRITE COMMBUFR, 'TK Install' (WRITELN (COMMBUFR) COPY(ln,2,Length(ln)-2) (RETURN ln $ENDIF $WRITELN "The directory '[temp]' does not exist." ENDWHILE ENDEXEC 3. "6F^9erD!$ǐ^  eHgdon't change the opening rectangle n}; NT; T; URE TSketchSelection. MouseRelease;} (END; $TRecolorCmd = SUBCLASS OF TCommand &{Variables} (newColor: TColor; {when the commaPROGRAM MBoxer; USES ${$U UObject } UObject, ${$U QuickDraw } QuickDraw, ${$U UDraw } UDraw, ${$U UABC } UABC, ${$U UUnivText } UTKUniversalText, ${$U UText } UText, ${$U UDialog } UDialog, ${$U UPalette } UPalette, ${$U UBoxer } UBoxer; CONST $phraseVersion = 1; BEGIN $process := TBoxProcess.CREATE(NIL, mainHeap); $process.Commence(phraseVersion); $process.Run; $process.Complete(TRUE); END. 3. "6F^9XTD!$ǐ^ΝTX.T:̟'T #̟H:!$'T #$UBOXER.oo.ʠʨp1PeS00 bdd X"jLxx̦\ 6ZÆd 6 6̦\F̡DTRàØZNZøO`O`XX0T${LisaBoxer: a box-drawing application for the Tool Kit} ${Copyright 1983, 1984, Apple Computer Inc.} {$E ERRORS.TEXT} {$E+} {go into the editor automagically} UNIT UBoxer; INTERFACE USES ${$U UObject} UObject, ${$U QuickDraw} QuickDraw, ${$U UDraw} UDraw, ${$U UABC} UABC, ${$U UUnivText} UTKUniversalText, ${$U UText} UText, ${$U UDialog} UDialog, ${$U UPalette} UPalette; {UPalette.OBJ must be on prefix volume} CONST "{Codes to represent box colors} $colorFirst = 1; $colorWhite = 1; $colorLtGray = 2; $colorGray = 3; $colorDkGray = 4; $colorBlack = 5; $colorLast = 5; "{Application-specific command numbers} $uWhite = 1006; $uLtGray = 1007; $uGray = 1008; $uDkGray = 1009; $uBlack = 1010; $uShades = 1011; $uOKShades = 1012; $uFront = 1020; $uBack = 1021; $uDuplicate = 1050; $uCreateBox = 2000; $uMoveBoxes = 2001; $uSplitH = 5000; $uSplitV = 5001; $uRemHSplit = 5002; $uRemVSplit = 5003; $uRemAllSplit = 5004; $uSaveSplits = 5005; "{Selection kinds} $pickKind = 1; $unPickKind = 2; $sketchKind = 3; $areaKind = 4; "{Alert numbers} $phMustClick = 1001; $phNoSplit = 1002; $phWhite = 3301; $phLightGray = 3302; $phGray = 3303; $phDarkGray = 3304; $phBlack = 3305; "{ dimensions of a box in palette } $palWidth = 36; $palHeight = 24; "{ distance between edge of palette box and the prototype box } $hPalMargin = 6; $vPalMargin = 4; "{ row numbers in action palette } $symArrow = 1; $symBox = 2; "{ amount to offset on a duplicate } $hDupOffset = 9; $vDupOffset = 6; $mnuTypeStyle = 101; TYPE $TColor = colorFirst..colorLast; {color of a box} "{New Classes for this Application} $TBox = SUBCLASS OF TObject ({Variables} (shapeLRect: LRect; (color: TColor; (isSelected: BOOLEAN; (wasSelected: BOOLEAN; &{Creation/Destruction} (FUNCTION {TBox.}CREATE(object: TObject; itsHeap: THeap; itsShape: LRect; itsColor: TColor): TBox; &{Display} (PROCEDURE {TBox.}Draw; (PROCEDURE {TBox.}Highlight(highTransit: THighTransit); (PROCEDURE {TBox.}InvalInTheView(view: TView); (PROCEDURE {TBox.}Outline; &{Enumerate Handles} (PROCEDURE {TBox.}EachHandleRect(PROCEDURE DoToHandle(hRect: Rect)); (END; "{Subclasses of Generic Classes} $TBoxProcess = SUBCLASS OF TProcess &{Creation/Destruction} (FUNCTION {TBoxProcess.}CREATE(object: TObject; itsHeap: THeap): TBoxProcess; '{PROCEDURE TBoxProcess. Commence(phraseVersion: INTEGER);} '{FUNCTION TBoxProcess. NewDocManager(volumePrefix: TFilePath; openAsTool: BOOLEAN): TDocManager;} (END; $TBoxDocManager = SUBCLASS OF TDocManager &{Creation/Destruction} (FUNCTION {TBoxDocManager.}CREATE(object: TObject; itsHeap: THeap; itsPathPrefix: TFilePath) ?: TBoxDocManager; '{FUNCTION TBoxDocManager. NewWindow(heap: THeap; wmgrID: TWindowID): TWindow;} (END; $TBoxWindow = SUBCLASS OF TWindow &{Variables} (actions: TPanel; (boxes: TPanel; &{Creation/Destruction} (FUNCTION {TBoxWindow.}CREATE(object: TObject; itsHeap: THeap; itsWmgrID: TWindowID): TBoxWindow; &{Document Creation} '{PROCEDURE TBoxWindow. BlankStationery;} &{Menus} '{FUNCTION TBoxWindow. CanDoCommand(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN;} &{Commands} '{FUNCTION TBoxWindow. NewCommand(cmdNumber: TCmdNumber): TCommand;} (PROCEDURE {TBoxWindow.}SelectAll; &{Actions Palette} (PROCEDURE {TBoxWindow.}SetAction(action: INTEGER; doHilite: BOOLEAN); &{Dialogs} '{PROCEDURE TBoxWindow. PutUpDialogBox(dialogBox: TDialogBox);} '{PROCEDURE TBoxWindow. TakeDownDialogBox;} (END; "{Palette subclasses} $TActView = SUBCLASS OF TPalView &{Variables} (palBox: TBox; {same TBox as in the TBoxView} &{Creation/Destruction} (FUNCTION {TActView.}CREATE(object: TObject; itsHeap: THeap; itsPanel: TPanel; itsPalBox: TBox) ;: TActView; &{Display} '{PROCEDURE TActView. DrawSymbol(atCol, atRow: INTEGER;} '{PROCEDURE TPalView. ChangedSelection(atCol, atRow: INTEGER);} &{Mouse Tracking} '{PROCEDURE TActView. MouseRelease;} (END; $TBoxView = SUBCLASS OF TView &{Variables} (boxList: TList; (palBox: TBox; {same TBox as in the TActView} (doingMove: BOOLEAN;{TRUE iff we are moving boxes, so that we do not draw the selected boxes, @but only outline them.} &{Creation/Destruction} (FUNCTION {TBoxView.}CREATE(object: TObject; itsHeap: THeap; itsPanel: TPanel; itsExtent: LRect; AitsPalBox: TBox; itsBoxList: TList): TBoxView; &{Display} '{PROCEDURE TBoxView. Draw;} (PROCEDURE {TBoxView.}InvalBounds(bounds: LRect; isSelected: BOOLEAN); (PROCEDURE {TBoxView.}ToggleHighlight(box: TBox); &{Mouse Tracking} (FUNCTION {TBoxView.}BoxWith(LPt: LPoint): TBox; '{FUNCTION TBoxView. CursorAt(mouseLPt: LPoint): TCursorNumber;} '{FUNCTION TBoxView. MousePress(mouseLPt: LPoint): BOOLEAN;} &{Filtering} '{PROCEDURE TBoxView. EachActualPart(PROCEDURE DoToBox(obj: TObject));} &{Utility} (PROCEDURE {TBoxView.}FixLRectDelta(bounds: LRect; VAR deltaLPt: LPoint); @{considers the LRect formed by offsetting bounds by deltaLPt, and Dchanges deltaLPt so that the resulting LRect lies within the Dview's extentLRect} (END; ${ selection classes: (The panel will ALWAYS contain a TPickSelection, except when in the process of ,creating a new box. The kind of the selection will be nothingKind iff the ,boundLRect is empty; unPickKind if the user just de-selected a box by shift ,clicking; otherwise, pickKind.} $TPickSelection = SUBCLASS OF TSelection &{Variables} &{Creation/Destruction} (FUNCTION {TPickSelection.}CREATE(object: TObject; itsHeap: THeap; itsView: TView; itsKind: INTEGER; GitsAnchorLPt: LPoint): TPickSelection; &{Drawing - per pad} '{PROCEDURE TPickSelection. Highlight(highTransit: THighTransit);} &{Selection - per pad} (PROCEDURE {TPickSelection.}ComputeBoundingBox; '{PROCEDURE TPickSelection. MouseMove(mouseLPt: LPoint);} '{PROCEDURE TPickSelection. MouseRelease;} '{PROCEDURE TPickSelection. Restore;} '{PROCEDURE TPickSelection. Save;} &{Command Dispatch} '{PROCEDURE TPickSelection. NewCommand(cmdNumber: TCmdNumber): TCommand;} (END; $TAreaSelection = SUBCLASS OF TSelection &{Variables} (shiftKey: BOOLEAN; &{Creation/Destruction} (FUNCTION {TAreaSelection.}CREATE(object: TObject; itsHeap: THeap; itsView: TView; GitsAnchorLPt: LPoint; itsShiftKey: BOOLEAN): TAreaSelection; &{Drawing - per pad} '{PROCEDURE TAreaSelection. Highlight(highTransit: THighTransit);} &{Selection - per pad} (PROCEDURE {TAreaSelection.}ComputeBoundingBox; '{PROCEDURE TAreaSelection. MouseMove(mouseLPt: LPoint);} '{PROCEDURE TAreaSelection. MouseRelease;} (END; $TSketchSelection = SUBCLASS OF TSelection &{Variables} (box: TBox; &{Creation/Destruction} (FUNCTION {TSketchSelection.}CREATE(object: TObject; itsHeap: THeap; itsView: TBoxView; IitsAnchorLPt: LPoint): TSketchSelection; &{Drawing - per pad} '{PROCEDURE TSketchSelection. Highlight(highTransit: THighTransit);} &{Selection - per pad} '{PROCEDURE TSketchSelection. MouseMove(mouseLPt: LPoint);} '{PROCEDURE TSketchSelection. MouseRelease;} (END; $TRecolorCmd = SUBCLASS OF TCommand &{Variables} (newColor: TColor; {when the command is first done this is copied to the view} &{Creation} (FUNCTION {TRecolorCmd.}CREATE(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; DitsView: TBoxView; itsColor: TColor): TRecolorCmd; &{Command Execution} '{PROCEDURE TRecolorCmd. Commit;} '{PROCEDURE TRecolorCmd. Perform(cmdPhase: TCmdPhase);} '{PROCEDURE TRecolorCmd. EachVirtualPart(PROCEDURE DoToObject(obj: TObject));} (END; $TMoveCmd = SUBCLASS OF TCommand &{Variables} (hOffset: LONGINT; (vOffset: LONGINT; &{Creation} (FUNCTION {TMoveCmd.}CREATE(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; AitsView: TBoxView; itsHOffset, itsVOffset: LONGINT): TMoveCmd; &{Command Execution} '{PROCEDURE TMoveCmd. Perform(cmdPhase: TCmdPhase);} (END; $TBoxCutCopyCmd = SUBCLASS OF TCutCopyCommand &{Variables} (selTopLeft: LPoint; &{Creation} (FUNCTION {TBoxCutCopyCmd.}CREATE(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; GitsView: TView; isCutCmd: BOOLEAN; itsTopLeft: LPoint): TBoxCutCopyCmd; &{Command Execution} '{PROCEDURE TBoxCutCopyCmd. Commit;} '{PROCEDURE TBoxCutCopyCmd. DoCutCopy(clipSelection: TSelection; deleteOriginal: BOOLEAN; McmdPhase: TCmdPhase);} '{PROCEDURE TBoxCutCopyCmd. EachVirtualPart(PROCEDURE DoToObject(obj: TObject));} (END; $TClearCmd = SUBCLASS OF TBoxCutCopyCmd &{Variables} &{Creation} (FUNCTION {TClearCmd.}CREATE(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; BitsView: TBoxView; itsTopLeft: LPoint): TClearCmd; &{Command Execution} '{PROCEDURE TClearCmd. Perform(cmdPhase: TCmdPhase);} (END; $TBoxPasteCmd = SUBCLASS OF TPasteCommand &{Variables} (pasteBoxList: TList; &{Creation and Destruction} (FUNCTION {TBoxPasteCmd.}CREATE(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; HitsView: TBoxView): TBoxPasteCmd; '{PROCEDURE TBoxPasteCmd. Free;} &{Command Execution} '{PROCEDURE TBoxPasteCmd. Commit;} '{PROCEDURE TBoxPasteCmd. DoPaste(clipSelection: TSelection; pic: PicHandle; cmdPhase: TCmdPhase);} '{PROCEDURE TBoxPasteCmd. EachVirtualPart(PROCEDURE DoToObject(obj: TObject));} (PROCEDURE {TBoxPasteCmd.}FinishPaste(cmdPhase: TCmdPhase); ,{This invalidates the pasted boxes and does other stuff needed to finish the command.} (END; $TSketchBoxCmd = SUBCLASS OF TBoxPasteCmd &{Variables} ({pasteList is created by the CREATE method} &{Creation and Destruction} (FUNCTION {TSketchBoxCmd.}CREATE(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; DitsView: TBoxView; itsBox: TBox): TSketchBoxCmd; &{Command Execution} '{PROCEDURE TSketchBoxCmd. Perform(cmdPhase: TCmdPhase);} (END; $TDuplicateCmd = SUBCLASS OF TBoxPasteCmd &{Variables} ({pasteList is created by the CREATE method} &{Creation} (FUNCTION {TDuplicateCmd.}CREATE(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; FitsView: TBoxView; itsPickSelection: TPickSelection): TDuplicateCmd; (END; $TFrontBackCmd = SUBCLASS OF TCommand &{Variables} (sendToBack: BOOLEAN; &{Creation} (FUNCTION {TFrontBackCmd.}CREATE(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; IitsView: TBoxView; isSendToBack: BOOLEAN): TFrontBackCmd; &{Command Execution} '{PROCEDURE TFrontBackCmd. Commit;} '{PROCEDURE TFrontBackCmd. Perform(cmdPhase: TCmdPhase);} '{PROCEDURE TFrontBackCmd. EachVirtualPart(PROCEDURE DoToObject(obj: TObject));} (END; IMPLEMENTATION "{$I UBoxer2.text} END. 3. "6F^9; D!$ǐ^RoTfilteredObj: TObject))}; ze); All)); TBoxView; T #̟H:!$'T #$UBOXER.oo.ʠʨp1PeS00 b(itsView.FixLRectDelta(itsPickSelection.boundLRect, deltaLPt); (itsView.EachVirtualPart(DuplicateBox); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TDuplicateCmd.}Perform{(cmdPhase: TCmdPhase)}; $BEGIN ({$IFC fTrace}BP(12);{$ENDVAR $shades: ARRAY[TColor] OF LPattern; $arwBitMap: BitMap; METHODS OF TBox; $FUNCTION {TBox.}CREATE{(object: TObject; itsHeap: THeap; itsShape: LRect; itsColor: TColor): TBox}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TBox(object); (WITH SELF DO ,BEGIN ,isSelected := FALSE; ,wasSelected := FALSE; ,shapeLRect := itsShape; ,color := itsColor; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TBox.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('shapeLRect: LRect'); (Field('color: Byte'); (Field('isSelected: BOOLEAN'); (Field('wasSelected: BOOLEAN'); (Field(''); $END; ${$ENDC} $PROCEDURE {TBox.}Draw; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF LRectIsVisible(SELF.shapeLRect) THEN ,BEGIN ,PenNormal; ,PenSize(1, 1); ,FillLRect(SELF.shapeLRect, shades[SELF.color]); ,FrameLRect(SELF.shapeLRect); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBox.}EachHandleRect{(PROCEDURE DoToHandle(hRect: Rect))}; $VAR hRect: Rect; (shapeRect: Rect; (dh, dv: INTEGER; (PROCEDURE DoOffsetBy(hOffset, vOffset: INTEGER); (BEGIN ,OffsetRect(hRect, hOffset, vOffset); ,DoToHandle(hRect); (END; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (SetRect(hRect, -3, -2, 3, 2); (thePad.LRectToRect(SELF.shapeLRect, shapeRect); (WITH shapeRect DO ,BEGIN ,dh := right - left; ,dv := bottom - top; ,DoOffsetBy(left, top); ,END; (DoOffsetBy(dh, 0); (DoOffsetBy(0, dv); (DoOffsetBy(-dh, 0); (IF dh > 15 THEN ,BEGIN ,DoOffsetBy(dh DIV 2, 0); ,DoOffsetBy(0, -dv); ,OffsetRect(hRect, -(dh DIV 2), dv); ,END; (IF dv > 15 THEN ,BEGIN ,DoOffsetBy(0, -(dv DIV 2)); ,DoOffsetBy(dh, 0); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBox.}Highlight{(highTransit: THighTransit)}; (VAR bounds: LRect; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (bounds := SELF.shapeLRect; (InsetLRect(bounds, -3, -2); (IF LRectIsVisible(bounds) THEN ,BEGIN ,thePad.SetPenToHighlight(highTransit); ,SELF.EachHandleRect(PaintRect); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBox.}InvalInTheView{(view: TView)}; (VAR bounds: LRect; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (WITH SELF DO ,{$H-} ,BEGIN ,bounds := shapeLRect; ,IF isSelected OR wasSelected THEN 0InsetLRect(bounds, -3, -2); ,{$H+} ,END; (view.panel.InvalLRect(bounds); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBox.}Outline; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF LRectIsVisible(SELF.shapeLRect) THEN ,BEGIN ,PenNormal; ,PenSize(1, 1); ,PenMode(patXor); ,FrameLRect(SELF.shapeLRect); ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TBoxProcess; $FUNCTION {TBoxProcess.}CREATE{(object: TObject; itsHeap: THeap): TBoxProcess}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TBoxProcess(TProcess.CREATE(object, itsHeap)); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxProcess.}Commence{(phraseVersion: INTEGER)}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (SUPERSELF.Commence(phraseVersion); (shades[colorWhite] := lPatWhite; (shades[colorLtGray] := lPatLtGray; (shades[colorGray] := lPatGray; (shades[colorDkGray] := lPatDkGray; (shades[colorBlack] := lPatBlack; ({ build the arrow bitmap } (WITH arwBitMap DO ,BEGIN ,rowBytes := 2; ,SetRect(bounds, 0, 0, 16, 16); ,baseAddr := @arrow.data; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TBoxProcess.}NewDocManager{(volumePrefix: TFilePath; openAsTool: BOOLEAN): TDocManager}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF openAsTool THEN ,NewDocManager := NIL (ELSE ,NewDocManager := TBoxDocManager.CREATE(NIL, mainHeap, volumePrefix); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TBoxDocManager; $FUNCTION {TBoxDocManager.}CREATE{(object: TObject; itsHeap: THeap; itsPathPrefix: TFilePath) =: TBoxDocManager}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TBoxDocManager(TDocManager.CREATE(object, itsHeap, itsPathPrefix)); ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TBoxDocManager.}NewWindow{(heap: THeap; wmgrID: TWindowID):TWindow}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (NewWindow := TBoxWindow.CREATE(NIL, heap, wmgrID); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TBoxWindow; $FUNCTION {TBoxWindow.}CREATE{(object: TObject; itsHeap: THeap; itsWmgrID: TWindowID): TWindow}; (VAR box: TBox; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TBoxWindow(TWindow.CREATE(object, itsHeap, itsWmgrID, TRUE)); (WITH SELF DO ,BEGIN ,actions := NIL; ,boxes := NIL; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TBoxWindow.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('actions: TPanel'); (Field('boxes: TPanel'); (Field(''); $END; ${$ENDC} $PROCEDURE {TBoxWindow.}BlankStationery; $VAR docHeap: THeap; (palBox: TBox; (viewLRect: LRect; (panel: TPanel; (boxView: TBoxView; (actView: TActView; (selection: TSelection; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (docHeap := SELF.Heap; (palBox := TBox.CREATE(NIL, docHeap, zeroLRect, colorWhite); ({ make main panel first so it will be selectPanel & clickPanel} (SetLRect(viewLRect, 0, 0, 100, 100); {+} {will get grown to 1 pg, then more as needed or requested} (panel := TPanel.CREATE(NIL, docHeap, SELF, 30, 20, @[aBar, aScroll, aSplit], [aScroll, aSplit]); (boxView := TBoxView.CREATE(NIL, docHeap, panel, viewLRect, palBox, TList.CREATE(NIL,docHeap, 0)); (SELF.boxes := panel; ({ make actions panel } (panel := panel.Divide(h, palWidth+1, pixelsFromEdge, [], palWidth, [aScroll], [aBar]); (actView := TActView.CREATE(NIL, docHeap, panel, palBox); (selection := panel.selection.FreedAndReplacedBy(TPalSelection.CREATE(NIL, docHeap, actView)); (SELF.actions := panel; ({ make the main selection only after all the panels are set up } (selection := SELF.selectPanel.selection.FreedAndReplacedBy( @TPickSelection.CREATE(NIL, docHeap, boxView, pickKind, zeroLPt)); ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TBoxWindow.}CanDoCommand{(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (CASE cmdNumber OF ,uSelAll, ,uSplitH, uSplitV, uRemHSplit, uRemVSplit, ,uRemAllSplit: 0CanDoCommand := TRUE; ,uSaveSplits: 0BEGIN 0CanDoCommand := TRUE; 0checkIt := SELF.boxes.deletedSplits <> NIL; 0END; ,OTHERWISE 0CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TBoxWindow.}NewCommand{(cmdNumber: TCmdNumber): TCommand}; (VAR palSelection: TPalSelection; ,boxPanel: TPanel; ,actView: TActView; ,vhs: VHSelect; ,topOrLeft: BOOLEAN; ,size: INTEGER; ,x: INTEGER; ,str: S255; ,band: TBand; ,scroller: TScroller; ,widestBand: TBand; ,s: TListScanner; ,firstPane: TPane; ,numSideBands: INTEGER; ,firstRegBand: INTEGER; ,tempBand: TBand; ,tempScrollBar: TScrollBar; ,a: TArray; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (boxPanel := SELF.boxes; (NewCommand := NIL; (CASE cmdNumber OF ,uSelAll: 0BEGIN 0SELF.SelectAll; 0{must go into select mode} 0SELF.SetAction(symArrow, TRUE); 0END; ,uSplitH, uSplitV, uRemHSplit, uRemVSplit: 0BEGIN 0IF (cmdNumber = uSplitH) OR (cmdNumber = uRemHSplit) THEN 4vhs := h 0ELSE 4vhs := v; 0IF (cmdNumber = uSplitH) OR (cmdNumber = uSplitV) THEN 4BEGIN 4widestBand := TBand(boxPanel.bands[vhs].At(1)); 4IF widestBand.scroller = NIL THEN {must be a sideband} 8widestBand := TSideBand(widestBand).CoBand; 4s := boxPanel.bands[vhs].Scanner; 4WHILE s.Scan(band) DO 8IF band.scroller <> NIL THEN {not a sideband}  LengthRect(widestBand.outerRect, vhs) THEN @widestBand := band; 4WITH widestBand.outerRect DO 8x := (topLeft.vh[vhs] + botRight.vh[vhs]) DIV 2; 4scroller := boxPanel.scrollBars[vhs].firstBox; {want the first scroller} 4END 0ELSE IF boxPanel.bands[vhs].Size < 2 THEN 4BEGIN 4scroller := NIL; 4process.Stop(phNoSplit); 4END 0ELSE 4BEGIN 4band := TBand(boxPanel.bands[vhs].Last); 4IF band.scroller = NIL THEN {must be a sideband} 8band := TSideBand(band).CoBand; 4scroller := band.scroller; 4x := MAXINT; 4END; 0IF scroller <> NIL THEN 4boxPanel.MoveSplitBefore(scroller, x); 0END; ,uRemAllSplit: 0BEGIN 0firstPane := TPane(boxPanel.panes.At(1)); 0FOR vhs := v TO h DO 4BEGIN 4numSideBands := 0; 4firstRegBand := 1; 4tempBand := TBand(boxPanel.bands[vhs].First); 4IF tempBand.scroller = NIL THEN 8BEGIN 8numSideBands := numSideBands + 1; 8firstRegBand := 2; 8END; 4tempBand := TBand(boxPanel.bands[vhs].Last); 4IF tempBand.scroller = NIL THEN 8numSideBands := numSideBands + 1; 4WHILE boxPanel.bands[vhs].Size-numSideBands > 1 DO 8BEGIN 8band := TBand(boxPanel.bands[vhs].At(firstRegBand+1)); 8boxPanel.MoveSplitBefore(band.scroller, MAXINT); 8END; 4END; 0IF boxPanel.deletedSplits <> NIL THEN 4boxPanel.deletedSplits.DelAll; 0END; ,uSaveSplits: 0IF boxPanel.deletedSplits = NIL THEN 4BEGIN 4a := TArray.CREATE(NIL, SELF.Heap, 0, SIZEOF(INTEGER)); 4boxPanel.deletedSplits := a; 4END 0ELSE 4BEGIN 4boxPanel.deletedSplits.Free; 4boxPanel.deletedSplits := NIL; 4END; ,OTHERWISE 0NewCommand := SUPERSELF.NewCommand(cmdNumber); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxWindow.}PutUpDialogBox(dialogBox: TDialogBox); $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (SUPERSELF.PutUpDialogBox(dialogBox); (IF dialogBox = SELF.boxes.view.printManager.layoutDialogBox THEN ,BEGIN ,menuBar.Insert(mnuTypeStyle, 0); ,menuBar.Draw; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxWindow.}SelectAll; $VAR panel: TPanel; (boxView: TBoxView; (PROCEDURE SelectBox(obj: TObject); (BEGIN ,IF NOT TBox(obj).isSelected THEN 0boxView.ToggleHighlight(TBox(obj)); (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (panel := SELF.boxes; (boxView := TBoxView(panel.view); (boxView.EachVirtualPart(SelectBox); (TPickSelection(panel.selection).ComputeBoundingBox; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxWindow.}SetAction{(action: INTEGER; doHilite: BOOLEAN)}; (VAR actPanel: TPanel; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (actPanel := SELF.actions; (IF (action = symArrow) OR (action = symBox) THEN ,TPalSelection(actPanel.selection).SetSelection(1, action, doHilite, FALSE, TRUE); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxWindow.}TakeDownDialogBox; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF SELF.dialogBox = SELF.boxes.view.printManager.layoutDialogBox THEN ,BEGIN ,menuBar.Delete(mnuTypeStyle); ,menuBar.Draw; ,END; (SUPERSELF.TakeDownDialogBox; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TActView; $FUNCTION {TActView.}CREATE{(object: TObject; itsHeap: THeap; itsPanel: TPanel; itsPalBox: TBox) =: TActView}; (VAR lr: LRect; ,box: TBox; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TActView(TPalView.CREATE(object, itsHeap, itsPanel, palWidth, palHeight, 1, 2)); (SELF.extentLRect.bottom := 500; {increase view height so rest of palette will be white} (SELF.GetBoxLRect(1, 2, lr); (InsetLRect(lr, hPalMargin, vPalMargin); (itsPalBox.shapeLRect := lr; (SELF.palBox := itsPalBox; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TActView.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('palBox: TBox'); (Field(''); $END; ${$ENDC} $PROCEDURE {TActView.}DrawSymbol{(atCol, atRow: INTEGER)}; (VAR lr: LRect; ,r: Rect; ,bounds: Rect; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF atRow = symBox THEN ,SELF.palBox.Draw (ELSE ,BEGIN ,SELF.GetBoxLRect(atCol, atRow, lr); ,thePad.lRectToRect(lr, r); ,SetRect(bounds, 0, 0, 16, 16); ,OffsetRect(bounds, r.left + (LengthRect(r, h)-8) DIV 2, ?r.top + (LengthRect(r, v)-16) DIV 2); ,CopyBits(arwBitMap, thePort^.portBits, 5arwBitMap.bounds, bounds, 5srcOr, NIL); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TActView.}MouseRelease; (VAR panel: TPanel; ,palSelection: TPalSelection; ,boxWindow: TBoxWindow; ,boxView: TBoxView; (PROCEDURE DeselectBox(obj: TObject); (BEGIN ,IF TBox(obj).isSelected THEN 0boxView.ToggleHighlight(TBox(obj)); (END; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (panel := SELF.panel; (palSelection := TPalSelection(panel.selection); (palSelection.MouseRelease; (IF SELF.palBox.isSelected THEN {user wants to draw another box -- deselect all boxes} ,BEGIN ,boxWindow := TBoxWindow(panel.window); ,boxView := TBoxView(boxWindow.boxes.view); ,boxView.EachVirtualPart(DeselectBox); ,TPickSelection(boxWindow.boxes.selection).ComputeBoundingBox; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ({Want to insure that when the palette box is marked isSelected if and only if that 0palette square is selected. Note that this is the ONLY place where we have 0to worry about this.} $PROCEDURE {TPalView.}ChangedSelection(atCol, atRow: INTEGER); $BEGIN (SELF.palBox.isSelected := ((atCol = 1) AND (atRow = symBox)); $END; END; METHODS OF TBoxView; $FUNCTION {TBoxView.}CREATE{(object: TObject; itsHeap: THeap; itsPanel: TPanel; itsExtent: LRect; >itsPalBox: TBox; itsBoxList: TList): TBoxView}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TBoxView(itsPanel.NewView(object, itsExtent, TStdPrintManager.CREATE(NIL, itsHeap), JstdMargins, TRUE)); (WITH SELF DO ,BEGIN ,boxList := itsBoxList; ,palBox := itsPalBox; ,doingMove := FALSE; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TBoxView.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('boxList: TList'); (Field('palBox: TBox'); (Field('doingMove: BOOLEAN'); $END; ${$ENDC} $FUNCTION {TBoxView.}BoxWith{(LPt: LPoint): TBox}; (PROCEDURE FindBox(obj: TObject); (BEGIN ,IF LPtInLRect(LPt, TBox(obj).shapeLRect) THEN 0BoxWith := TBox(obj); {last one found (front one) is returned} (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (boxWith := NIL; (SELF.EachVirtualPart(FindBox); ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TBoxView.}CursorAt{(mouseLPt: LPoint): TCursor}; $VAR sketchSelection: TSketchSelection; (shapeLRect: LRect; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (CASE SELF.panel.selection.kind OF ,areaKind: 0CursorAt := fingerCursor; ,sketchKind: 0CursorAt := smCrossCursor; ,OTHERWISE 0IF SELF.palBox.isSelected THEN 4CursorAt := smCrossCursor 0ELSE 4CursorAt := arrowCursor; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxView.}Draw; (VAR vhs: VHSelect; ,doneLCd: LONGINT; ,incLCd: LONGINT; ,startLPt: LPoint; ,endLPt: LPoint; ,str: S255; ,tempLRect: LRect; (PROCEDURE DrawBox(obj: TObject); (BEGIN ,IF NOT (TBox(obj).isSelected AND SELF.doingMove) THEN 0TBox(obj).Draw; (END; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (SELF.EachVirtualPart(DrawBox); ({$IFC fTrace}EP;{$ENDC} $END; "{This is used when moving (for example) a group of boxes, to insure that no part of the (bounding box of the group goes outside the view extent. bounds is the bounding box of (the group of boxes and deltaLpt is the amount to offset the bounds. deltaLpt is (adjusted so that the new bounds falls inside the view extent.} $PROCEDURE {TBoxView.}FixLRectDelta{(bounds: LRect; VAR deltaLPt: LPoint)}; (VAR diffLRect: LRect; ,realExtent: LRect; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (realExtent := SELF.extentLRect; (realExtent.topLeft := zeroLPt; (LRectMinusLRect(realExtent, bounds, diffLRect); {diffLRect indicates the amount it is possible to \move bounds in each direction without moving \outside the view extent} (LRectHaveLPt(diffLRect, deltaLPt); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxView.}InvalBounds{(bounds: LRect; isSelected: BOOLEAN)}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF isSelected THEN ,InsetLRect(bounds, -3, -2); (thePad.InvalLRect(bounds); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxView.}MousePress{(mouseLPt: LPoint)}; $VAR panel: TPanel; (palSelection: TPalSelection; (selection: TSelection; (pickedBox: TBox; (theKind: INTEGER; (PROCEDURE DeselectBox(obj: TObject); (BEGIN ,IF TBox(obj).isSelected THEN 0SELF.ToggleHighlight(TBox(obj)); (END; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (panel := SELF.panel; (IF clickState.fApple THEN {on Apple-click go into drawing mode} ,IF NOT SELF.palBox.isSelected THEN 0BEGIN 0panel.view.EachVirtualPart(DeselectBox); 0TBoxWindow(panel.window).SetAction(symBox, TRUE); 0END; (IF SELF.palBox.isSelected THEN {user is drawing a box} ,selection := panel.selection.FreedAndReplacedBy( @TSketchSelection.CREATE(NIL, SELF.Heap, SELF, mouseLPt)) (ELSE ,BEGIN ,pickedBox := SELF.BoxWith(mouseLPt); ,theKind := pickKind; ,IF pickedBox = NIL THEN {user clicked outside all boxes -- make an area selection} 0selection := panel.selection.FreedAndReplacedBy( @TAreaSelection.CREATE(NIL, SELF.Heap, SELF, mouseLPt, clickState.fShift)) ,ELSE 0BEGIN 0IF NOT (pickedBox.isSelected OR clickState.fShift)THEN 4SELF.EachVirtualPart(DeselectBox); {user clicked in an unselected box without \shifting -- deselect the old boxes} 0IF clickState.fShift OR NOT pickedBox.isSelected THEN 4BEGIN {add/remove the box the user clicked in to the selection} 4IF pickedBox.isSelected THEN 8theKind := unPickKind; 4SELF.ToggleHighlight(pickedBox); 4END; 0selection := panel.selection.FreedAndReplacedBy( DTPickSelection.CREATE(NIL, SELF.Heap, SELF, theKind, mouseLPt)); 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxView.}EachActualPart{(PROCEDURE DoToObject(obj: TObject))}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.boxList.Each(DoToObject); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxView.}ToggleHighlight{(box: TBox)}; $VAR isntSelected: BOOLEAN; (highTransit: THighTransit; (PROCEDURE ToggleOnThePad; (BEGIN ,box.Highlight(highTransit); (END; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (isntSelected := NOT box.isSelected; (highTransit := highToggle[isntSelected]; (SELF.panel.OnAllPadsDo(ToggleOnThePad); (box.isSelected := isntSelected; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TPickSelection; $FUNCTION {TPickSelection.}CREATE{(object: TObject; itsHeap: THeap; itsView: TView; itsKind: INTEGER; DitsAnchorLPt: LPoint): TPickSelection}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TPickSelection(TSelection.CREATE(object, itsHeap, itsView, itsKind, itsAnchorLPt)); (SELF.ComputeBoundingBox; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TPickSelection.}CanDoCommand{(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN}; (VAR boxView: TBoxView; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (CASE cmdNumber OF ,uWhite, uLtGray, uGray, uDkGray, uBlack, ,uShades: 0BEGIN 0boxView := TBoxView(SELF.view); 0CanDoCommand := (SELF.kind <> nothingKind) OR (boxView.palBox.isSelected); 0END; ,uCut, uCopy, uClear, ,uFront, uBack, uDuplicate: 0CanDoCommand := SELF.kind <> nothingKind; ,uPaste: 0CanDoCommand := TRUE; ,OTHERWISE 0CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPickSelection.}ComputeBoundingBox; $VAR n: INTEGER; (unitedLRect: LRect; (boxWindow: TBoxWindow; (PROCEDURE UniteBox(obj: TObject); (BEGIN ,IF TBox(obj).isSelected THEN 0BEGIN 0IF n = 0 THEN 4unitedLRect := TBox(obj).shapeLRect 0ELSE 4UnionLRect(unitedLRect, TBox(obj).shapeLRect, unitedLRect); 0n := n + 1; 0END; (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (n := 0; (SELF.view.EachVirtualPart(UniteBox); (WITH SELF DO ,IF n = 0 THEN 0BEGIN 0kind := nothingKind; 0boundLRect := zeroLRect; 0END ,ELSE 0BEGIN 0IF kind = nothingKind THEN 4kind := pickKind; 0boundLRect := unitedLRect; 0END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPickSelection.}Highlight{(highTransit: THighTransit)}; $VAR boxView: TBoxView; (PROCEDURE HiliteBox(obj: TObject); (BEGIN ,IF TBox(obj).isSelected THEN 0TBox(obj).Highlight(highTransit); (END; (PROCEDURE OutlineBox(obj: TObject); (BEGIN ,IF TBox(obj).isSelected THEN 0TBox(obj).Outline; (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (boxView := TBoxView(SELF.view); (IF boxView.doingMove THEN ,boxView.EachVirtualPart(OutlineBox) (ELSE ,boxView.EachVirtualPart(HiliteBox); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPickSelection.}MouseMove{(mouseLPt: LPoint)}; (VAR boxView: TBoxView; ,panel: TPanel; ,diffLPt: LPoint; ,diffLRect: LRect; ,bbox: LRect; (PROCEDURE MoveBox(obj: TObject); (BEGIN ,IF TBox(obj).isSelected THEN 0{$H-} 0OffsetLRect(TBox(obj).shapeLRect, diffLPt.h, diffLPt.v); 0{$H+} (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (boxView := TBoxView(SELF.view); (panel := SELF.panel; '{First test if we want to drag this selection at all} (IF SELF.kind = pickKind THEN ,BEGIN +{How far did mouse move?} ,LPtMinusLPt(mouseLPt, SELF.currLPt, diffLPt); +{Don't move past view boundaries} ,boxView.FixLRectDelta(SELF.boundLRect, diffLPt); +{Move it if delta is nonzero} ,IF NOT EqualLPt(diffLPt, zeroLPt) THEN 0BEGIN 0IF NOT boxView.doingMove THEN {erase old boxes and change to outlines} 4BEGIN 4boxView.doingMove := TRUE; 4WITH SELF DO 8BEGIN 8{$H-} 8bbox := boundLRect; 8InsetLRect(bbox, -3, -2); 8panel.InvalLRect(bbox); 8{$H+} 8END; 4SELF.window.Update(TRUE); 4END; *{$H-} OffsetLRect(SELF.boundLRect, diffLPt.h, diffLPt.v); {$H+} 0LPtPlusLPt(SELF.currLPt, diffLPt, mouseLPt); 0SELF.currLPt := mouseLPt; 0panel.Highlight(SELF, hOnToOff); 0boxView.EachVirtualPart(MoveBox); 0panel.Highlight(SELF, hOffToOn); 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPickSelection.}MouseRelease; (VAR deltaLPt: LPoint; ,actPanel: TPanel; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (TBoxView(SELF.view).doingMove := FALSE; (IF NOT EqualLPt(SELF.currLPt, SELF.anchorLPt) THEN ,BEGIN ,LPtMinusLPt(SELF.currLPt, SELF.anchorLPt, deltaLPt); ,{Must turn off highlighting in the palette, because the highlighting is already off in the 0other panel, so that the TMoveCmd does not turn off highlighting before performing, 0but does turn it on afterwards.} ,actPanel := TBoxWindow(SELF.window).actions; ,actPanel.Highlight(actPanel.selection, hOnToOff); ,SELF.window.PerformCommand(TMoveCmd.CREATE(NIL, SELF.Heap, uMoveBoxes, TBoxView(SELF.view), HdeltaLPt.h, deltaLPt.v)); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TPickSelection.}NewCommand{(cmdNumber: TCmdNumber): TCommand}; $VAR pasteH: LONGINT; (pasteV: LONGINT; (boxView: TBoxView; (heap: THeap; (newColor: TColor; (dialogWindow: TDialogWindow; (dialog: TDialog; (cluster: TCluster; (checkbox: TCheckbox; (okButton: TButton; (cancelButton: TButton; (PROCEDURE FindColor(obj: TObject); (BEGIN (IF TBox(obj).isSelected THEN ,newColor := TBox(obj).color; (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (NewCommand := NIL; (boxView := TBoxView(SELF.view); (heap := SELF.Heap; (CASE cmdNumber OF ,uWhite, uLtGray, uGray, uDkGray, uBlack: 0BEGIN 0newColor := cmdNumber - uWhite + colorWhite; 0WITH boxView.palBox DO 4{$H-} 4IF isSelected THEN 8BEGIN 8color := newColor; 8TBoxWindow(SELF.window).actions.InvalLRect(shapeLRect); 8END 4ELSE IF SELF.kind = nothingKind THEN 8SELF.CantDoIt 4ELSE 8NewCommand := TRecolorCmd.CREATE(NIL, heap, cmdNumber, boxView, newColor); 4{$H+} 0END; ,uShades: 0BEGIN 0dialogWindow := NewStdDialogWindow(SELF.Heap, 120, diDismiss, diAccept, diDismiss); 0dialogWindow.freeOnDismissal := TRUE; {this dialog-box structure will vanish when it \is taken down} 0dialog := dialogWindow.dialogView.AddNewDialog('SHAD'); 0cluster := dialog.AddStdCluster('Elmer', 60, 40); 0boxView.EachVirtualPart(FindColor); {will set var 'newColor' to the color of a selected box} 0checkbox := cluster.NewAlignedCheckbox(phWhite, newColor = colorWhite); 0checkbox := cluster.NewAlignedCheckbox(phLightGray, newColor = colorLtGray); 0checkbox := cluster.NewAlignedCheckbox(phGray, newColor = colorGray); 0checkbox := cluster.NewAlignedCheckbox(phDarkGray, newColor = colorDkGray); 0checkbox := cluster.NewAlignedCheckbox(phBlack, newColor = colorBlack); 0okButton := dialog.NewButton(phOK, stdButtonMetrics, NIL, uOKShades); 0cancelButton := dialog.NewButton(phCancel, stdButtonMetrics, okButton, noCmdNumber); 0dialog.SetDefaultButton(cancelButton); 0SELF.window.PutUpDialogBox(dialogWindow); 0NewCommand := NIL; 0END; ,uOKShades: {OK button was hit in the SHADES dialog} {+SW+} 0BEGIN 0checkbox := 4TCluster(TDialogWindow(SELF.window.dialogBox).mainDialog.children.First).hilitBox; 0CASE checkbox.idNumber OF 4phWhite: cmdNumber := uWhite; 4phLightGray: cmdNumber := uLtGray; 4phGray: cmdNumber := uGray; 4phDarkGray: cmdNumber := uDkGray; 4phBlack: cmdNumber := uBlack; 4END; 0NewCommand := SELF.NewCommand(cmdNumber); 0END; ,uDuplicate: 0NewCommand := TDuplicateCmd.CREATE(NIL, heap, cmdNumber, boxView, SELF); ,uClear: 0IF SELF.kind = nothingKind THEN 4SELF.CantDoIt 0ELSE 4NewCommand := TClearCmd.CREATE(NIL, heap, cmdNumber, boxView, SELF.boundLRect.topLeft); ,uCut, uCopy: 0IF SELF.kind = nothingKind THEN 4SELF.CantDoIt 0ELSE 4NewCommand := TBoxCutCopyCmd.CREATE(NIL, heap, cmdNumber, boxView, cmdNumber = uCut, USELF.boundLRect.topLeft); ,uPaste: 0BEGIN 0clipboard.Inspect; 0IF clipboard.hasView THEN 4BEGIN 4WITH SELF DO 8IF kind = nothingKind THEN  inside)) THEN 4boxView.ToggleHighlight(TBox(obj)); 0{$H+} 0END; (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.panel.Highlight(SELF, hOnToOff); (boxView := TBoxView(SELF.view); (boxView.EachVirtualPart(SelectInArea); (selection := SELF.FreedAndReplacedBy( @TPickSelection.CREATE(NIL, SELF.Heap, boxView, pickKind, SELF.anchorLPt)); ({don't refer to SELF after this} ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TSketchSelection; $FUNCTION {TSketchSelection.}CREATE{(object: TObject; itsHeap: THeap; itsView: TBoxView; FitsAnchorLPt: LPoint): TSketchSelection}; (VAR box: TBox; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TSketchSelection(TSelection.CREATE(object, itsHeap, itsView, sketchKind, itsAnchorLPt)); (box := TBox(itsView.palBox.Clone(itsHeap)); (box.shapeLRect := zeroLRect; (SELF.box := box; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TSketchSelection.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('box: TBox'); $END; ${$ENDC} $PROCEDURE {TSketchSelection.}Highlight{(highTransit: THighTransit)}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} ({since sketch selections are created only when creating a box, the highTransit should always )be hOffToOn; to highlight it, just outline the box} (SELF.box.Outline; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TSketchSelection.}MouseMove{(mouseLPt: LPoint)}; $VAR maxBoxLRect: LRect; (diffLPt: LPoint; (box: TBox; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (WITH SELF.anchorLPt DO &{$H-} SetLRect(maxBoxLRect, h+10-MAXINT, v+10-MAXINT, h+MAXINT-10, v+MAXINT-10); {$H+} (LRectHaveLPt(maxBoxLRect, mouseLPt); (LPtMinusLPt(mouseLPt, SELF.currLPt, diffLPt); (IF NOT EqualLPt(diffLPt, zeroLPt) THEN ,BEGIN ,SELF.currLPt := mouseLPt; ,box := SELF.box; ,SELF.panel.Highlight(SELF, hOnToOff); 0{NOTE: the first time this is done there is no highlighting. Normally, this statement 4would cause a problem, because it would be turning the highlighting ON. But the 4box shape is initially a zeroLRect, so it does not mess things up} ,box.shapeLRect.topLeft := SELF.anchorLPt; ,box.shapeLRect.botRight := mouseLPt; &{$h-} RectifyLRect(box.shapeLRect); {$H+} ,SELF.panel.Highlight(SELF, hOffToOn); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TSketchSelection.}MouseRelease; $VAR myPanel: TPanel; (myBoxView: TBoxView; (myBox: TBox; (drawnLRect: LRect; (pickSelection: TPickSelection; (PROCEDURE DeselectBox(obj: TObject); (BEGIN ,IF TBox(obj).isSelected THEN 0TBox(obj).isSelected := FALSE; (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (WITH SELF DO ,BEGIN ,myPanel := panel; ,myBoxView := TBoxView(view); ,myBox := box; ,END; (drawnLRect := myBox.shapeLRect; ({always need a pickSelection in the panel} (pickSelection := TPickSelection(SELF.FreedAndReplacedBy( @TPickSelection.CREATE(NIL, SELF.Heap, myBoxView, pickKind, SELF.anchorLPt))); ({dont refer to SELF after this} (IF (drawnLRect.right - drawnLRect.left <= 4) OR (drawnLRect.bottom - drawnLRect.top <= 4) THEN ,BEGIN {too small, so don't remember the box} ,myBoxView.EachVirtualPart(DeselectBox); {MousePress left the isSelected flags on} ,pickSelection.ComputeBoundingBox; {because we have now deselected the old selection} ,myBox.InvalInTheView(myBoxView); ,myBox.Free; ,END (ELSE {this also turns isSelected off, but copies it into wasSelected first} ,myPanel.window.PerformCommand(TSketchBoxCmd.CREATE(NIL, LpickSelection.Heap, uCreateBox, myBoxView, myBox)); ({$IFC fTrace}EP;{$ENDC} $END; END; {COMMAND CLASSES} {Called as the last thing in every .Perform method} PROCEDURE EndCommand(SELF: TBoxView); $VAR panel: TPanel; BEGIN $panel := SELF.panel; $TPickSelection(panel.selection).ComputeBoundingBox; $panel.selection.MarkChanged; $TBoxWindow(panel.window).SetAction(symArrow, FALSE); {turning highlighting on is handled by Toolkit} END; {Called as the last thing in many .Perform methods; this invalidates all the boxes marked isSelected $and calls EndCommand. (It avoids repeating the InvalBox procedure many times.)} PROCEDURE InvalSelection(boxView: TBoxView); $PROCEDURE InvalBox(obj: TObject); (VAR box: TBox; $BEGIN (box := TBox(obj); (IF box.isSelected THEN ,box.InvalInTheView(boxView); $END; BEGIN $boxView.EachActualPart(InvalBox); $EndCommand(boxView); END; {NOTE: $Unless otherwise mentioned, we let the Toolkit managed the wasSelected and isSelected bits. $Before command.Perform is called, the Toolkit calls selection.Restore (unless it is the doPhase). $After command.Perform is called, the Toolkit calls selection.Save. $Therefore on the doPhase the wasSelected bits have not been set, (but the isSelected bits reflect the current selection. $On undoPhase or redoPhase both isSelected and wasSelected reflect the current selection at the time the (command was done. $That is why the command.Perform methods always check the isSelected bits. $command.FilterAndDo and command.EachVirtualPart must check wasSelected bits (because when they are called, the current selection can be anything. $You must be careful about calling TView.EachVirtualPart from within command.Perform because of (the following: &- On the doPhase the command object has already been installed and TView.EachVirtualPart will (call command.EachVirtualPart. &- But the selection is not saved until after command.Perform is done, so that the wasSelected (have not been set yet. $That is why TRecolorCmd.Perform (for example) calls TView.EachActualPart instead. } METHODS OF TRecolorCmd; $FUNCTION {TRecolorCmd.}CREATE{(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; AitsView: TBoxView; itsColor: TColor): TRecolorCmd}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TRecolorCmd(TCommand.CREATE(object, itsHeap, itsCmdNumber, itsView, TRUE, revealAll)); (SELF.newColor := itsColor; ({$IFC fTrace}EP;{$ENDC} $END; #{$IFC fDebugMethods} $PROCEDURE {TRecolorCmd.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('newColor: INTEGER'); $END; ${$ENDC} $PROCEDURE {TRecolorCmd.}Commit; $VAR s: TListScanner; (color: TColor; (box: TBox; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (s := TBoxView(SELF.image).boxList.Scanner; (color := SELF.newColor; (WHILE s.Scan(box) DO ,IF box.wasSelected THEN 0box.color := color; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TRecolorCmd.}Perform{(cmdPhase: TCmdPhase)}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (InvalSelection(TBoxView(SELF.image)); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TRecolorCmd.}FilterAndDo{(actualObj: TObject; PROCEDURE DoToObject(filteredObj: TObject))}; (VAR saveColor: TColor; ,box: TBox; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} ,box := TBox(actualObj); ,IF box.wasSelected THEN 0BEGIN 0saveColor := box.color; 0box.color := SELF.newColor; 0DoToObject(box); 0box.color := saveColor; 0END ,ELSE 0DoToObject(box); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TMoveCmd; $FUNCTION {TMoveCmd.}CREATE{(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; itsView: TBoxView; >itsHOffset, itsVOffset: LONGINT): TMoveCmd}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TMoveCmd(TCommand.CREATE(object, itsHeap, itsCmdNumber, itsView, TRUE, revealNone)); (WITH SELF DO ,BEGIN ,unHiliteBefore[doPhase] := FALSE; ,hOffset := itsHOffset; ,vOffset := itsVOffset; ,END; ({$IFC fTrace}EP;{$ENDC} $END; %{$IFC fDebugMethods} $PROCEDURE {TMoveCmd.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('hOffset: LONGINT'); (Field('vOffset: LONGINT'); $END; ${$ENDC} $PROCEDURE {TMoveCmd.}Perform{(cmdPhase: TCmdPhase)}; $VAR boxView: TBoxView; (panel: TPanel; (diffLPt: LPoint; (aBox: TBox; (PROCEDURE InvalOnThePad; (BEGIN ,boxView.InvalBounds(aBox.shapeLRect, TRUE); (END; (PROCEDURE MoveBox(obj: TObject); (BEGIN ,aBox := TBox(obj); ,IF aBox.isSelected THEN 0BEGIN 0IF cmdPhase <> doPhase THEN {on doPhase boxes have already been moved} 4BEGIN 4panel.OnAllPadsDo(InvalOnThePad); {invalidate old box position} .{$H-} OffsetLRect(aBox.shapeLRect, diffLPt.h, diffLPt.v); {$H+} 4END; 0panel.OnAllPadsDo(InvalOnThePad); 0END; (END; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (boxView := TBoxView(SELF.image); (panel := boxView.panel; (WITH SELF DO {$H-} ,CASE cmdPhase OF 0doPhase, redoPhase: 4SetLPt(diffLPt, hOffset, vOffset); 0undoPhase: 4SetLPt(diffLPt, -hOffset, -vOffset); 0END; {$H+} (boxView.EachActualPart(MoveBox); (EndCommand(boxView); (boxView.panel.window.RevealSelection(TRUE {reveal ALL}, FALSE {don't highlight}); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TBoxCutCopyCmd; $FUNCTION {TBoxCutCopyCmd.}CREATE{(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; DitsView: TView; isCutCmd: BOOLEAN; itsTopLeft: LPoint): TBoxCutCopyCmd}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TBoxCutCopyCmd(TCutCopyCommand.CREATE(object, itsHeap, itsCmdNumber, itsView, isCutCmd)); (SELF.selTopLeft := itsTopLeft; (IF NOT isCutCmd THEN {no need to highlight on doPhase of a copy command} ,WITH SELF DO 0BEGIN 0unHiliteBefore[doPhase] := FALSE; 0hiliteAfter[doPhase] := FALSE; 0END; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TBoxCutCopyCmd.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('selTopLeft: LPoint'); $END; ${$ENDC} $PROCEDURE {TBoxCutCopyCmd.}Commit; (VAR s: TListScanner; ,box: TBox; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF SELF.isCut THEN ,BEGIN ,s := TBoxView(SELF.image).boxList.Scanner; ,WHILE s.Scan(box) DO 0IF box.wasSelected THEN 4s.Delete(TRUE); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxCutCopyCmd.}DoCutCopy{(clipSelection: TSelection; deleteOriginal: BOOLEAN; JcmdPhase: TCmdPhase)}; $VAR boxView: TBoxView; (pickSelection: TPickSelection; (centerLPt: LPoint; (clipHeap: THeap; (clipPanel: TPanel; (clipBoxList: TList; (boundLRect: LRect; (deltaH: LONGINT; (deltaV: LONGINT; (clipBoxView: TBoxView; (clipPickSelection: TPickSelection; (palBox: TBox; (PROCEDURE DoCopy(obj: TObject); (VAR box: TBox; ,clipBox: TBox; (BEGIN ,box := TBox(obj); ,IF box.isSelected THEN 0BEGIN 0box.wasSelected := TRUE; {Need to do this because the saved selection reflects the state LAFTER the command is performed. If this was a cut command, then Lthe selected boxes are not part of the selection, so that their LwasSelected bits would not be set properly.} 0clipBox := TBox(box.Clone(clipHeap)); 0clipBox.isSelected := TRUE; *{$H-} OffsetLRect(clipBox.shapeLRect, deltaH, deltaV); {$H+} 0clipBoxList.InsLast(clipBox); 0END; (END; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (boxView := TBoxView(SELF.image); (pickSelection := TPickSelection(boxView.panel.selection); (boundLRect := pickSelection.boundLRect; ({ set centerLPt to center of old boundLRect } (WITH boundLRect DO ,SetLPt(centerLPt, (left+right) DIV 2, (top+bottom) DIV 2); (IF cmdPhase = doPhase THEN ,BEGIN ,{prepare to copy} ,clipHeap := clipSelection.Heap; ,clipPanel := clipSelection.panel; ,clipBoxList := TList.CREATE(NIL, clipHeap, 0); ,WITH boundLRect DO 0BEGIN 0deltaH := -left; 0deltaV := -top; 0END; ,boxView.EachActualPart(DoCopy); {copy the selected boxes into the Clipboard} L{make clipboard selection} ,OffsetLRect(boundLRect, deltaH, deltaV); ,palBox := TBox.CREATE(NIL, clipHeap, zeroLRect, colorWhite); ,PushFocus; ,clipboard.window.Focus; ,clipBoxView := TBoxView.CREATE(NIL, clipHeap, clipPanel, boundLRect, palBox, clipBoxList); ,PopFocus; ,clipPickSelection := TPickSelection(clipSelection.FreedAndReplacedBy( 4TPickSelection.CREATE(NIL, clipHeap, clipBoxView, pickKind, zeroLPt))); ,END; &{ set the selection's anchorLPt and currLPt so that a paste right after the cut will be a NOP } (IF SELF.isCut THEN ,BEGIN ,IF cmdPhase <> undoPhase THEN 0WITH boxView.panel.selection DO 4BEGIN 4anchorLPt := centerLPt; 4currLPt := centerLPt; 4END; ,InvalSelection(boxView); ,{If we undo a cut, we don't want to see the current selection, we want to see the boxes 0that are being restored. Set up the command's revelation so that the Toolkit does 0not automatically reveal the selection ...} ,IF cmdPhase <> undoPhase THEN {next UNDO will be the undoPhase} 0SELF.revelation := revealNone ,ELSE 0BEGIN 0SELF.revelation := revealAll; 0{... then reveal the selection after the UNDO is finished} 0boxView.panel.window.RevealSelection(TRUE {reveal ALL}, FALSE {don't highlight}); 8{we don't highlight because the Toolkit will do that for us} 0END; ,END (ELSE ,EndCommand(boxView); {don't need to invalidate on a copy} ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxCutCopyCmd.}EachVirtualPart{(PROCEDURE DoToObject(filteredObj: TObject))}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF SELF.isCut THEN ,SUPERSELF.EachVirtualPart(DoToObject) (ELSE ,SELF.image.EachActualPart(DoToObject); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxCutCopyCmd.}FilterAndDo{(actualObj: TObject; PROCEDURE DoToObject(filteredObj: TObject))}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF NOT TBox(actualObj).wasSelected THEN ,DoToObject(actualObj); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TClearCmd; $FUNCTION {TClearCmd.}CREATE{(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; ?itsView: TBoxView; itsTopLeft: LPoint): TClearCmd}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TClearCmd(TBoxCutCopyCmd.CREATE(object, itsHeap, itsCmdNumber, itsView, TRUE, itsTopLeft)); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TClearCmd.}Perform{(cmdPhase: TCmdPhase)}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (InvalSelection(TBoxView(SELF.image)); ({See the comment in TBoxCutCopyCmd.DoCutCopy above; the same thing applies here.} (IF cmdPhase <> undoPhase THEN ,SELF.revelation := revealNone (ELSE ,BEGIN ,SELF.revelation := revealAll; ,TView(SELF.image).panel.window.RevealSelection(TRUE {reveal ALL}, FALSE {don't highlight}); ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TBoxPasteCmd; $FUNCTION {TBoxPasteCmd.}CREATE{(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; DitsView: TBoxView): TBoxPasteCmd}; (VAR itsPasteBoxList: TList; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TBoxPasteCmd(TPasteCommand.CREATE(object, itsHeap, itsCmdNumber, itsView)); (itsPasteBoxList := TList.CREATE(NIL, itsHeap, 0); (SELF.pasteBoxList := itsPasteBoxList; (SELF.revelation := revealNone; {when we do the paste we don't care what the current selection is, Dwe want to see the pasted boxes} ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxPasteCmd.}Free; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (SELF.pasteBoxList.Free; (SUPERSELF.Free; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TBoxPasteCmd.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('pasteBoxList: TList'); $END; ${$ENDC} $PROCEDURE {TBoxPasteCmd.}Commit; $VAR boxList: TList; (s: TListScanner; (box: TBox; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (boxList := TBoxView(SELF.image).boxList; (s := SELF.pasteBoxList.Scanner; (WHILE s.Scan(box) DO ,BEGIN ,boxList.InsLast(box); ,s.Delete(FALSE); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxPasteCmd.}DoPaste{(clipSelection: TSelection; pic: PicHandle; cmdPhase: TCmdPhase)}; $VAR boxView: TBoxView; (panel: TPanel; (docHeap: THeap; (clipPickSelection: TPickSelection; (pickSelection: TPickSelection; (bbox: LRect; (deltaLPt: LPoint; (clipBoxView: TBoxView; (pasteList: TList; (s: TListScanner; (clipBox: TBox; (box: TBox; (PROCEDURE Deselect(obj: TObject); (BEGIN ,TBox(obj).isSelected := FALSE; (END; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (boxView := TBoxView(SELF.image); (panel := boxView.panel; (docHeap := boxView.Heap; ({Set up the pastBoxList} (IF cmdPhase = doPhase THEN .{ If the clipboard selection is of class TBoxSelection then we can paste it into document, 3otherwise we have to do other things } ,IF NOT InClass(clipSelection, TPickSelection) THEN 0panel.selection.CantDoIt ,ELSE 0BEGIN 0clipPickSelection := TPickSelection(clipSelection); 0pickSelection := TPickSelection(panel.selection); 0bbox := clipPickSelection.boundLRect; 0{ Figure out how much to move clipboard info for pasting } 0{ First, set deltaLPt to point at which to paste center of clipboard: 4anchorLPt of selection if no selection, else center of selection bounding box } 0WITH pickSelection DO 4{$H-} 4IF kind = nothingKind THEN 8WITH anchorLPt DO  NIL THEN ,SELF.pasteBoxList.Each(DoToObject); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TBoxPasteCmd.}FinishPaste{(cmdPhase: TCmdPhase)}; (VAR boxView: TBoxView; ,panel: TPanel; ,box: TBox; ,s: TListScanner; (PROCEDURE InvalPastedBox(obj: TObject); (BEGIN ,{$IFC fTrace}BP(10);{$ENDC} ,TBox(obj).InvalInTheView(boxView); ,{$IFC fTrace}EP;{$ENDC} (END; (PROCEDURE Deselect(obj: TObject); (BEGIN ,TBox(obj).isSelected := FALSE; (END; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (boxView := TBoxView(SELF.image); (panel := boxView.panel; (SELF.pasteBoxList.Each(InvalPastedBox); (IF cmdPhase = doPhase THEN ,boxView.EachActualPart(Deselect); (s := SELF.pasteBoxList.Scanner; (WHILE s.Scan(box) DO ,box.InvalInTheView(boxView); (EndCommand(boxView); ({Similar to Cut/Clear. If we are on the doPhase or redoPhase we need to scroll the pasted ,boxes into view ourselves; on the undoPhase, we can let the Toolkit do it for us.} (IF cmdPhase = undoPhase THEN {the next phase is doPhase or redoPhase} ,SELF.revelation := revealNone (ELSE ,BEGIN ,SELF.revelation := revealAll; ,boxView.panel.window.RevealSelection(TRUE {reveal ALL}, FALSE {don't highlight}); ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TSketchBoxCmd; $FUNCTION {TSketchBoxCmd.}CREATE{(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; DitsView: TBoxView; itsBox: TBox): TAddBoxesCmd}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TSketchBoxCmd(TBoxPasteCmd.CREATE(object, itsHeap, itsCmdNumber, itsView)); (SELF.pasteBoxList.InsLast(itsBox); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TSketchBoxCmd.}Perform{(cmdPhase: TCmdPhase)}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (SELF.FinishPaste(cmdPhase); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TDuplicateCmd; $FUNCTION {TDuplicateCmd.}CREATE{(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; CitsView: TBoxView; itsPickSelection: TPickSelection): TDuplicateCmd}; (VAR deltaLPt: LPoint; ,list: TList; (PROCEDURE DuplicateBox(obj: TObject); ,VAR box: TBox; (BEGIN ,{$IFC fTrace}BP(11);{$ENDC} ,IF TBox(obj).isSelected THEN 0BEGIN 0box := TBox(obj.Clone(itsHeap)); 0{$H-} 0OffsetLRect(box.shapeLRect, deltaLPt.h, deltaLPt.v); 0list.InsLast(box); 0END; ,{$IFC fTrace}EP;{$ENDC} (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TDuplicateCmd(TBoxPasteCmd.CREATE(object, itsHeap, itsCmdNumber, itsView)); (list := SELF.pasteBoxList; {Created by TBoxPasteCmd.CREATE} (SetLPt(deltaLpt, hDupOffset, vDupOffset); (itsView.FixLRectDelta(itsPickSelection.boundLRect, deltaLPt); (itsView.EachVirtualPart(DuplicateBox); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TDuplicateCmd.}Perform{(cmdPhase: TCmdPhase)}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (SELF.FinishPaste(cmdPhase); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TFrontBackCmd; $FUNCTION {TFrontBackCmd.}CREATE{(object: TObject; itsHeap: THeap; itsCmdNumber: TCmdNumber; FitsView: TBoxView; isSendToBack: BOOLEAN): TFrontBackCmd}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TFrontBackCmd(TCommand.CREATE(object, itsHeap, itsCmdNumber, itsView, TRUE, revealAll)); (SELF.sendToBack := isSendToBack; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TFrontBackCmd.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('sendToBack: BOOLEAN'); (Field(''); $END; ${$ENDC} $PROCEDURE {TFrontBackCmd.}Commit; $VAR boxList: TList; (tempList: TList; (s: TListScanner; (box: TBox; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (tempList := TList.CREATE(NIL, SELF.Heap, 0); (boxList := TBoxView(SELF.image).boxList; (s := boxList.Scanner; (WHILE s.Scan(box) DO ,IF box.wasSelected THEN 0BEGIN 0tempList.InsLast(box); 0s.Delete(FALSE); 0END; (boxList.InsManyAt(boxList.size*ORD(NOT SELF.sendToBack) + 1, tempList, 1, tempList.Size); (tempList.FreeObject; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TFrontBackCmd.}Perform{(cmdPhase: TCmdPhase)}; (VAR boxView: TBoxView; (PROCEDURE InvalBox(obj: TObject); ,VAR box: TBox; (BEGIN ,box := TBox(obj); ,IF box.isSelected THEN 0box.InvalInTheView(boxView); (END; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (boxView := TBoxView(SELF.image); (boxView.EachActualPart(InvalBox); (EndCommand(boxView); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TFrontBackCmd.}EachVirtualPart{(PROCEDURE DoToObject(filteredObj: TObject))}; $VAR wantChanged: BOOLEAN; (PROCEDURE DoToFilteredBox(obj: TObject); (BEGIN ,IF wantChanged = TBox(obj).wasSelected THEN 0DoToObject(obj); (END; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (wantChanged := SELF.sendToBack; (SELF.image.EachActualPart(DoToFilteredBox); (wantChanged := NOT wantChanged; (SELF.image.EachActualPart(DoToFilteredBox); ({$IFC fTrace}EP;{$ENDC} $END; END; 3. "6F^9BOD!$ǐ^f$$eGLanager. 2000 989 990 checkbox := cluster.NewAlignedCheckbox(phWhite, newColor = colorWhite); ? *; PBOXER.TEXT for LisaBoxer ;This is a sample phrase file for ToolKit applications ;NOTE: The wording of the alerts may not conform to the standards of the ; first release applications ; 28Sept83 Added page-numbering-order commands to Page Layout Menu 1 3 2300 $-#boot-tk/PABC ; Apple building block phrase files can be included here ; Other application alerts can be included here, numbered between 1001 and 32000 1001 stop alert Click in the drawing panel before doing "^1". 1002 stop alert There is no split in that direction to remove. ;legends for the checkboxes in the 'SHADES' dialog 3301 White 3302 Light Gray 3303 Gray 3304 Dark Gray 3305 Black 0 1 $-#boot-tk/PABC~File/Print 2 $-#boot-tk/PABC~Edit - Clear#208 Duplicate/D#1050 - Select All of Document/A#204 3 $-#boot-tk/PABC~Page Layout 4 Arrangement Bring to Front#1020 Send To Back#1021 5 Shades White#1006 Light Gray#1007 Gray#1008 Dark Gray#1009 Black#1010 - Shades...#1011 91 Splits Split Horizontal Scroll Bar#5000 Split Vertical Scroll Bar#5001 - Remove Horizontal Split#5002 Remove Vertical Split#5003 - Remove All Splits#5004 - Save Deleted Splits#5005 99 $-#boot-tk/PABC~Debug 100 $-#boot-tk/PABC~Buzzwords Create Box#2000 Move Selection#2001 1000 $-#boot-tk/PABC~Clipboard File/Print 0 3. "6F^9erD!$ǐ^  eHbdon't change the opening rectangle n}; NT; T; URE TSketchSelection. MouseRelease;} (END; $TRecolorCmd = SUBCLASS OF TCommand &{Variables} (newColor: TColor; {when the comma;The next 2 lines specify the default tool number and tool volume 201 ;no assembler files $ ;we use the upalette building block upalette $ ;nothing else to link in $ ;install parameters: we handle documents; we handle >1 document; we don't change the opening rectangle y y n Boxer $ 3. "6F^9ewD!$ǐ^"t1313 T`hting will blink rapidly} ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPalSelection.}MouseMove{(mouseLPt: LPoint)}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (SELF.MousePress(mouseLPt); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPalSelection.}MouseRelease; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (TPalView(SELF.view).ChangedSelection(SELF.selCol, SELF.selRow); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPalSelection.}Res{ Provides the framework for a palette view consisting of a rectangular array of palette boxes $(all the same size), and a selection into the palette. Clients must: $(1) subclass TPalView to implement a method for drawing the palette symbols $(2) after creating the TPalView, create a TPalSelection in the panel (the same TPalSelection is ,reused throughout) Clients may: $(1) subclass TPalSelection, in order to implement NewCommand *** THINGS TO CONSIDER *** Handling commands without subclassing TPalSelection Adding a flag to indicate whether to blink the highlighting rapidly If user changes his mind after clicking in palette Handle mouse outside palette } UNIT UPalette; {$E ERRORS.TEXT} {$E+} {go into the editor automagically} INTERFACE USES "{$U UObject} UObject, "{$U QuickDraw} QuickDraw, "{$U UDraw} UDraw, "{$U UABC} UABC; CONST $palKind = 1; TYPE $TPalView = SUBCLASS OF TView &{Fields} (palBoxH: LONGINT; (palBoxV: LONGINT; (numCols: INTEGER; (numRows: INTEGER; &{Creation/Destruction} (FUNCTION {TPalView.}CREATE(object: TObject; itsHeap: THeap; itsPanel: TPanel; itsBoxH, AitsBoxV: LONGINT; itsNumCols, itsNumRows: INTEGER): TPalView; ({NOTE: rows and columns are numbered from 1} &{Display/Display Metrics} (PROCEDURE {TPalView.}BoxWith(lPt: LPoint; VAR atCol, atRow: INTEGER); (PROCEDURE {TPalView.}ChangedSelection(atCol, atRow: INTEGER); 0{Called by TPalSelection.SetSelection, and TPalSelection.Restore 4in case the view wants to do something when the selection changes; 4clients should not call this directly.} (PROCEDURE {TPalView.}GetBoxLRect(atCol, atRow: INTEGER; VAR boxLRect: LRect); '{PROCEDURE TPalView. Draw;} (PROCEDURE {TPalView.}DrawSymbol(atCol, atRow: INTEGER); (PROCEDURE {TPalView.}HighlightSymbol(atCol, atRow: INTEGER; highTransit: THighTransit); $END; $TPalSelection = SUBCLASS OF TSelection &{Fields} (selCol: INTEGER; (selRow: INTEGER; &{Creation/Destruction} (FUNCTION {TPalSelection.}CREATE(object: TObject; itsHeap: THeap; itsView: TPalView): TPalSelection; ,{initial selection is column 1, row 1} &{Highlighting} '{PROCEDURE TPalSelection. Highlight(highTransit: THighTransit);} (PROCEDURE {TPalSelection.}SetSelection(atCol, atRow: INTEGER; HfDoHighlight, fUnconditional, fNotifyView: BOOLEAN); ,{if fDoHighlight is TRUE, updates the highlighting; -if fUnconditional is FALSE, then first checks to see if the current selection matches 0the desired one, and if so does no highlighting; -if fNotifyView is TRUE and the selection is different or fUnconditional is TRUE then we 0will call TPalView.ChangedSelection with the new selection} &{Mouse Tracking} '{PROCEDURE TPalSelection. MouseMove(mouseLPt: LPoint);} '{PROCEDURE TPalSelection. MousePress(mouseLPt: LPoint);} '{PROCEDURE TPalSelection. MouseRelease;} ,{MouseRelease just calls TPalView.ChangedSelection} &{Commands} '{FUNCTION TPalSelection. NewCommand(cmdNumber: TCmdNumber): TCommand;} '{PROCEDURE TPalSelection. Restore;} $END; IMPLEMENTATION METHODS OF TPalView; $FUNCTION {TPalView.}CREATE{(object: TObject; itsHeap: THeap; itsPanel: TPanel; itsBoxH, itsBoxV: LONGINT; FitsNumCols, itsNumRows: INTEGER): TPalView}; (VAR extentLRect: LRect; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (SetLRect(extentLRect, 0, 0, (itsBoxH+1)*itsNumCols-1, (itsBoxV+1)*itsNumRows-1); (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TPalView(itspanel.NewStatusView(object, extentLRect)); (WITH SELF DO ,BEGIN ,palBoxH := itsBoxH; ,palBoxV := itsBoxV; ,numCols := itsNumCols; ,numRows := itsNumRows; ,scrollPastEnd := zeroPt; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TPalView.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (TView.Fields(Field); (Field('palBoxH: LONGINT'); (Field('palBoxV: LONGINT'); (Field('numCols: INTEGER'); (Field('numRows: INTEGER'); (Field(''); $END; ${$ENDC} $PROCEDURE {TPalView.}BoxWith{(lPt: LPoint; VAR atCol, atRow: INTEGER)}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (WITH SELF DO ,BEGIN ,atCol := (lPt.h DIV (palBoxH+1)) + 1; ,IF atCol < 1 THEN 0atCol := 1 ,ELSE IF atCol > numCols THEN 0atCol := numCols; ,atRow := (lPt.v DIV (palBoxV+1)) + 1; ,IF atRow < 1 THEN 0atRow := 1 ,ELSE IF atRow > numRows THEN 0atRow := numRows; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPalView.}ChangedSelection(atCol, atRow: INTEGER); $BEGIN $END; $PROCEDURE {TPalView.}GetBoxLRect{(atCol, atRow: INTEGER; VAR boxLRect: LRect)}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (WITH SELF DO ,{$H-} ,IF (atCol >= 1) AND (atCol <= SELF.numCols) AND /(atRow >= 1) AND (atRow <= SELF.numRows) THEN 0BEGIN 0SetLRect(boxLRect, 0, 0, palBoxH, palBoxV); 0OffSetLRect(boxLRect, (atCol-1)*(palBoxH+1), (atRow-1)*(palBoxV+1)); 0END ,ELSE 0boxLRect := zeroLRect; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPalView.}Draw; (VAR row: INTEGER; ,col: INTEGER; ,boxLRect: LRect; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (PenNormal; (FOR row := 1 TO SELF.numRows DO ,FOR col := 1 TO SELF.numCols DO 0BEGIN 0SELF.GetBoxLRect(col, row, boxLRect); 0InsetLRect(boxLRect, -1, -1); 0IF LRectIsVisible(boxLRect) THEN 4BEGIN 4FrameLRect(boxLRect); 4SELF.DrawSymbol(col, row); 4END; 0END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPalView.}DrawSymbol{(atCol, atRow: INTEGER)}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPalView.}HighlightSymbol{(atCol, atRow: INTEGER; highTransit: THighTransit)}; (VAR boxLRect: LRect; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (thePad.SetPenToHighlight(highTransit); (PenSize(2, 1); (SELF.GetBoxLRect(atCol, atRow, boxLRect); (FrameLRect(boxLRect); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TPalSelection; $FUNCTION {TPalSelection.}CREATE{(object: TObject; itsHeap: THeap; itsView: TPalView): TPalSelection}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TPalSelection(TSelection.CREATE(object, itsHeap, itsView, palKind, zeroLPt)); (WITH SELF DO ,BEGIN ,selCol := 1; ,selRow := 1; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TPalSelection.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (TSelection.Fields(Field); (Field('selCol: INTEGER'); (Field('selRow: INTEGER'); (Field(''); $END; ${$ENDC} $PROCEDURE {TPalSelection.}Highlight{(highTransit: THighTransit)}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (WITH SELF DO ,{$H-} ,TPalView(view).HighlightSymbol(selCol, selRow, highTransit); ,{$H+} ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPalSelection.}MousePress{(mouseLPt: LPoint)}; (VAR newCol: INTEGER; ,newRow: INTEGER; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (TPalView(SELF.view).BoxWith(mouseLPt, newCol, newRow); (SELF.SetSelection(newCol, newRow, TRUE, TRUE, FALSE); <{the TRUEs means the highlighting will blink rapidly} ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPalSelection.}MouseMove{(mouseLPt: LPoint)}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (SELF.MousePress(mouseLPt); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPalSelection.}MouseRelease; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (TPalView(SELF.view).ChangedSelection(SELF.selCol, SELF.selRow); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPalSelection.}Restore; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (SUPERSELF.Restore; (TPalView(SELF.view).ChangedSelection(SELF.selCol, SELF.selRow); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPalSelection.}SetSelection{(atCol, atRow: INTEGER; LfDoHighlight, fUnconditional, fNotifyView: BOOLEAN)}; (VAR panel: TPanel; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF fUnconditional OR (atCol <> SELF.selCol) OR (atRow <> SELF.selRow) THEN ,BEGIN ,panel := SELF.panel; ,IF fDoHighlight THEN 0panel.Highlight(SELF, hOnToOff); ,WITH SELF DO 0BEGIN 0selCol := atCol; 0selRow := atRow; 0END; *{Notify view} ,IF fNotifyView THEN 0TPalView(SELF.view).ChangedSelection(atCol, atRow); ,IF fDoHighlight THEN 0panel.Highlight(SELF, hOffToOn); ,END; ({$IFC fTrace}EP;{$ENDC} $END; "END; END. 3. "6F^9D!$ǐ^H3. "6F^9D!$ǐ^PROGRAM MCB2Sample; USES ${$U UObject } UObject, ${$U QuickDraw } QuickDraw, ${$U UDraw } UDraw, ${$U UABC } UABC, ${$U UCB2Sample } UCB2Sample; {Your application's unit(s)} CONST $phraseVersion = 1; BEGIN $process := TSamProcess.CREATE; {Your application's TProcess subclass} $process.Commence(phraseVersion); $process.Run; $process.Complete(TRUE); END. $END; END; G5TK4̆V{tITOR.OBJ̆^Hg :a$kTk:)$ "#." #"##%& ! 3. "6F^9DED!$ǐ^[>/,,-#BOOT-) Command; TSamWindow; N;} w; x-drawing application for the Tool Kit} ${Copyright 1983, Apple Computer Inc.} UNIT U1Boxer; INTERFACE USES ${$U UObject} UObject, #{Two Panel CheckerBoard Test application for the Tool Kit} "{ This program has a few enhancements over the one panel version, including optimzing screen (updates and mouse dragging within the panels } UNIT UCB2Sample; INTERFACE {$SETC ColHeadings := TRUE} $USES ({$U UObject} UObject, ({$U QuickDraw} QuickDraw, ({$U UDraw} UDraw, (* OTHER BUILDING BLOCKS IF WANTED *) ({$U UABC} UABC; "CONST ${ Colors } (colorWhite = 0; (colorLtGray = 1; (colorGray = 2; (colorDkGray = 3; (colorBlack = 4; ${ Menu commands } (uWhite = 1006; (uLtGray = 1007; (uGray = 1008; (uDkGray = 1009; (uBlack = 1010; {$IFC ColHeadings} (uShowHeads = 1100; (uHideHeads = 1101; {$ENDC} ${ Board Dimensions } (numRows = 8; { # rows } (numCols = 8; { # cols } (boxH = 45; { width of a box } (boxV = 30; { height of a box } (txMargin = 4; { horizontal space between view and edge of text } ${ Selection kind } (samKind = 1; $TYPE ${ Numbers used in the view to represent the color of a square } (TColor = ColorWhite..ColorBlack; ${ The checkerboard itself } (TCheckerboard = SUBCLASS OF TObject ({Fields} ,boxes: ARRAY[1..numrows, 1..numcols] OF TColor; ({Creation} ,FUNCTION {TCheckerboard.}CREATE(object: TObject; heap: THeap): TCheckerboard; ({Accessing} ,PROCEDURE {TCheckerboard.}ColorAlternating(evenColor, oddColor: TColor); 8{ color the checkerboard; boxes with row+col even are made evenColor @otherwise oddColor } ,FUNCTION {TCheckerboard.}GetColor(rowIndex, colIndex: INTEGER): TColor; ,PROCEDURE {TCheckerboard.}SetColor(rowIndex, colIndex: INTEGER; color: TColor); (END; ${ The "process" controlling this application } (TSamProcess = SUBCLASS OF TProcess ({Creation} ,FUNCTION {TSamProcess.}CREATE: TSamProcess; +{FUNCTION TSamProcess. NewDocManager(volumePrefix: TFilePath): TDocManager;} (END; ${ Manager of the application's document} (TSamDocManager = SUBCLASS OF TDocManager ({Creation} ,FUNCTION {TSamDocManager.}CREATE(object: TObject; heap: THeap; HitsPathPrefix: TFilePath): TSamDocManager; +{FUNCTION TSamDocManager. NewWindow(heap: THeap; WmgrId: TWindowId): TWindow;} (END; ${ Common code and data of each view } (TSamView = SUBCLASS OF TView ({Fields} ,window: TSamWindow; { gives us an easy way to access the color database } ({Creation} ,FUNCTION {TSamView.}CREATE(object: TObject; heap: THeap; itsExtent: LRect; DitsPanel: TPanel): TSamView; ({Selection} +{PROCEDURE TSamView. MousePress(mouseLPt: LPoint);} +{PROCEDURE TSamView. MouseMove(mouseLPt: LPoint);} 4{ adding this method will implement selections while button is down } ,FUNCTION {TSamView.}NewSelection(rowIndex, colIndex: INTEGER): TSamSelection; ABSTRACT; 4{ Create a new selection of the appropriate class; this is called by :>'vv$UCB2SAMPLE.TEXTxxNUCB2SAMPLE.TEXTLE.TEXTE.TE̍V"N.8~.8vv( :#''̍VLH.9̍h2 ̍V*-#1#1-Samples-UCB2SAM{utility function to convert a menu command number into a TColor} FUNCTION CvtCmdNumber(cmdNumber: TCmdNumber): TColor; BEGIN $CvtCmdNumber := cmdNumber - uWhite + colorWhite; END; METHODS OF TCheckerboard; $FUNCTION {TCheckerboard.}CREATE{(object: TObject; heap: THeap): TCheckerboard}; $VAR rowIndex: INTEGER; (colIndex: INTEGER; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TCheckerboard(object); ({ initialize to all white squares } (WITH SELF DO ,FOR rowIndex := 1 TO numrows DO 0FOR colIndex := 1 TO numcols DO 4boxes[rowIndex, colIndex] := colorWhite; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TCheckerboard.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('boxes: ARRAY[1..8, 1..8] OF Byte'); (Field(''); $END; ${$ENDC} $PROCEDURE {TCheckerboard.}ColorAlternating{(evenColor, oddColor: TColor)}; $VAR rowIndex: INTEGER; (colIndex: INTEGER; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (FOR rowIndex := 1 TO numRows DO ,FOR colIndex := 1 TO numCols DO 0IF ODD(rowIndex+colIndex) THEN 4SELF.SetColor(rowIndex, colIndex, oddColor) 0ELSE 4SELF.SetColor(rowIndex, colIndex, evenColor); ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TCheckerboard.}GetColor{(rowIndex, colIndex: INTEGER): TColor}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (GetColor := SELF.boxes[rowIndex, colIndex]; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TCheckerboard.}SetColor{(rowIndex, colIndex: INTEGER; color: TColor)}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.boxes[rowIndex, colIndex] := color; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TSamProcess; { Required boiler plate } $FUNCTION {TSamProcess.}CREATE; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF := TSamProcess(TProcess.CREATE(NewObject(mainHeap, THISCLASS), mainHeap)); ({$IFC fTrace}EP;{$ENDC} $END; { Required boiler plate } $FUNCTION {TSamProcess.}NewDocManager{(volumePrefix: TFilePath; openAsTool: BOOLEAN): TDocManager}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (NewDocManager := TSamDocManager.CREATE(NIL, mainHeap, volumePrefix); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TSamDocManager; { Required boiler plate} $FUNCTION {TSamDocManager.}CREATE{(object: TObject; heap: THeap; HitsPathPrefix: TFilePath): TSamDocManager}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TSamDocManager(TDocManager.CREATE(object, heap, itsPathPrefix)); ({$IFC fTrace}EP;{$ENDC} $END; { Required boiler plate} $FUNCTION {TSamDocManager.}NewWindow{(heap: THeap; WmgrId: TWindowId): TWindow}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (NewWindow := TSamWindow.CREATE(NIL, heap, wmgrID); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TSamView; $FUNCTION {TSamView.}CREATE{(object: TObject; heap: THeap; itsExtent: LRect; DitsPanel: TPanel): TSamView}; (VAR res: Point; ,margins: LRect; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (res := screenRes; (SetLRect(margins, res.h, res.v, res.h, res.v); {1" each, whatever the resolution} (SELF := TSamView(TView.CREATE(object, heap, itsPanel, itsExtent, ,TPrintManager.CREATE(NIL, heap), margins, FALSE, res, TRUE)); (SELF.window := TSamWindow(itsPanel.window); ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TSamView.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('window: TSamWindow'); (Field(''); $END; ${$ENDC} { return the first/last row/column that needs updating; $0 <= firstRow <= numRows+1; $0 <= firstCol <= numCols+1; $0 <= lastRow <= numRows; $0 <= lastCol <= numCols } $PROCEDURE {TSamView.}GetDrawLimits{(VAR firstRow, firstCol, lastRow, lastCol: INTEGER)}; (VAR r: LRect; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (r := thePad.visLRect; (SELF.LPtToRowCol(firstRow, firstCol, r.topLeft); ({ NOTE: in QuickDraw, r.botRight is not inside the rectangle, so move it by 1 pixel } (WITH r DO ,SetLPt(botRight, botRight.h-1, botRight.v-1); (SELF.LPtToRowCol(lastRow, lastCol, r.botRight); (lastRow := Min(lastRow, numRows); (lastCol := Min(lastCol, numCols); ({$IFC fTrace}EP;{$ENDC} $END; { just make believe it was a mouse press; the selection code does nothing if the same box is selected } $PROCEDURE {TSamView.}MouseMove{(mouseLPt: LPoint)}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.MousePress(mouseLPt); ({$IFC fTrace}EP;{$ENDC} $END; { Calculate the new selected box, and make the selection in both panels } $PROCEDURE {TSamView.}MousePress{(mouseLPt: LPoint)}; $VAR rowIndex: INTEGER; (colIndex: INTEGER; (panel: TPanel; (samWindow: TSamWindow; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (panel := SELF.panel; (samWindow := TSamWindow(panel.window); (SELF.LPtToRowCol(rowIndex, colIndex, mouseLPt); (IF (rowIndex < 1) OR (rowIndex > 8) OR (colIndex < 1) OR (colIndex > 8) THEN ,rowIndex := 0; { this signifies no selection } (samWindow.Select(panel, rowIndex, colIndex); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TSamCBView; $FUNCTION {TSamCBView.}CREATE{(object: TObject; heap: THeap; itsPanel: TPanel @itsBoxH, itsBoxV: INTEGER): TSamCBView}; $VAR r: LRect; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); 8{allow for 1 pixel all the way around} (SetLRect(r, 0, 0, numCols*itsBoxH+2, numRows*itsBoxV+2); (SELF := TSamCBView(TSamView.CREATE(object, heap, r, itsPanel)); (WITH SELF DO ,BEGIN ,boxH := itsBoxH; ,boxV := itsBoxV; ,allowMouseOutside := TRUE; {because of row/column headings} ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TSamCBView.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('boxH: INTEGER'); (Field('boxV: INTEGER'); (Field(''); $END; ${$ENDC} { Draw all the boxes; this routine optimizes the drawing } $PROCEDURE {TSamCBView.}Draw; $VAR r: LRect; (CB: TCheckerboard; (rowIndex: INTEGER; (colIndex: INTEGER; (firstRow: INTEGER; (lastRow: INTEGER; (firstCol: INTEGER; (lastCol: INTEGER; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} ({ draw thin black line around whole checkerboard } (PenNormal; (r := SELF.extentLRect; (FrameLRect(r); (SELF.GetDrawLimits(firstRow, firstCol, lastRow, lastCol); (CB := SELF.window.CB; ({ Draw the necessary squares; compare this loop with that in the text view } (FOR rowIndex := firstRow TO lastRow DO ,FOR colIndex := firstCol TO lastCol DO { index through the row } 0IF (rowIndex = 0) OR (colIndex = 0) THEN 4SELF.DrawHeading(rowIndex, colIndex) 0ELSE 4SELF.DrawBox(CB.GetColor(rowIndex, colIndex), rowIndex, colIndex); ({$IFC fTrace}EP;{$ENDC} $END; { Draw one box in a given color; this is a method so that someone can easily change the (way in which boxes are drawn and/or colored.} $PROCEDURE {TSamCBView.}DrawBox{(itsColor: TColor; rowIndex, colIndex: INTEGER)}; $VAR tempBox: LRect; (LPat: LPattern; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} ({ The tool kit makes no assumptions about the pen. You set it when you want to use it. } (PenNormal; (PenSize(3,2); ({ Calculate the rectangle to fill } (SELF.SetUpBox(rowIndex, colIndex,tempBox); (IF LRectIsVisible(tempBox) THEN { only draw boxes that need to be drawn } ,BEGIN ,CASE itsColor OF 0colorWhite: LPat := lPatWhite; 0colorLtGray: LPat := lPatLtGray; 0colorGray: LPat := lPatGray; 0colorDkGray: LPat := lPatDkGray; 0colorBlack: LPat := lPatBlack; 0OTHERWISE LPat := lPatWhite; {should not happen} 0END; ,FillLRect(tempBox, LPat); ,FrameLRect(tempBox); ,END; ({$IFC fTrace}EP;{$ENDC} $END; { Draw a row or column heading.} $PROCEDURE {TSamCBView.}DrawHeading{(rowIndex, colIndex: INTEGER)}; $VAR tempBox: LRect; (str: S255; (fInfo: FontInfo; (target: LPoint; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} ({either rowIndex=0 or colIndex=0} ({$IFC fDbgOK} (IF (rowIndex <> 0) AND (colIndex <> 0) THEN ,ABCBreak('(rowIndex <> 0) AND (colIndex <> 0)', 0); ({$ENDC} (IF rowIndex <> colIndex THEN {if both are 0, nothing to do} ,BEGIN ,{ The tool kit makes no assumptions about the pen. You set it when you want to use it. } ,PenNormal; ,PenSize(1, 1); ,TextFont(fIDSystem); ,TextFace([]); ,GetFontInfo(fInfo); ,IntToStr(rowIndex + colIndex, @str); ,{ Calculate the rectangle to fill } ,SELF.SetUpBox(rowIndex, colIndex, tempBox); ,IF LRectIsVisible(tempBox) THEN { only draw boxes that need to be drawn } 0BEGIN 0WITH tempBox DO 4IF rowIndex = 0 THEN 8SetLPt(target, (left + right) DIV 2, Gtop + ((bottom - top) DIV 4)) 4ELSE 8SetLPt(target, left + ((right - left) DIV 4), G(top + bottom) DIV 2); 0WITH target DO 4BEGIN 4h := h - (StringWidth(str) DIV 2); 4v := v + ((fInfo.ascent - fInfo.descent) DIV 2); 4END; 0MoveToL(target.h, target.v); 0DrawString(str); 0IF rowIndex = 0 THEN 4InsetLRect(tempBox, 1, 0) 0ELSE 4InsetLRect(tempBox, 0, 1); 0FrameLRect(tempBox); 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; { return a new selection appropriate to this view } $FUNCTION {TSamCBView.}NewSelection{(rowIndex, colIndex: INTEGER): TSamSelection}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (NewSelection := TSamCBSelection.CREATE(NIL, SELF.Heap, SELF, rowIndex, colIndex); ({$IFC fTrace}EP;{$ENDC} $END; { Decide what Row-Column box is indicated by this point; return FALSE iff not in checkerboard $or in row/column headings } $PROCEDURE {TSamCBView.}LPtToRowCol{(VAR rowIndex, colIndex: INTEGER; lPt: LPoint)}; $VAR r: LRect; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} ({ r is the rectangle containing the checkerboard } (r := SELF.extentLRect; (InsetLRect(r, -boxH, -boxV); (LRectHaveLPt(r, lPt); (WITH SELF DO ,BEGIN ,rowIndex := ((lPt.v+boxV-1) DIV boxV); {the -1 allows for the border} ,colIndex := ((lPt.h+boxH-1) DIV boxH); ,END; &{$IFC fTrace}EP;{$ENDC} $END; { Create a rectangle, for this Row-Column index. } $PROCEDURE {TSamCBView.}SetUpBox{(rowIndex, colIndex: INTEGER; VAR bbox: LRect)}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (WITH SELF, bbox DO ,BEGIN ,left := boxH * (colIndex - 1) + 1; {extra pixel for border} ,top := boxV * (rowIndex -1) + 1; {extra pixel for border} ,right := left + boxH; ,bottom := top + boxV; ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TSamTXView; $FUNCTION {TSamTXView.}CREATE{(object: TObject; heap: THeap; itsPanel: TPanel): TSamTXView}; $VAR longStr: S255; (fInfo: FontInfo; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); ({ use a temporary extent rect, until we can calculate the correct one } (SELF := TSaMTXView(TSamView.CREATE(object, heap, zeroLRect, itsPanel)); (PushFocus; (itsPanel.window.Focus; (SELF.SetPen; { set pen assumes that focus has been done } (GetFontInfo(fInfo); (SELF.GetBoxString(1, 1, MAXINT, longStr); { use an unknown color to get longest string } (WITH fInfo, SELF, extentLRect DO ,BEGIN ,lineHeight := ascent + descent + leading + 1; ,lineAscent := ascent + (leading DIV 2) - 1; &{$H-} right := StringWidth(longStr) + 2*txMargin; {$H+} ,bottom := (numRows*numCols*lineHeight); ,END; (PopFocus; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TSamTxView.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('lineHeight: INTEGER'); (Field('lineAscent: INTEGER'); (Field(''); $END; ${$ENDC} { return the string used to describe a row/col/color combination; this is a method so $people can override it if needed } $PROCEDURE {TSamTxView.}GetBoxString{(rowIndex, colIndex: INTEGER; color: INTEGER; IVAR str: S255)}; $VAR tmpStr: S255; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IntToStr(rowIndex, @tmpStr); (str := CONCAT('R', tmpStr, '-'); (IntToStr(colIndex, @tmpStr); (str := CONCAT(str, 'C', tmpStr, ' '); (CASE color OF ,colorWhite: tmpStr := 'White'; ,colorLtGray: tmpStr := 'Light Gray'; ,colorGray: tmpStr := 'Gray'; ,colorDkGray: tmpStr := 'Dark Gray'; ,colorBlack: tmpStr := 'Black'; ,OTHERWISE tmpStr := 'Unknown Color'; {should not happen, except for ]determining the longest possible string} ,END; (str := CONCAT(str, tmpStr); ({$IFC fTrace}EP;{$ENDC} $END; { Draw all the boxes; this routine optimizes the drawing } $PROCEDURE {TSamTXView.}Draw; $VAR samWindow: TSamWindow; (rowIndex: INTEGER; (colIndex: INTEGER; (c1,c2: INTEGER; (firstRow: INTEGER; (lastRow: INTEGER; (firstCol: INTEGER; (lastCol: INTEGER; (color: TColor; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.GetDrawLimits(firstRow, firstCol, lastRow, lastCol); (samWindow := SELF.window; ({ do first row } (FOR colIndex := firstCol TO numcols DO ,BEGIN ,color := samWindow.CB.GetColor(firstRow, colIndex); ,SELF.DrawName(color, firstRow, colIndex); ,END; ({ do middle rows } (FOR rowIndex := firstRow+1 to lastRow-1 DO ,FOR colIndex := 1 to numcols DO 0BEGIN 0color := samWindow.CB.GetColor(rowIndex, colIndex); 0SELF.DrawName(color, rowIndex, colIndex); 0END; ({ do last row } (FOR colIndex := 1 to lastCol DO ,BEGIN ,color := samWindow.CB.GetColor(lastRow, colIndex); ,SELF.DrawName(color, lastRow, colIndex); ,END; ({$IFC fTrace}EP;{$ENDC} $END; { Draw one box as a text string. } $PROCEDURE {TSamTXView.}DrawName{(itsColor: TColor; rowIndex, colIndex: INTEGER)}; $VAR tempBox: LRect; (str: S255; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} ({ The tool kit makes no assumptions about the pen. You set it when you want to use it. } (SELF.SetPen; ({ Calculate the rectangle to fill } (SELF.SetUpBox(rowIndex, colIndex,tempBox); (IF LRectIsVisible(tempBox) THEN { only draw boxes that need to be drawn } ,BEGIN ,SELF.GetBoxString(rowIndex, colIndex, itsColor, str); ,MoveToL(tempBox.left + txMargin, tempBox.top + SELF.lineAscent); ,DrawString(str); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TSamView.}NewSelection{(rowIndex, colIndex: INTEGER): TSamSelection}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (NewSelection := TSamTxSelection.CREATE(NIL, SELF.Heap, SELF, rowIndex, colIndex); ({$IFC fTrace}EP;{$ENDC} $END; { Decide what Row-Column box is indicated by this point; return FALSE iff not in checkerboard } $PROCEDURE {TSamTXView.}LPtToRowCol{(VAR rowIndex, colIndex: INTEGER; lPt: LPoint)}; $VAR index: INTEGER; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (WITH SELF DO ,index := (lPt.v DIV lineHeight); { index should be in [0..numrows*numcols-1] } (IF index < 0 THEN ,BEGIN ,rowIndex := 0; ,colIndex := 0; ,END (ELSE IF index > (numRows*numCols)-1 THEN ,BEGIN ,rowIndex := numRows + 1; ,colIndex := numCols + 1; ,END (ELSE ,BEGIN ,{ convert index to row/col } ,rowIndex := (index DIV numcols) + 1; { rowIndex is in [1..numrows] } ,colIndex := (index MOD numcols) + 1; { colIndex is in [1..numcols] } ,END; &{$IFC fTrace}EP;{$ENDC} $END; { Set up the pen for drawing the characters; assumes that we are focused on the right window ((or a pad in the right window); this is a method so it can be overridden } $PROCEDURE {TSamTXView.}SetPen; $BEGIN &{$IFC fTrace}BP(10);{$ENDC} &PenNormal; &TextFont(fIDSystem); { system font } &TextFace([]); &{$IFC fTrace}EP;{$ENDC} $END; { Create a rectangle, for this Row-Column index. } $PROCEDURE {TSamTXView.}SetUpBox{(rowIndex, colIndex: INTEGER; VAR bbox: LRect)}; $VAR index: INTEGER; { number of the line to draw; [0..numrow*numcols-1] } $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (index := numcols*(rowIndex-1) + colIndex-1; { index is in [0..numcols*numrows-1] } ({ use same left and right as view , calculate the top and bottom } (WITH SELF, bbox DO ,BEGIN ,left := SELF.extentLRect.left; ,top := (index * lineHeight); ,right := SELF.extentLRect.right; ,bottom := top + lineHeight; ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TSamSelection; $FUNCTION {TSamSelection.}CREATE{(object: TObject; heap: THeap; itsView: TSamView; CselRow, selCol: INTEGER): TSamSelection}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TSamSelection(TSelection.CREATE(object, heap, itsView, samKind, zeroLPt)); (WITH SELF DO ,BEGIN ,row := selRow; ,col := selCol; ,END; ({$H-} (itsView.SetupBox(selRow, selCol, SELF.boundLRect); ({$H+} ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TSamSelection.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('row: INTEGER'); (Field('col: INTEGER'); (Field(''); $END; ${$ENDC} { set up the state of all the menu items before the user gets to see them } $FUNCTION {TSamSelection.}CanDoCommand{(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN}; $VAR enable: BOOLEAN; (cmd: INTEGER; (samSelection: TSamSelection; (color: TColor; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (enable := SELF.kind <> nothingKind; (IF enable THEN ,color := TSamWindow(SELF.window).CB.GetColor(SELF.row, SELF.col); (CASE cmdNumber OF ,uWhite, uLtGray, uGray, ,uDkGray, uBlack: 0BEGIN 0CanDoCommand := enable; 0checkIt := enable AND (CvtCmdNumber(cmdNumber) = color); 0END; ,OTHERWISE 0CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TSamSelection.}NewCommand{(cmdNumber: TCmdNumber): TCommand}; $VAR samWindow: TSamWindow; (oldColor: TColor; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (CASE cmdNumber OF ,uWhite, uLtGray, uGray, uDkGray, uBlack: <{ This is the only Menu command that needs to be handled by this Application } 0BEGIN 0samWindow := TSamWindow(SELF.window); 0WITH SELF DO {$H-} 4oldColor := samWindow.CB.GetColor(row, col); 0{don't do anything of old & new colors are the same} 0IF oldColor = CvtCmdNumber(cmdNumber) THEN 4NewCommand := NIL 0ELSE 4NewCommand := TRecolorCommand.CREATE(NIL, SELF.Heap, samWindow, SELF, cmdNumber); 0END; ,OTHERWISE { The ABCs do the rest! } 0NewCommand := TSelection.NewCommand(cmdNumber); ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TSamCBSelection; $FUNCTION {TSamCBSelection.}CREATE{(object: TObject; heap: THeap; itsView: TView; JselRow, selCol: INTEGER): TSamCBSelection}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TSamCBSelection(TSamSelection.CREATE(object, heap, itsView, selRow, selCol)); ({$IFC fTrace}EP;{$ENDC} $END; { Required to highlight the indication in the already-focused pad } $PROCEDURE {TSamCBSelection.}Highlight{(highTransit: THighTransit)}; $VAR r: LRect; (samView: TSamView; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF HighTransit <> hNone THEN ,BEGIN ,{ This application frames the box to indicate it is selected } ,{ Make r be the rectangle to frame } ,samView := TSamView(SELF.view); ,samView.SetupBox(SELF.row, SELF.col, r); ,IF LRectIsVisible(r) THEN { only do highlight if part of the frame is visible } 0BEGIN 0{ Choose an appropriate pen mode for the highlight transition } 0{ The highPen array assumes you want black for on, gray for dim, and that both are xor'ed } 0SetPenState(highPen[highTransit]); 0PenSize(1, 1); 0FrameLRect(r); 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TSamTXSelection; $FUNCTION {TSamTXSelection.}CREATE{(object: TObject; heap: THeap; itsView: TView; JselRow, selCol: INTEGER): TSamSelection}; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TSamTXSelection(TSamSelection.CREATE(object, heap, itsView, selRow, selCol)); ({$IFC fTrace}EP;{$ENDC} $END; { Required to highlight the indication in the already-focused pad } $PROCEDURE {TSamTXSelection.}Highlight{(highTransit: THighTransit)}; $VAR r: LRect; (samView: TSamView; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF HighTransit <> HNone THEN ,BEGIN ,{ This application inverts the text string to indicate it is selected; when deactivated, 4the highlighting changes to a thin black rectangle } ,{ Make r be the rectangle to invert } ,samView := TSamView(SELF.view); ,samView.SetupBox(SELF.row, SELF.col, r); ,IF LRectIsVisible(r) THEN { only do highlighting if part of the rectangle is visible } 0BEGIN 0PenNormal; 0PenSize(1, 1); 0IF (highTransit = hOffToDim) OR (highTransit = hDimToOff) THEN 4FrameLRect(r) 0ELSE 4BEGIN 4IF (highTransit = hOnToDim) OR (highTransit = hDimToOn) THEN 8InsetLRect(r, 1, 1); 4InvrtLRect(r); 4END; 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TSamWindow; $FUNCTION {TSamWindow.}CREATE{(object: TObject; heap: THeap; itsWmgrId: TWindowId): TWindow}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TSamWindow(TWindow.CREATE(object, heap, itsWmgrID, TRUE)); (WITH SELF DO ,BEGIN ,CB := NIL; ,showRowColHeads := FALSE; ,cbPanel := NIL; ,txPanel := NIL; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TSamWindow.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('CB: TCheckerboard'); (Field('showRowColHeads: BOOLEAN'); (Field('cbPanel: TPanel'); (Field('txPanel: TPanel'); (Field(''); $END; ${$ENDC} { Create a blank document } $PROCEDURE {TSamWindow.}BlankStationery; $VAR board: TCheckerboard; (panel: TPanel; (aView: TSamView; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (board := TCheckerboard.CREATE(NIL, SELF.heap); (board.ColorAlternating(colorDkGray, colorWhite); (SELF.CB := board; (panel := TPanel.CREATE(NIL, SELF.heap, SELF, 2*boxH, 2*boxV, @[aScroll, aSplit], [aScroll, aSplit]); (SELF.cbPanel := panel; ({ ... and its view } (aView := TSamCBView.CREATE(NIL, SELF.Heap, panel, boxH, boxV); ({ ... then the Text panel (other 3/8 of horizontal space) ... } (panel := panel.Divide(h, -38, percentFromEdge, [userCanResizeIt, windowCanResizeIt], @0, [aScroll, aSplit], [aScroll]); (SELF.txPanel := panel; ({ ... and its view ...} (aView := TSamTxView.CREATE(NIL, SELF.Heap, panel); ({$IFC fTrace}EP;{$ENDC} $END; {$IFC ColHeadings} { set up the state of all the menu items before the user gets to see them } $FUNCTION {TSamWindow.}CanDoCommand{(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (CASE cmdNumber OF ,uShowHeads, uHideHeads: 0BEGIN 0CanDoCommand := TRUE; 0checkIt := (cmdNumber = uShowHeads) = SELF.showRowColHeads; 0END; ,OTHERWISE 0CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); ,END; ({$IFC fTrace}EP;{$ENDC} $END; {$ENDC} $PROCEDURE {TSamWindow.}InvalidateBox{(rowIndex, colIndex: INTEGER)}; $VAR s: TListScanner; (panel: TPanel; (samView: TSamView; (r: LRect; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (s := SELF.panels.Scanner; (WHILE s.Scan(panel) DO ,BEGIN ,samView := TSamView(panel.view); ,samView.SetupBox(rowIndex, colIndex, r); ,panel.InvalLRect(r); ,END; ({$IFC fTrace}EP;{$ENDC} $END; {$IFC ColHeadings} $FUNCTION {TSamWindow.}NewCommand{(cmdNumber: TCmdNumber): TCommand}; (VAR hSize: INTEGER; ,vSize: INTEGER; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (CASE cmdNumber OF ,uShowHeads, uHideHeads: 0BEGIN 0NewCommand := NIL; 0IF cmdNumber = uShowHeads THEN 4BEGIN 4hSize := boxH DIV 2; 4vSize := boxV DIV 2; 4END 0ELSE 4BEGIN 4hSize := -1; 4vSize := -1; 4END; 0SELF.cbPanel.ShowSideBand(v, TRUE, vSize, -boxV); 0SELF.cbPanel.ShowSideBand(h, TRUE, hSize, -boxH); 0SELF.cbPanel.ShowSideBand(v, FALSE, vSize, -boxV); 0SELF.cbPanel.ShowSideBand(h, FALSE, hSize, -boxH); 0SELF.showRowColHeads := cmdNumber = uShowHeads; 0END; ,OTHERWISE { The ABCs do the rest! } 0NewCommand := SUPERSELF.NewCommand(cmdNumber); ,END; ({$IFC fTrace}EP;{$ENDC} $END; {$ENDC} { make the selection in both panels; rowSel=0 means de-select; this routine does nothing if the $old and new selections are the same } $PROCEDURE {TSamWindow.}Select{(selectPanel: TPanel; rowSel, colSel: INTEGER)}; $VAR needToSelect: BOOLEAN; { TRUE iff old and new selections are different } (s: TListScanner; (panel: TPanel; (highTransit: THighTransit; (samView: TSamView; (aSelection: TSelection; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (aSelection := SELF.selectPanel.selection; (WITH aSelection DO ,IF kind = nothingKind THEN 0needToSelect := rowSel<>0 ,ELSE 0needToSelect := (rowSel<>TSamSelection(aSelection).row) OR @(colSel<>TSamSelection(aSelection).col); (IF needToSelect THEN ,BEGIN ,s := SELF.panels.Scanner; ,WHILE s.Scan(panel) DO 0BEGIN 0{ un-highlight the old selection } 0panel.Highlight(panel.selection, hOnToOff); 0samView := TSamView(panel.view); 0IF rowSel=0 THEN 4aSelection := samView.NoSelection 0ELSE 4aSelection := samView.NewSelection(rowSel, colSel); 0aSelection := panel.selection.FreedAndReplacedBy(aSelection); 0{ highlight the new selection } 0highTransit := hOffToOn; 0panel.Highlight(panel.selection, hOffToOn); 0IF panel = selectPanel THEN 4panel.BeSelectPanel(TRUE); 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TRecolorCommand; $FUNCTION {TRecolorCommand.}CREATE{(object: TObject; heap: THeap; itsWindow: TSamWindow; EcurrSelection: TSamSelection; EitsCmdNumber: TCmdNumber): TRecolorCommand}; $VAR oColor: TColor; (phase: TCmdPhase; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TRecolorCommand(TCommand.CREATE(object, heap, itsCmdNumber, NIL, TRUE, revealAll)); (WITH SELF, currSelection DO ,BEGIN ,selPanel := panel; ,rowChanged := row; ,colChanged := col; &{$H-} newColor := CvtCmdNumber(itsCmdNumber); ,oColor := itsWindow.CB.GetColor(row, col); {$H+} ,END; (WITH SELF DO ,BEGIN ,window := itsWindow; {be careful: currSelection has a window field also} ,oldColor := oColor; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TRecolorCommand.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('window: TSamWindow'); (Field('selPanel: TPanel'); (Field('rowChanged: INTEGER'); (Field('colChanged: INTEGER'); (Field('oldColor: Byte'); (Field('newColor: Byte'); (Field(''); $END; ${$ENDC} $PROCEDURE {TRecolorCommand.}Perform{(cmdPhase: TCmdPhase)}; $VAR samWindow: TSamWindow; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (samWindow := SELF.window; (samWindow.selectPanel.selection.MarkChanged; (WITH SELF DO {$H-} ,samWindow.InvalidateBox(rowChanged, colChanged); {$H+} (WITH SELF DO {$H-} ,CASE cmdPhase OF 0redoPhase, doPhase: samWindow.CB.SetColor(rowChanged, colChanged, newColor); 0undoPhase: samWindow.CB.SetColor(rowChanged, colChanged, oldColor); 0END; ({$IFC fTrace}EP;{$ENDC} $END; END; 3. "6F^9itD!$ǐ^ aH@N open the document. release of ing.^L^L 3. "6F^OK@640,26 ; phCancel = 143 143 Cancel@640,80 ; ALERTS 151-899 RESERVED FOR OTHER BUILDING BLOCKS ; ALERTS 900-999 RESERVED FOR THE ALERT MANAGER ;These alerts are used by the DTAlert routine of the alert manager. 901 ; singular/pl; PCBSAMPLE.TEXT for LisaChecker ;This is a sample phrase file for ToolKit applications ;NOTE: The wording of the alerts may not conform to the standards of the ; first release applications 1 3 2300 $-#boot-TK/PABC ; Apple building block phrase files can be included here 1000 LisaCheckers II ; Other application alerts can be included here, numbered between 1001 and 32000 0 1 $-#boot-tk/pabc~File/Print 2 Edit Undo Last Change#205 - Show Column & Row Headings#1100 Hide Column & Row Headings#1101 4 Shades White#1006 Light Gray#1007 Gray#1008 Dark Gray#1009 Black#1010 99 $-#boot-tk/pabc~Debug 100 $-#boot-tk/pabc~Buzzwords 1000 $-#boot-tk/pabc~Clipboard File/Print 0 3. "6F^9-#D!$ǐ^H7̍V̓v̓zpJNu̓z̍V̍~p̓”FFFˆp†p̍V®FPFP,̍̓zFFxpJNu̍~̍~ERg ̍̍~̓z},LOWER,[Force],pFF.̍V̍hV0̍~̍~p8pJļ̍~̍~88,FFFpNu"L̍h;The next 2 lines specify the default tool number and tool volume 206 ;no assembler files $ ;no building blocks $ ;no links $ ;install parameters: we handle documents; we handle >1 document; we don't change the opening rectangle y y n Checkerboard II $ 3. "6F^9. D!$ǐ^YHlication's TProcess subclass} 3. "6F^PROGRAM MClock; USES ${$U UObject } UObject, ${$U QuickDraw } QuickDraw, ${$U UDraw } UDraw, ${$U UABC } UABC, ${$U UClock } UClock; {Your application's unit(s)} CONST $phraseVersion = 1; BEGIN $process := TClkProcess.CREATE; {Your application's TProcess subclass} $process.Commence(phraseVersion); $process.Run; $process.Complete(TRUE); END. 3. "6F^9. D!$ǐ^YHlication's TProcess subclass} 3. "6F^UNIT UClock; INTERFACE USES ${$U UObject} UObject, ${$U QuickDraw} QuickDraw, ${$U UDraw} UDraw, ${$U UABC} UABC, ${$U -#BOOT-Syscall} Syscall, ${$U UTimer} UTimer; CONST $editLength = 18; $maxAlarms = 0; TYPE $TWhere = (hourBox, minBox, ampmBox, moBox, dayBox, yearBox, noBox); $TEditString = STRING[editLength]; $TClkProcess = SUBCLASS OF TProcess &{Variables} &{Creation/Destruction} (FUNCTION TClkProcess.CREATE: TClkProcess; (FUNCTION TClkProcess.NewDocManager(volumePrefix: TFilePath; PopenAsTool: BOOLEAN): TDocManager; OVERRIDE; (PROCEDURE TClkProcess.Complete(allIsWell: BOOLEAN); OVERRIDE &{Inter-process Communication} (PROCEDURE TClkProcess.HandlePrivateEvent(typeOfEvent: INTEGER; fromProcess: LONGINT; Twhen: LONGINT; otherData: LONGINT); OVERRIDE; (END; $TClkDocManager = SUBCLASS OF TDocManager &{Variables} &{Creation/Destruction} (FUNCTION TClkDocManager.CREATE(object: TObject; heap: THeap; itsPathPrefix: TFilePath; LitsProcess: TClkProcess): TClkDocManager; (PROCEDURE TClkDocManager.Free; OVERRIDE; (FUNCTION TClkDocManager.NewWindow(heap: THeap; wmgrID: TWindowID): TWindow; OVERRIDE; (END; $TClkWindow = SUBCLASS OF TWindow &{Variables} (panel: TPanel; (alarm: INTEGER; {# minutes before alarm; 0 if OFF} (views: ARRAY[0..maxAlarms] OF TClkView; &{Creation/Destruction} (FUNCTION TClkWindow.CREATE(object: TObject; heap: THeap; itsWmgrID: TWindowID): TClkWindow; &{Document Creation} (PROCEDURE TClkWindow.BlankStationery; OVERRIDE; &{Commands} (FUNCTION TClkWindow.CanDoCommand(cmdNumber: TCmdNumber;VAR checkIt: BOOLEAN): BOOLEAN; OVERRIDE; (FUNCTION TClkWindow.NewCommand(cmdNumber: TCmdNumber): TCommand; OVERRIDE; &{Display} (PROCEDURE TClkWindow.Activate; OVERRIDE; (PROCEDURE TClkWindow.ShowTime(update: BOOLEAN); (PROCEDURE TClkWindow.StashPicture(highTransit: THighTransit); OVERRIDE; (PROCEDURE TClkWindow.Tick; (END; $TClkView = SUBCLASS OF TView &{Variables} (editString: TEditString; (alarmNum: INTEGER; {0 means this is the actual time} &{Creation/Destruction} (FUNCTION TClkView.CREATE(object: TObject; heap: THeap; itsPanel: TPanel; Dalarm: INTEGER): TClkView; &{Display} (PROCEDURE TClkView.Draw; OVERRIDE; (PROCEDURE TClkView.EditChar(pos: INTEGER; newChar: CHAR); (FUNCTION TClkView.GetField(mouseLPt: LPoint): TWhere; (PROCEDURE TClkView.GetTime; (PROCEDURE TClkView.ShowTime(update: BOOLEAN); (END; IMPLEMENTATION {$I UClock2.text} END. 3. "6F^9ieD!$ǐ^[j1j1CTF}EP;{$ENDC} $END; $FUNCTION {TPickSelection.}NewCommand{(cmdNumber: TCmdNumber): TCommand}; (VAR pasteH: LONGINT; ,pasteV: LONGINT; ,samView: TSamView; ,heap: THeap; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (NewCommand := NIL; (samView := TSamView(SELF.view); (heap := SELF.Heap; (CASE cmdNumber OF ,uWhite, uLtGray, uGray, uDkGray, uBlack: 0NewCommand := TRecolorCmd.CREATE(NIL, heap, cmdNumber, samCONST $timeFont = fIDm10Pitch; $legendFont = fID15Pitch; $timeLegend = 'time'; $alarmLegend = 'alarm '; $hourOffset = 1; {fields positions within date/time string} $minOffset = 4; $ampmOffset = 7; $moOffset = 11; $dayOffset = 14; $yearOffset = 17; $displaySize = 18; $endJa = 31; $endFe = 59; $endMr = 90; $endAp = 120; $endMy = 151; $endJn = 181; $endJl = 212; $endAu = 243; $endSe = 273; $endOc = 304; $endNo = 334; $endDe = 365; $cln = ':'; $slh = '/'; $nullEditString = ' '; 6{123456789012345678} $uTimeMode = 1000; $uAlarm1Mode = 1001; $uAlarmOff = 2000; $uMaxAlarm = 2010; $phDing = 1001; TYPE $NumberStr = STRING[11]; VAR $editLRect: LRect; $hourLRect: LRect; $minLRect: LRect; $ampmLRect: LRect; $moLRect: LRect; $dayLRect: LRect; $yearLRect: LRect; $editRow: INTEGER; $editCol: INTEGER; $viewLRect: LRect; $legendV: LONGINT; $legendH: LONGINT; $legendLRect:LRect; $numWidth: INTEGER; {display metrics} $rowHt: INTEGER; $fAscent: INTEGER; $fDescent: INTEGER; $julianDays: ARRAY[0..12] OF INTEGER; $theWindow: TClkWindow; $theDoc: TClkDocManager; METHODS OF TClkProcess; $FUNCTION TClkProcess.CREATE: TClkProcess; (VAR osErr: INTEGER; ,fInfo: FontInfo; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF := TClkProcess(TProcess.CREATE(NewObject(mainHeap, THISCLASS), mainHeap)); (InitTimer(osErr); ({$IFC fDbgOK} (IF osErr > 0 THEN ,BEGIN ,ABCbreak('TClkProcess.CREATE: Error from InitTimer', osErr); ,HALT; ,END; ({$ENDC} (TextFont(timeFont); (TextFace([]); (GetFontInfo(fInfo); (WITH fInfo DO ,BEGIN ,rowHt := ascent + descent + leading + 4; ,fAscent := ascent; ,fDescent := descent; ,END; (numWidth := CharWidth('0'); (editRow := 1; (editCol := 1; (SetLRect(editLRect, editCol*numWidth, (editRow-1)*rowHt+fDescent+2, <(editCol+1)*numWidth, editRow*rowHt+fDescent+2); (WITH editLRect DO ,BEGIN ,SetLRect(hourLRect, left+(hourOffset*numWidth), top, @left+((hourOffset+2)*numWidth), bottom); ,SetLRect(minLRect, left+(minOffset*numWidth), top, @left+((minOffset+2)*numWidth), bottom); ,SetLRect(ampmLRect, left+(ampmOffset*numWidth), top, @left+((ampmOffset+1)*numWidth), bottom); ,SetLRect(moLRect, left+(moOffset*numWidth), top, @left+((moOffset+2)*numWidth), bottom); ,SetLRect(dayLRect, left+(dayOffset*numWidth), top, @left+((dayOffset+2)*numWidth), bottom); ,SetLRect(yearLRect, left+(yearOffset*numWidth), top, @left+((yearOffset+2)*numWidth), bottom); ,END; (TextFont(legendFont); (GetFontInfo(fInfo); (WITH fInfo, editLRect DO ,BEGIN ,SetLRect(viewLRect, 0, 0, yearLRect.right+numWidth, top+bottom+ascent+descent+leading); ,legendH := left; ,legendV := bottom+ascent; ,SetLRect(legendLRect, 0, top+bottom, viewLRect.right, viewLRect.bottom); ,END; (julianDays[00] := 0; (julianDays[01] := endJa; (julianDays[02] := endFe; (julianDays[03] := endMr; (julianDays[04] := endAp; (julianDays[05] := endMy; (julianDays[06] := endJn; (julianDays[07] := endJl; (julianDays[08] := endAu; (julianDays[09] := endSe; (julianDays[10] := endOc; (julianDays[11] := endNo; (julianDays[12] := endDe; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TClkProcess.Complete(allIsWell: BOOLEAN); (VAR osErr: INTEGER; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} (KillTimer(osErr); ({$IFC fDBGOK} (IF osErr > 0 THEN ,ABCBreak('Error from KillTimer = ', osErr); ({$ENDC} (SUPERSELF.Complete(allIsWell); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TClkProcess.HandlePrivateEvent(typeOfEvent: INTEGER; fromProcess: LONGINT; Pwhen: LONGINT; otherData: LONGINT); (VAR osErr: INTEGER; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF theWindow = NIL THEN ,BEGIN ,StopTimer(osErr); ,{$IFC fDbgOK} ,IF osErr > 0 THEN 0ABCbreak('TClkProcess.HandlePrivateEvent: Error from StopTimer', osErr); ,{$ENDC} ,END (ELSE ,BEGIN ,theDoc.Bind; ,theWindow .Tick; ,theDoc.Unbind; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TClkProcess.NewDocManager(volumePrefix: TFilePath; openAsTool: BOOLEAN): TDocManager; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF openAsTool OR (docList.size = 0) THEN ,theDoc := TClkDocManager.CREATE(NIL, mainHeap, volumePrefix, SELF) (ELSE ,theDoc := NIL; (NewDocManager := theDoc; ({$IFC fTrace}EP;{$ENDC} $END; BEGIN $theWindow := NIL; $theDoc := NIL; END; METHODS OF TClkDocManager; $FUNCTION TClkDocManager.CREATE(object: TObject; heap: THeap; itsPathPrefix: TFilePath; HitsProcess: TClkProcess): TClkDocManager; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TClkDocManager(TDocManager.CREATE(object, heap, itsPathPrefix)); (SELF.files.shouldSuspend := FALSE; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TClkDocManager.Free; $BEGIN ({$IFC fTrace}BP(4);{$ENDC} (theWindow := NIL; (theDoc := NIL; (SUPERSELF.Free; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TClkDocManager.NewWindow(heap: THeap; wmgrID: TWindowID):TWindow; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (theWindow := TClkWindow.CREATE(NIL, heap, wmgrID); (NewWindow := theWindow; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TClkWindow; $FUNCTION TClkWindow.CREATE(object: TObject; heap: THeap; itsWmgrID: TWindowID): TClkWindow; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TClkWindow(TWindow.CREATE(object, heap, itsWmgrID, TRUE)); (SELF.alarm := 0; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE TClkWindow.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('panel: TPanel'); (Field('alarm: INTEGER'); (Field('views: ARRAY[0..0] OF TClkView'); (Field(''); $END; ${$ENDC} $PROCEDURE TClkWindow.Activate; (VAR osErr: INTEGER; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (StartTimer(osErr); (SUPERSELF.Activate; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TClkWindow.BlankStationery; (VAR panel: TPanel; ,clkView: TClkView; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (panel := TPanel.CREATE(NIL, SELF.Heap, SELF, 0, 0, [], []); (clkView := TClkView.CREATE(NIL, SELF.Heap, panel, 0); (SELF.panel := panel; (SELF.views[0] := clkView; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TClkWindow.CanDoCommand(cmdNumber: TCmdNumber;VAR checkIt: BOOLEAN): BOOLEAN; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF (cmdNumber >= uAlarmOff) AND (cmdNumber <= uMaxAlarm) THEN ,BEGIN ,CanDoCommand := TRUE; ,checkIt := SELF.alarm = (cmdNumber - uAlarmOff); ,END (ELSE ,CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TClkWindow.NewCommand(cmdNumber: TCmdNumber): TCommand; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF (cmdNumber >= uAlarmOff) AND (cmdNumber <= uMaxAlarm) THEN ,BEGIN ,SELF.alarm := cmdNumber - uAlarmOff; ,NewCommand := NIL; ,END (ELSE ,NewCommand := SUPERSELF.NewCommand(cmdNumber); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TClkWindow.ShowTime(update: BOOLEAN); (VAR osErr: INTEGER; (PROCEDURE ShowTheTime; (BEGIN ,SELF.views[0].ShowTime(update); (END; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF SELF.IsVisible THEN ,SELF.panel.OnAllPadsDo(ShowTheTime) (ELSE ,BEGIN ,StopTimer(osErr); ,{$IFC fDbgOK} ,IF osErr > 0 THEN 0ABCbreak('TClkWindow.ShowTime: Error from StopTimer', osErr); ,{$ENDC} ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TClkWindow.StashPicture(highTransit: THighTransit); $BEGIN ({$IFC fTrace}BP(12);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TClkWindow.Tick; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF SELF.alarm = 1 THEN ,process.Note(phDing); (WITH SELF DO ,IF alarm > 0 THEN 0alarm := alarm - 1; (SELF.ShowTime(TRUE); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TClkView; $FUNCTION TClkView.CREATE(object: TObject; heap: THeap; itsPanel: TPanel; Dalarm: INTEGER): TClkView; (VAR itsExtent: LRect; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TClkView(itsPanel.NewStatusView(object, viewLRect)); (WITH SELF DO ,BEGIN ,editString := nullEditString; ,alarmNum := alarm; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE TClkView.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('editString: STRING[18]'); (Field('alarmNum: INTEGER'); (Field(''); $END; ${$ENDC} $FUNCTION TClkView.CursorAt(mouseLPt: LPoint): TCursorNumber; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF SELF.GetField(mouseLPt) = noBox THEN ,CursorAt := noCursor (ELSE ,CursorAt := crossCursor; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TClkView.Draw; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (SELF.ShowTime(FALSE); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TClkView.EditChar(pos: INTEGER; newChar: CHAR); (VAR left: LONGINT; ,tempLRect: LRect; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (left := editLRect.left + (pos*numWidth); (SetLRect(tempLRect, left, editLRect.top, left+numWidth, editLRect.bottom); (FillLRect(tempLRect, lPatWhite); (MoveToL(left, editRow*rowHt); (DrawChar(newChar); (SELF.editString[pos] := newChar; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TClkView.GetField(mouseLPt: LPoint): TWhere; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF LPtInLRect(mouseLPt, hourLRect) THEN ,GetField := hourBox (ELSE IF LPtInLRect(mouseLPt, minLRect) THEN ,GetField := minBox (ELSE IF LPtInLRect(mouseLPt, ampmLRect) THEN ,GetField := ampmBox (ELSE IF LPtInLRect(mouseLPt, moLRect) THEN ,GetField := moBox (ELSE IF LPtInLRect(mouseLPt, dayLRect) THEN ,GetField := dayBox (ELSE IF LPtInLRect(mouseLPt, yearLRect) THEN ,GetField := yearBox (ELSE ,GetField := noBox; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TClkView.GetTime; (VAR editString: TEditString; ,osErr: INTEGER; ,curTime: Time_Rec; ,localTime: Time_Rec; ,strVal: NumberStr; ,mo: INTEGER; ,day: INTEGER; (PROCEDURE InsertStr(offset: INTEGER); ,VAR i: INTEGER; 0lgth: INTEGER; (BEGIN ,lgth := Length(strVal); ,FOR i := 1 to lgth DO 0editString[offset+1+i-lgth] := strVal[i]; (END; (PROCEDURE JulianToMoDay(julian: INTEGER; leapYear: BOOLEAN; VAR mo, day: INTEGER); ,VAR feb29: BOOLEAN; 0i: INTEGER; (BEGIN ,feb29 := FALSE; ,IF leapYear AND (julian > endFe) THEN 0BEGIN 0IF julian = endFe+1 THEN 4feb29 := TRUE; 0julian := julian - 1; 0END; ,i := 12; ,WHILE julianDays[i] >= julian DO 0i := i - 1; ,mo := i+1; ,IF feb29 THEN 0day := 29 ,ELSE 0day := julian - julianDays[i]; (END; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (editString := nullEditString; (editString[minOffset-1] := ':'; (editString[dayOffset-1] := '/'; (editString[yearOffset-1] := '/'; (Get_Time(osErr, curTime); (Convert_Time(osErr, curTime, localTime, FALSE); (IF localTime.hour > 11 THEN ,BEGIN ,strVal := 'pm'; ,IF localTime.hour > 12 THEN 0localTime.hour := localTime.hour -12; ,END (ELSE ,BEGIN ,strVal := 'am'; ,IF localTime.hour = 0 THEN 0localTime.hour := 12; ,END; (InsertStr(ampmOffset); (IntToStr(localTime.hour, @strVal); (IF Length(strVal) = 1 THEN ,strVal := Concat(' ', strval); (InsertStr(hourOffset); (IntToStr(localTime.minute, @strVal); (IF Length(strVal) = 1 THEN ,strVal := Concat('0', strval); (InsertStr(minOffset); (JulianToMoDay(localTime.day, (localTime.year MOD 4) = 0, mo, day); (IntToStr(mo, @strVal); (IF Length(strVal) = 1 THEN ,strVal := Concat(' ', strval); (InsertStr(moOffset); (IntToStr(day, @strVal); (IF Length(strVal) = 1 THEN ,strVal := Concat('0', strval); (InsertStr(dayOffset); (IntToStr(localTime.year, @strVal); (Delete(strVal, 1, 2); (InsertStr(yearOffset); (SELF.editString := editString; ({$IFC fTrace}EP;{$ENDC} $END; (* &&& $PROCEDURE TClkView.MousePress(mouseLPt: LPoint); (VAR panel: TPanel; ,pickSelection: TPickSelection; ,pickedBox: TBox; ,sketchSelection: TSketchSelection; ,theKind: INTEGER; (PROCEDURE DeselectBox(object: TObject); ,VAR box: TBox; (BEGIN ,box := TBox(object); ,IF box.isSelected THEN 0BEGIN 0box.ToggleHighlight(SELF); 0IF pickedBox = NIL THEN {a click in space may be a deselect or a sketch-new-box; we won't} 4box.isSelected := TRUE; {know which until MouseRelease; save the selection until then} 0END; (END; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (panel := SELF.panel; (pickedBox := SELF.BoxWith(mouseLPt); (IF pickedBox = NIL THEN ,BEGIN ,SELF.EachVirtualPart(DeselectBox); ,sketchSelection := TSketchSelection(panel.selection.FreedAndReplacedBy( RTSketchSelection.CREATE(NIL, SELF.Heap, SELF, mouseLPt))); ,END (ELSE ,BEGIN ,IF NOT (pickedBox.isSelected OR clickState.fShift)THEN 0SELF.EachVirtualPart(DeselectBox); ,theKind := pickKind; ,IF clickState.fShift OR NOT pickedBox.isSelected THEN 0BEGIN 0IF pickedBox.isSelected THEN 4theKind := unPickKind; 0pickedBox.ToggleHighlight(SELF); 0END; ,pickSelection := TPickSelection(panel.selection.FreedAndReplacedBy( ATPickSelection.CREATE(NIL, SELF.Heap, SELF, theKind, mouseLPt))); ,END; ({$IFC fTrace}EP;{$ENDC} $END; *) (* $FUNCTION {TClkView.}NoSelection: TSelection; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (NoSelection := TPickSelection.CREATE(NIL, SELF.Heap, SELF, nothingKind, zeroLPt); ({$IFC fTrace}EP;{$ENDC} $END; *) (* $PROCEDURE {TClkView.}SetMinViewSize{(VAR minLRect: LRect)}; {+} $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (minLRect := viewLRect; ({$IFC fTrace}EP;{$ENDC} $END; *) $PROCEDURE TClkView.ShowTime(update: BOOLEAN); (VAR curDisplay: TEditString; ,editString: TEditString; ,i: INTEGER; ,s: S255; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF NOT update THEN ,curDisplay := nullEditString (ELSE ,curDisplay := SELF.editString; (SELF.GetTime; (editString := SELF.editString; (TextFont(timeFont); (TextFace([]); ({Dehilite} (FOR i := 1 TO editLength DO ,IF curDisplay[i] <> editString[i] THEN 0SELF.EditChar(i, editString[i]); (IF NOT update THEN ,BEGIN ,FillLRect(legendLRect, lPatWhite); ,MoveToL(legendH, legendV); ,TextFont(legendFont); ,IF SELF.alarmNum = 0 THEN 0DrawString(timeLegend) ,ELSE 0BEGIN 0DrawString(alarmLegend); 0IntToStr(SELF.alarmNum, @s); 0DrawString(s); 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; (* METHODS OF TPickSelection; $FUNCTION {TPickSelection.}CREATE{(object: TObject; heap: THeap; itsView: TView; itsKind: INTEGER; GitsAnchorLPt: LPoint): TPickSelection}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TPickSelection(TSelection.CREATE(object, heap, itsView, itsKind, itsAnchorLPt)); (SELF.ComputeBoundingBox; (SELF.showsHighlight := TRUE; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPickSelection.}Free; {++} (PROCEDURE InvalOtherPanel(object: TObject); (BEGIN ,IF TPanel(object) <> SELF.view.panel THEN 0TPanel(object).Invalidate; (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.window.panels.Each(InvalOtherPanel); (TSelection.Free; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TPickSelection.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (TSelection.Fields(Field); (Field('showsHighlight: BOOLEAN'); (Field(''); $END; ${$ENDC} $FUNCTION {TPickSelection.}CanDoCommand{(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (CASE cmdNumber OF ,uWhite, uLtGray, uGray, uDkGray, uBlack, ,uFront, uBack, ,uCut, uCopy, uClear: 0CanDoCommand := SELF.kind <> nothingKind; ,uPaste: 0CanDoCommand := TRUE; ,OTHERWISE 0CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPickSelection.}ComputeBoundingBox; ,VAR n: INTEGER; 0unitedLRect: LRect; (PROCEDURE InvalOtherPanel(object: TObject); (BEGIN ,IF TPanel(object) <> SELF.view.panel THEN 0TPanel(object).Invalidate; (END; (PROCEDURE UniteBox(object: TObject); ,VAR box: TBox; (BEGIN ,box := TBox(object); ,IF box.isSelected THEN 0BEGIN 0IF n = 0 THEN 4unitedLRect := box.shapeLRect 0ELSE 4UnionLRect(unitedLRect, box.shapeLRect, unitedLRect); 0n := n + 1; 0END; (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (n := 0; (SELF.view.EachVirtualPart(UniteBox); (WITH SELF DO ,IF n = 0 THEN 0BEGIN 0kind := nothingKind; 0boundLRect.botRight := boundLRect.topLeft; {so right place scrolls into view for Undo Clear} 0END ,ELSE 0BEGIN 0kind := pickKind; 0boundLRect := unitedLRect; 0END; (SELF.window.panels.Each(InvalOtherPanel); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPickSelection.}Highlight{(highTransit: THighTransit)}; (PROCEDURE HiliteBox(object: TObject); ,VAR box: TBox; (BEGIN ,box := TBox(object); ,IF box.isSelected THEN 0box.Highlight(highTransit); (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} ({Make sure we dont show the highlight during draging} (IF SELF.showsHighlight THEN ,SELF.view.EachVirtualPart(HiliteBox); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPickSelection.}KeyClear; (VAR dummy: BOOLEAN; {++} $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF SELF.CanDoCommand(uClear, dummy) THEN {++} ,SELF.window.PerformCommand(SELF.NewCommand(uClear)); {++} ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPickSelection.}MouseMove{(mouseLPt: LPoint)}; (VAR samView: TClkView; ,diffLPt: LPoint; ,diffLRect: LRect; (PROCEDURE MoveBox(object: TObject); (BEGIN ,TBox(object).MoveInAView(samView, diffLPt); (END; $BEGIN '{$IFC fTrace}BP(11);{$ENDC} '{First test if we want to drag this selection at all} (IF SELF.kind = pickKind THEN ,BEGIN ,samView := TClkView(SELF.view); +{How far did mouse move?} ,LPtMinusLPt(mouseLPt, SELF.currLPt, diffLPt); +{Don't move past view boundaries} ,LRectMinusLRect(samView.extentLRect, SELF.boundLRect, diffLRect); ,LRectHaveLPt(diffLRect, diffLPt); +{Move it if delta is nonzero} ,IF NOT EqualLPt(diffLPt, zeroLPt) THEN 0BEGIN *{$H-} OffsetLRect(SELF.boundLRect, diffLPt.h, diffLPt.v); {$H+} 0LPtPlusLPt(SELF.currLPt, diffLPt, mouseLPt); 0SELF.currLPt := mouseLPt; 0IF SELF.showsHighlight THEN 4BEGIN 4samView.panel.Highlight(SELF, hOnToOff); 4SELF.showsHighlight := FALSE; 4END; 0samView.EachVirtualPart(MoveBox); 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TPickSelection.}MouseRelease; (VAR deltaLPt: LPoint; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF NOT EqualLPt(SELF.currLPt, SELF.anchorLPt) THEN ,BEGIN ,LPtMinusLPt(SELF.currLPt, SELF.anchorLPt, deltaLPt); ,SELF.window.PerformCommand(TMoveCmd.CREATE(NIL, SELF.Heap, uMoveBoxes, TClkView(SELF.view), WdeltaLPt.h, deltaLPt.v)); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TPickSelection.}NewCommand{(cmdNumber: TCmdNumber): TCommand}; (VAR pasteH: LONGINT; ,pasteV: LONGINT; ,samView: TSamView; ,heap: THeap; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (NewCommand := NIL; (samView := TSamView(SELF.view); (heap := SELF.Heap; (CASE cmdNumber OF ,uWhite, uLtGray, uGray, uDkGray, uBlack: 0NewCommand := TRecolorCmd.CREATE(NIL, heap, cmdNumber, samView, cmdNumber - uWhite Q+ colorWhite); ,uClear: 0NewCommand := TSamClearCmd.CREATE(NIL, heap, cmdNumber, samView, SELF.boundLRect.topLeft); ,uCut, uCopy: 0NewCommand := TSamCutCopyCmd.CREATE(NIL, heap, cmdNumber, samView, cmdNumber = uCut, USELF.boundLRect.topLeft); ,uPaste: 0BEGIN 0WITH SELF DO 4IF kind = nothingKind THEN 8BEGIN 8pasteH := samView.clickLPt.h; 8pastev := samView.clickLPt.v; 8END 4ELSE 8WITH boundLRect DO  NIL) AND ((highTransit = hOffToOn) OR (highTransit = hOnToOff)) THEN ,BEGIN ,rgn1 := NewRgn; ,rgn2 := NewRgn; ,OpenRgn; ,FrameLRect(box.bounds); ,CloseRgn(rgn1); ,IF box.color = colorWhite THEN {subtract overlapping black keys} 0BEGIN 0OpenRgn; 0IF box.overBox1 <> NIL THEN 4box.overBox1.Draw; 0IF box.overBox2 <> NIL THEN 4box.overBox2.Draw; 0CloseRgn(rgn2); 0DiffRgn(rgn1, rgn2 ,rgn1); 0END; ,PenMode(patXOR); ,thePad.LPatToPat(lPatGray, pat); ,PenPat(pat); ,InsetRgn(rgn1, 3, 2); ,PaintRgn(rgn1); ,DisposeRgn(rgn1); ,DisposeRgn(rgn2); (END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TKeySelection.}MousePress{(mouseLPt: LPoint)}; $VAR panel: TPanel; (keyWindow: TKeyWindow; (pickedBox: TBox; (noSelection: TSelection; (theKind: INTEGER; (keyView: TKeyView; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (panel := SELF.panel; (keyWindow := TKeyWindow(panel.window); (keyView := TKeyView(SELF.view); (pickedBox := keyView.BoxWith(mouseLPt); { find box where mouse press/move happened } (IF pickedBox = NIL THEN { Mouse press outside of keyboard } ,BEGIN ,IF (SELF.currentBox <> NIL) THEN { was there a key already down? } 0BEGIN 0keyWindow.Silence; { turn off tone } 0panel.Highlight(SELF, hOnToOff); 0END; ,SELF.currentBox := NIL; { no "current" key } ,END (ELSE { Mouse press on keyboard } ,BEGIN ,IF (pickedBox <> SELF.currentBox) THEN { this key same as last one? } 0BEGIN { No... } 0panel.Highlight(SELF, hOnToOff); 0keyWindow.Sound(pickedBox.waveLength); { start tone } 0SELF.currentBox := pickedBox; { save this key as the new "current" key } 0panel.Highlight(SELF, hOffToOn); 0END; ,END; '{$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TKeySelection.}MouseMove{(mouseLPt: LPoint)}; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.MousePress(mouseLPt); { do same thing as for initial MousePress } ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TKeySelection.}MouseRelease; (VAR fakeLPt: LPoint; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (SetLPt(fakeLPt, -1, -1); (SELF.MousePress(fakeLPt); {any LPoint not on the keyboard will do} '{$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TKeySelection.}KeyChar{(ch: CHAR)}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TKeyWindow; $FUNCTION {TKeyWindow.}CREATE{(object: TObject; itsHeap: THeap; itsWmgrID: TWindowID): TWindow}; (VAR t: SpeakerVolume; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN +object := NewObject(itsHeap, THISCLASS); (SELF := TKeyWindow(TWindow.CREATE(object, itsHeap, itsWmgrID, FALSE)); (WITH SELF DO ,BEGIN ,hSize := 100; ,vSize := 100; ,appVolume := 1; {initial volume inside application} ,END; (t := Volume; (SELF.initialVolume := t; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE {TKeyWindow.}Fields{(PROCEDURE Field(nameAndType: S255))}; $BEGIN (SUPERSELF.Fields(Field); (Field('initialVolume: INTEGER'); (Field('appVolume: INTEGER'); (Field('hSize: INTEGER'); (Field('vSize: INTEGER'); (Field(''); $END; ${$ENDC} $PROCEDURE {TKeyWindow.}Activate; $VAR border: Rect; (pt: Point; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (TWindow.Activate; (SELF.GetBorder(border); (WITH SELF, border DO ,{$H-} ,SetPt(pt, hSize + right, vSize + bottom); ,{$H+} (SELF.ResizeTo(pt); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TKeyWindow.}BlankStationery; $VAR keyList: TList; (number: INTEGER; (keyLRect: LRect; (box: TBox; (viewLRect: LRect; (panel: TPanel; (keyView: TKeyView; (keySelection: TKeySelection; (aWhiteKey: TBox; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (keyList := TList.CREATE(NIL, SELF.Heap, numKeys); {allocate enough space for white keys to start} (number := 0; (SetLRect(keyLRect, 0, 0, whKeyWidth, whKeyHeight); (OffsetLRect(keyLRect, viewHMargin, viewVMargin); (WHILE number < numKeys DO ,BEGIN ,number := number + 1; ,box := TBox.CREATE(NIL, SELF.heap, number, colorWhite, waveTable[whiteKeys[number]]); ,box.bounds := keyLRect; ,keyList.InsAt(number, box); ,OffsetLRect(keyLRect, whKeyWidth, 0); ,END; (WITH keyLRect DO ,SetLRect(viewLRect, 0, 0, left + viewHMargin, bottom + viewVMargin); (WITH viewLRect DO ,panel := TPanel.CREATE(NIL, SELF.Heap, SELF, 0, 0, [], []); (WITH SELF, viewLRect DO ,BEGIN ,hSize := right; ,vSize := bottom; ,END; (keyView := TKeyView.CREATE(NIL, SELF.Heap, panel, viewLRect, keyList); (keySelection := TKeySelection(panel.selection.FreedAndReplacedBy( = 0 THEN 0BEGIN 0box := TBox.CREATE(NIL, SELF.heap, number, colorBlack, waveTable[blackKeys[number]]); 0box.bounds := keyLRect; 0keyList.InsLast(box); 0{Make the white keys that 'box' covers point to it} 0aWhiteKey := TBox(keyList.At(number)); 0aWhiteKey.overBox1 := box; 0IF number > 1 THEN 4BEGIN 4aWhiteKey := TBox(keyList.At(number - 1)); 4aWhiteKey.overBox2 := box; 4END; 0END; ,OffsetLRect(keyLRect, whKeyWidth, 0); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TKeyWindow.}CanDoCommand{(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN}; (VAR t: SpeakerVolume; ,cmd: TCmdNumber; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF (cmdNumber >= uVol0) AND (cmdNumber <= uVolMax) THEN ,BEGIN ,CanDoCommand := TRUE; ,checkIt := cmdNumber = SELF.appVolume + uVol0; ,END (ELSE ,CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TKeyWindow.}Deactivate; $VAR border: Rect; (pt: Point; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (********** Put this in if you want the window to shrink down on a deactivate (SELF.GetBorder(border); (WITH SELF, border DO ,{$H-} ,SetPt(pt, 60, 40); ,{$H+} (TArea.PushFocus; (SELF.Focus; (SELF.ResizeTo(pt); (TArea.PopFocus; **********) (SUPERSELF.Deactivate; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION {TKeyWindow.}NewCommand{(cmdNumber: TCmdNumber): TCommand}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF (cmdNumber >= uVol0) AND (cmdNumber <= uVolMax) THEN ,BEGIN ,NewCommand := NIL; ,SELF.appVolume := cmdNumber - uVol0; ,END (ELSE ,NewCommand := SUPERSELF.NewCommand(cmdNumber); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TKeyWindow.}Silence; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (Silence; (SetVolume(SELF.initialVolume); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE {TKeyWindow.}Sound{(waveLength: Microseconds)}; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (SetVolume(SELF.appVolume); (Noise(waveLength); ({$IFC fTrace}EP;{$ENDC} $END; END; 3. "6F^9D!$ǐ^.H3. "6F^9boD!$ǐ^; PKeyboard.TEXT Phrase file for Keyboard application program 1 3 2300 $-#boot-tk/PABC ; Apple building block phrase files can be included here 1000 LisaKeyboard ; Other application alerts can be included here, numbered between 1001 and 32000 0 1 File/Print Set Aside Everything#101 Set Aside#102 - Save & Put Away#103 Save & Continue#0 Revert to Previous Version#0 - Format for Printer ...#0 Print ...#0 Monitor the Printer ...#106 2 Volume 0 (Soft)/0#1000 1/1#1001 2/2#1002 3/3#1003 4/4#1004 5/5#1005 6/6#1006 7 (Loud)/7#1007 100 $-#boot-tk/PABC~Buzzwords 1000 $-#boot-tk/PABC~Clipboard File/Print 0 3. "6F^9. D!$ǐ^sHommand;} rID: TWindowID): TKeyWindow; ; cManager; LRect; (panel: TPanel; (keyView: TKeyView; (keySelection: TKeySelection; (aWhiteKey: TBox; $BEGIN ({$'{PROCEDURE TKeySelection. KeyChar(ch: CHAR);} (END; $TKeyWindow = SUBCLASS OF TWindow &{Variables} (initialVolume: SpeakerVolume; { volume outside of application } (appVolume: SpeakerVolume; { volume inside applicati;The next 2 lines specify the default tool number and tool volume 203 ;no assembler files $ ;no building blocks $ ;nothing else to link in $ ;install parameters: does not use documents; don't change open rectangle ; (the program adjusts the window size itself) n n Keyboard $ 3. "6F^9. D!$ǐ^V.: ; OVERRIDE; ; TCmdNumber; ; OVERRIDE; er; ?<At? SBn?<"@/N m PCp"S@nJnW" g.HnHzHnZHzHn?<" ACp@ S@n`r nW/ B^PROGRAM MReader; USES ${$U UObject} UObject, ${$U QuickDraw} QuickDraw, ${$U UDraw} UDraw, ${$U UABC} UABC, ${$U UUnivText} UTKUniversalText, {+SW+} ${$U UText} UText, ${$U UDialog} UDialog, ${$IFC LibraryVersion > 20} ${$U UIconRef} UIconRef, ${$ENDC} ${$U UReader} UReader; CONST $phraseVersion = 1; BEGIN $process := TRdrProcess.CREATE; $process.Commence(phraseVersion); $process.Run; $process.Complete(TRUE); END. 3. "6F^9esD!$ǐ^]l%l% THeap; itsWmgrID: TWindowID): TRdrWindow; &{Document Creation, etc.} (PROCEDURE TRdrWindow.Activate; OVERRIDE; (PROCEDURE TRdrWindow.BlankStationery; OVERRIDE; &{Menus} (FUNCTION TRdrWindow.CanDoCommand(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN; OVERRIDE; &{Commands} (FUNCTION TRdrWindow.NewCommand(cmdNumber: TCmdNumber): TCommand; OVERRIDE; (END; $TRdrPrintManager = SUBCLASS OF TStdPrintManager &{Va{$SETC forOS := TRUE} ${LisaReader: reads UCSD text file} ${Copyright 1983, 1984, Apple Computer Inc.} UNIT UReader; {$SETC TimeRead := FALSE} {If TRUE display the time needed to read a file.} INTERFACE USES {$E ERRORS} {$E+} ${$U -#BOOT-SysCall} SysCall, ${$U UObject} UObject, ${$U QuickDraw} QuickDraw, ${$U UDraw} UDraw, ${$U UABC} UABC, ${$U UUnivText} UTKUniversalText, ${$U UText} UText, ${$U UDialog} UDialog, ${$U UIconRef} UIconRef, ${$U SuLib} StdUnit; CONST $uReadFile = 1000; $uLisaWrite = 2000; $uReadIcons = 2001; $famStatus = famModern; $sizeStatus = size12Point; $famOffset = uModern - famModern; $sizeOffset = u20Pitch - size20Pitch; $vMargin = 4; $hMargin = 6; $phCtrReading = 9; $phReadingFile = 1001; $phCantOpen = 1002; $phReadError = 1004; $phDiffDate = 1007; $phCurFile = 1500; $phNoName = 1501; $phNoMsg = 1502; {$IFC TimeRead} $phTimer = 2000; {$ENDC} $txtUnit = $0400; { 1024 = two disk blocks } $readUnit = $4000; { 16K = amount to read at one time } $DLE = 16; $EOL = 13; $statusHeight = 20; $inpID = 'Read File Named: [.TEXT]'; TYPE $TFileBuffer = PACKED ARRAY[1..readUnit] OF CHAR; "{Subclasses of Generic Classes} $TFileBlock = SUBCLASS OF TObject &{Fields} (numBytes: INTEGER; {# bytes actually in the data} (firstLine: LONGINT; (lineIndex: TArray; (data: TFileBuffer; &{Creation/Destruction} (FUNCTION TFileBlock.CREATE(object:TObject; heap: THeap; itsFirstLine: LONGINT): TFileBlock; (PROCEDURE TFileBlock.Free; OVERRIDE; &{Reading Files} (PROCEDURE TFileBlock.ReadFrom(fs: TFileScanner; VAR blockMaxLen: INTEGER); ,{when done, fs.actual is # bytes read; blockMaxLen is maximum line length of block} &{Accessing} (FUNCTION TFileBlock.LineAt(idx: INTEGER; VAR leadingSp, chStart, nChars: INTEGER): BOOLEAN; ,{returns TRUE if the line idx is located within the block; 0leadingSp is number of leading spaces; 0chStart is block index of first real character; 0nChars is number of real characters} (END; $TRdrProcess = SUBCLASS OF TProcess &{Creation/Destruction} (FUNCTION TRdrProcess.CREATE: TRdrProcess; (FUNCTION TRdrProcess.NewDocManager(volumePrefix: TFilePath; PopenAsTool: BOOLEAN): TDocManager; OVERRIDE; (PROCEDURE TRdrProcess.CopyExternalDoc(VAR error: INTEGER;  SUOk THEN (BEGIN (process.GetAlert(phNoMsg, msg^); (i := Pos('#', msg^); (IF i > 0 THEN ,BEGIN ,Delete(msg^, i, 1); ,SUIntToStr(err, @num); ,Insert(num, msg^, i); ,END; (END; END; METHODS OF TFileBlock; $FUNCTION TFileBlock.CREATE(object:TObject; heap: THeap; itsFirstLine: LONGINT): TFileBlock; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TFileBlock(object); (WITH SELF DO ,BEGIN ,numBytes := 0; ,lineIndex := NIL; ,firstLine := itsFirstLine; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TFileBlock.Free; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (Free(SELF.lineIndex); (TObject.FreeObject; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE TFileBlock.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('numBytes: INTEGER'); (Field('firstLine: LONGINT'); (Field('lineIndex: TArray'); (Field(''); $END; ${$ENDC} $FUNCTION TFileBlock.LineAt(idx: INTEGER; VAR leadingSp, chStart, nChars: INTEGER): BOOLEAN; (VAR ix: INTEGER; ,ok: BOOLEAN; ,nLines: LONGINT; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (nLines := SELF.lineIndex.Size; (WITH SELF DO ,IF (idx >= firstLine) AND (idx < firstLine + nLines) THEN 0BEGIN 0ok := TRUE; 0{$H-} 0ix := idx - firstLine + 1; 0chStart := TpInteger(lineIndex.At(ix))^; 0IF (ORD(data[chStart]) = DLE) AND (chStart < numBytes) THEN 4BEGIN 4leadingSp := ORD(data[chStart+1]) - 32; 4chStart := chStart + 2; 4END 0ELSE 4leadingSp := 0; 0IF ix < nLines THEN 4ix := TpInteger(lineIndex.At(ix+1))^ 0ELSE 4ix := numBytes; 0REPEAT 4ix := ix - 1; 0UNTIL ORD(data[ix]) = EOL; 0nChars := ix - chStart 0{$H+} 0END ,ELSE 0ok := FALSE; (LineAt := ok; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TFileBlock.ReadFrom(fs: TFileScanner; VAR blockMaxLen: INTEGER); $VAR nBytes: INTEGER; (numLines: INTEGER; (lineIdx: TArray; (byteIdx: INTEGER; (ch: INTEGER; (lineLen: INTEGER; (currStart: INTEGER; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (blockMaxLen := 0; (fs.XferSequential(xRead, @readBuffer, readUnit); ({$H-} (XferLeft(@readBuffer, @SELF.data, readUnit); ({$H+} (IF (fs.error <= 0) OR (fs.error = 848{EOF}) THEN ,BEGIN ,nBytes := fs.actual; ,{find out how many lines there are} ,numLines := 0; ,byteIdx := 1; ,WITH SELF DO 0WHILE byteIdx <= nBytes DO 4BEGIN 4IF ORD(data[byteIdx]) = EOL THEN 8numLines := numLines + 1; 4byteIdx := byteIdx + 1; 4END; ,lineIdx := TArray.CREATE(NIL, SELF.Heap, numLines, SIZEOF(INTEGER)); ,WITH SELF DO 0BEGIN 0lineIndex := lineIdx; 0numBytes := nBytes; 0END; ,{construct the line index} ,byteIdx := 1; ,currStart := 1; ,lineLen := 0; ,WITH SELF DO 0{$H-} 0WHILE byteIdx <= nBytes DO 4BEGIN 4ch := ORD(SELF.data[byteIdx]); 4IF ch = DLE THEN 8BEGIN 8IF byteIdx < nBytes THEN  0) OR (outScanner.error > 0)) DO ,BEGIN ,SELF.AbortXferSequential(xRead, @buf, SIZEOF(buf), chunkSize, inScanner); ,SELF.AbortXferSequential(xWrite, @buf, Min(SIZEOF(buf), inScanner.actual), LchunkSize, outScanner); ,END; (error := inScanner.error; (LatestError(outScanner.error, error); (inScanner.Free; (outScanner.Free; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TRdrProcess.NewDocManager(volumePrefix: TFilePath; openAsTool: BOOLEAN): TDocManager; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (NewDocManager := TRdrDocManager.CREATE(NIL, mainHeap, volumePrefix); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TRdrDocManager; $FUNCTION TRdrDocManager.CREATE(object:TObject; heap: THeap; itsPathPrefix: TFilePath): TRdrDocManager; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TRdrDocManager(TDocManager.CREATE(object, heap, itsPathPrefix)); ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TRdrDocManager.NewWindow(heap: THeap; wmgrID: TWindowID):TWindow; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (NewWindow := TRdrWindow.CREATE(NIL, heap, wmgrID); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TRdrWindow; $FUNCTION TRdrWindow.CREATE(object:TObject; heap: THeap; itsWmgrID: TWindowID): TRdrWindow; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TRdrWindow(TWindow.CREATE(object, heap, itsWmgrID, TRUE)); ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE TRdrWindow.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('filePanel: TPanel'); (Field('statusPanel: TPanel'); (Field('dialogWindow: TDialogWindow'); (Field('fileDialog: TFileDialog'); (Field(''); $END; ${$ENDC} $PROCEDURE TRdrWindow.Activate; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SUPERSELF.Activate; (IF NOT TRdrView(SELF.filePanel.view).HasFile AND (SELF.dialogBox = NIL) THEN ,SELF.DoCommand(uReadFile); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRdrWindow.BlankStationery; (VAR panel: TPanel; ,rdrView: TRdrView; ,statusView: TStatusView; ,dialogWindow: TDialogWindow; ,fileDialog: TFileDialog; ,s: S255; ,diHeight: INTEGER; ,cv: TConvResult; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (panel := TPanel.CREATE(NIL, SELF.Heap, SELF, 30, 20, @[aBar, aScroll, aSplit], [aBar, aScroll, aSplit]); (rdrView := TRdrView.CREATE(NIL, SELF.Heap, panel); (SELF.filePanel := panel; (WITH rdrView.typestyle.font DO ,BEGIN ,fontFamily := famModern; ,fontSize := size15Pitch; ,END; (rdrView.FontChanged; (panel := panel.Divide(v, statusHeight, pixelsFromEdge, [], statusHeight, [aBar], []); (statusView := TStatusView.CREATE(NIL, SELF.Heap, panel); (SELF.statusPanel := panel; (process.GetAlert(phDiHeight, s); (StrToInt(@s, diHeight, cv); (IF cv <> cvValid THEN ,diHeight := 125; (dialogWindow := NewStdDialogWindow(SELF.Heap, diHeight, diAccept, diAccept, diDismissDialogBox); (fileDialog := TFileDialog.CREATE(NIL, SELF.Heap, dialogWindow.dialogView, rdrView); (dialogWindow.dialogView.AddDialog(fileDialog); (SELF.dialogWindow := dialogWindow; (SELF.fileDialog := fileDialog; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TRdrWindow.CanDoCommand(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN; (VAR rdrView: TRdrView; ,famCmd: TCmdNumber; ,sizeCmd: TCmdNumber; ,hasFile: BOOLEAN; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (rdrView := TRdrView(SELF.filePanel.view); (hasFile := rdrView.HasFile; (WITH rdrView.typestyle.font DO ,BEGIN ,famCmd := fontFamily + famOffset; ,sizeCmd := fontSize + sizeOffset; ,END; (CASE cmdNumber OF ,uModern, uClassic, ,u20Pitch, u15Pitch, u12Pitch, u10Pitch: 0BEGIN 0CanDoCommand := hasFile; 0checkIt := (famCmd = cmdNumber) OR (sizeCmd = cmdNumber); 0END; ,uClear, uLisaWrite: 0CanDoCommand := hasFile; ,uReadIcons: 0CanDoCommand := clipboard.hasIcon; ,uReadFile: 0CanDoCommand := SELF.dialogBox = NIL; ,OTHERWISE 0CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TRdrWindow.NewCommand(cmdNumber: TCmdNumber): TCommand; (VAR rdrView: TRdrView; ,diView: TDialogView; ,inputFrame: TInputFrame; ,diTextSel: TFrameSelection; ,oldManBreaks: TArray; ,newManBreaks: TArray; ,i: INTEGER; ,ln: LONGINT; ,LCd: LONGINT; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (NewCommand := NIL; (rdrView := TRdrView(SELF.filePanel.view); (CASE cmdNumber OF ,uModern, uClassic, ,u20Pitch, u15Pitch, u12Pitch, u10Pitch: 0BEGIN 0WITH rdrView.typeStyle.font DO 4IF (cmdNumber = uModern) OR (cmdNumber = uClassic) THEN 8fontFamily := cmdNumber - famOffset 4ELSE 8fontSize := cmdNumber - sizeOffset; 0rdrView.FontChanged; 0{reset manual breaks on the same lines as before} 0TRdrPrintManager(rdrView.printManager).RemakeManualBreaks; 0SELF.selectPanel.selection.MarkChanged; 0END; ,uReadFile: 0IF SELF.dialogBox = NIL THEN 4BEGIN 4SELF.fileDialog.SelectInputFrame(SELF.fileDialog.inputFrame); 4SELF.PutUpDialogBox(SELF.dialogWindow); 4END; ,uClear: 0BEGIN 0rdrView.fBlockList.DelAll(TRUE); 0rdrView.fBlockList.Free; 0WITH rdrView DO 4BEGIN 4fBlockList := NIL; 4filePath := ''; 4fileDate := 0; 4maxLineLen := 0; 4nLines := 0; 4END; 0rdrView.SetExtent; 0SELF.statusPanel.Invalidate; 0SELF.selectPanel.selection.MarkChanged; 0END; ,uLisaWrite: 0NewCommand := TCopyToLisaWrite.CREATE(NIL, SELF.Heap, cmdNumber, rdrView); ,uReadIcons: 0NewCommand := TRdrPasteIcons.CREATE(NIL, SELF.Heap, cmdNumber, rdrView); ,OTHERWISE 0NewCommand := SUPERSELF.NewCommand(cmdNumber); ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TRdrPrintManager; $FUNCTION TRdrPrintManager.CREATE(object:TObject; heap: THeap): TRdrPrintManager; (VAR dynamicArray: TArray; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TRdrPrintManager(TStdPrintManager.CREATE(object, heap)); (dynamicArray := TArray.CREATE(NIL, heap, 0, 4); (SELF.manBreaks := dynamicArray; ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE TRdrPrintManager.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('manBreaks: TArray'); (Field(''); $END; ${$ENDC} $PROCEDURE TRdrPrintManager.ClearPageBreaks(automatic: BOOLEAN); $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF NOT automatic THEN ,SELF.manBreaks.DelAll; (SUPERSELF.ClearPageBreaks(automatic); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRdrPrintManager.Init(itsMainView: TView; itsDfltMargins: LRect); $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (SUPERSELF.Init(itsMainView, itsDfltMargins); (SELF.pageRiseDirection := v; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRdrPrintManager.RemakeManualBreaks; (VAR rdrView: TRdrView; ,manBreaks: TArray; ,i: INTEGER; ,ln: LONGINT; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} ({clear old manual page breaks, but call superclass so we don't wipe out our 0list of manual breaks} (SUPERSELF.ClearPageBreaks(FALSE); (rdrView := TRdrView(SELF.view); (manBreaks := SELF.manBreaks; (FOR i := 1 TO manBreaks.Size DO ,BEGIN ,ln := TpInteger(manBreaks.At(i))^; ,SUPERSELF.SetBreak(h, rdrView.LocateLine(ln), FALSE); {again, call superclass so we don't Xinsert anything into our list of breaks} ,END; (SELF.RedoBreaks; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRdrPrintManager.SetBreak(vhs: VHSelect; where: LONGINT; isAutomatic: BOOLEAN); (VAR ln: LONGINT; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF NOT isAutomatic AND (vhs = h) THEN ,BEGIN ,ln := TRdrView(SELF.view).LocateLCd(where); ,SELF.manBreaks.InsLast(@ln); ,END; (SUPERSELF.SetBreak(vhs, where, isAutomatic); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRdrPrintManager.SetDfltHeadings; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (SUPERSELF.SetDfltHeadings; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TRdrView; $FUNCTION TRdrView.CREATE(object:TObject; heap: THeap; itsPanel: TPanel): TRdrView; (VAR margins: LRect; ,dummyExtent: LRect; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SetLRect(dummyExtent, 0, 0, hMargin, vMargin); (WITH screenRes DO ,SetLRect(margins, h, v, h, v); (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TRdrView(object); (WITH SELF DO {some of these fields are needed ultimately by TView.CREATE} ,BEGIN ,filePath := ''; ,fileDate := 0; ,fBlockList := NIL; ,maxLineLen := 0; ,nLines := 0; ,typeStyle := sysTypestyle; ,fntDescent := 0; ,charSize := zeroPt; ,END; (SELF := TRdrView(itsPanel.NewView(object, dummyExtent, LTRdrPrintManager.CREATE(NIL, heap), margins, TRUE)); ({$IFC fTrace}EP;{$ENDC} $END; ${$IFC fDebugMethods} $PROCEDURE TRdrView.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('filePath: STRING[255]'); (Field('fileDate: LONGINT'); (Field('fBlockList: TList'); (Field('maxLineLen: INTEGER'); (Field('nLines: LONGINT'); (Field('typeStyle: RECORD onFaces:Byte; pad: Byte; fontFamily: Byte; fontSize: Byte; END'); (Field(''); (Field('fntDescent: INTEGER'); (Field('charSize: Point'); (Field(''); $END; ${$ENDC} $PROCEDURE TRdrView.Draw; (LABEL ,10; (VAR numLines: LONGINT; ,spWidth: INTEGER; ,start: LONGINT; ,finish: LONGINT; ,height: INTEGER; ,lCd: LONGINT; ,ln: LONGINT; ,s: TListScanner; ,leadingSp: INTEGER; ,chStart: INTEGER; ,nChars: INTEGER; ,aBlock: TFileBlock; ,ix: INTEGER; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (numLines := SELF.nLines; (IF numLines > 0 THEN ,BEGIN ,SetQDTypeStyle(SELF.typeStyle); ,spWidth := CharWidth(' '); ,WITH thePad.visLRect, SELF.charSize DO 0BEGIN 0height := v; 0start := top - v; 0finish := bottom + v; 0END; ,WITH SELF.extentLRect DO 0{$H-} 0BEGIN 0start := Max(start, top); 0finish := Min(finish, bottom); 0END; 0{$H+} ,start := SELF.LocateLCd(start); ,finish := SELF.LocateLCd(finish); ,lCd := SELF.LocateLine(start); ,s := SELF.fBlockList.Scanner; ,ln := start; ,WHILE s.Scan(aBlock) DO 0IF aBlock.firstLine > finish THEN 4s.Done 0ELSE IF aBlock.LineAt(ln, leadingSp, chStart, nChars) THEN 4REPEAT 8MoveToL(hMargin + (leadingSp * spWidth), lCd); 8DrawText(@aBlock.data, chStart-1, nChars); 8ln := ln + 1; 8lCd := lCd + height; 8IF ln > finish THEN  SELF.nLines THEN ,ln := SELF.nLines; (LocateLCd := ln; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TRdrView.HasFile: BOOLEAN; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (HasFile := SELF.nLines > 0; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TRdrView.LocateLine(ln: LONGINT): LONGINT; (VAR lCd: LONGINT; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF ln <= 0 THEN ,LocateLine := 0 (ELSE ,BEGIN ,lCd := (SELF.charSize.v * ln) + vMargin - SELF.fntDescent; ,IF lCd = SELF.extentLRect.bottom THEN 0lCd := SELF.extentLRect.bottom; ,LocateLine := lCd; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRdrView.ReadFile(VAR filePath: TFilePath); (LABEL ,100; (TYPE ,TpEName = ^E_Name; ,TpPathname = ^Pathname; (VAR error: INTEGER; ,catalog: TFilePath; ,pCatalog: TpEName; ,filePart: TFilePath; ,attr: fs_info; ,vName: e_name; ,password: e_name; ,aFile: TFile; ,str: S255; ,aList: TList; ,vol: S255; ,maxLen: INTEGER; ,blockMaxLen: INTEGER; ,heap: THeap; ,fs: TFileScanner; ,fSize: LONGINT; ,ixLine: LONGINT; ,aFileBlock: TFileBlock; ,pct: INTEGER; {$IFC TimeRead} ,i: INTEGER; ,timeVal: LONGINT; {$ENDC} (PROCEDURE DoAbort; (BEGIN ,process.BeginWait(phAborting); ,aList.DelAll(TRUE); ,maxLen := 0; ,ixLine := 1; ,process.Stop(phTerminated); ,GOTO 100; (END; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (SplitFilePath(filePath, catalog, filePart); (IF catalog <> '' THEN ,BEGIN ,catalog := Copy(catalog, 2, Length(catalog)-2); {delete the '-'s} ,pCatalog := @catalog; ,Lookup(error, TpPathname(pCatalog)^, attr); ,IF error > 0 THEN 0BEGIN 0password := ''; 0Mount(error, vname, password, pCatalog^); 0END; ,END; (heap := SELF.Heap; (aFile := TFile.CREATE(NIL, heap, filePath, ''); (fs := aFile.ScannerFrom(0, [fRead]); (IF fs.error > 0 THEN ,BEGIN ,process.ArgAlert(1, filePath); ,GetErrorText(error, @str); ,process.ArgAlert(2, str); ,process.Stop(phCantOpen); ,END (ELSE ,BEGIN ,aList := SELF.fBlockList; ,SELF.filePath := filePath; &{$H-} SELF.fileDate := aFile.WhenModified(error); {$H+} ,IF aList <> NIL THEN 0BEGIN 0aList.DelAll(TRUE); 0aList.Free; 0END; ,{ skip first 2 blocks } ,fs.Seek(txtUnit); ,fSize := aFile.size; ,maxLen := 0; ,aList := TList.CREATE(NIL, heap, (fSize - txtUnit + readUnit - 1) DIV readUnit); ,SELF.fBlockList := aList; ,ixLine := 1; {number of next line to read} ,pct := 0; ,process.ArgAlert(1, filePath); ,process.BeginWait(phReadingFile); ,process.CountAlert(phCtrReading, (100 * fs.position) DIV fSize); {$IFC TimeRead} ,timeVal := GetTime; {$ENDC} ,WHILE (fs.position < fSize) AND (fs.error <= 0) DO 0BEGIN 0IF process.AbortRequest THEN 4DoAbort; 0aFileBlock := TFileBlock.CREATE(NIL, heap, ixLine); 0aList.InsLast(aFileBlock); {insert in list, so that if a read error it will be freed} 0aFileBlock.ReadFrom(fs, blockMaxLen); 0maxLen := Max(maxLen, blockMaxLen); 0IF (fs.error > 0) AND (fs.error <> 848 {EOF}) THEN 4BEGIN 4IF error = erAborted THEN 8DoAbort 4ELSE 8BEGIN 8aList.DelAll(TRUE); 8GetErrorText(fs.error, @str); 8process.ArgAlert(1, str); 8process.Stop(phReadError); 8END; 4maxLen := 0; 4ixLine := 1; 4END 0ELSE 4ixLine := ixLine + aFileBlock.lineIndex.Size; 0process.CountAlert(phCtrReading, (100 * fs.position) DIV fSize); 0END; {while still blocks in the file} {$IFC TimeRead} ,timeVal := GetTime - timeVal; ,SULIntToStr(timeVal, @str); ,FOR i := Length(str) + 1 TO 3 DO 0Insert('0', str, 1); ,Insert('.', str, Length(str)-1); ,process.ArgAlert(1, str); ,process.Note(phTimer); {$ENDC} 100: {wrap up} ,fs.Free; ,WITH SELF DO 0BEGIN 0maxLineLen := maxLen; 0nLines := ixLine - 1; 0END; ,process.EndWait; ,SELF.SetExtent; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRdrView.SetExtent; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (SELF.panel.currentView.ReactToPrinterChange; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRdrView.SetMinViewSize(VAR minLRect: LRect); (VAR len: LONGINT; ,wid: LONGINT; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (IF SELF.nLines > 0 THEN ,BEGIN ,WITH SELF.charSize DO 0{$H-} 0BEGIN 0len := 2 * vMargin + 7ORD4(SELF.nLines) * v; 0wid := 2 * hMargin + 7ORD4(SELF.maxLineLen) * h; 0END; 0{$H+} ,SetLRect(minLRect, 0, 0, wid, len); ,END (ELSE ,minLRect := zeroLRect; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TStatusView; $FUNCTION TStatusView.CREATE(object:TObject; heap: THeap; itsPanel: TPanel): TStatusView; (VAR itsExtent: LRect; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (SetLRect(itsExtent, 0, 0, 1000, statusHeight); (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TStatusView(itsPanel.NewStatusView(object, itsExtent)); (SELF.scrollPastEnd := zeroPt; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TStatusView.Draw; (CONST hMargin = 3; (VAR fInfo: FontInfo; ,base: LONGINT; ,str: S255; ,pStr: TPString; ,overflow: BOOLEAN; ,rdrWindow: TRdrWindow; ,rdrView: TRdrView; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (TextFont(fIDSystem); {system font} (TextFace([]); (GetFontInfo(fInfo); (WITH fInfo DO ,base := ascent + (statusHeight - ascent - descent) DIV 2; (MoveToL(hMargin, base); (process.GetAlert(phCurFile, str); (SUAddCh(@str, ' ', 255, overflow); (DrawString(str); (rdrWindow := TRdrWindow(SELF.panel.window); (rdrView := TRdrView(rdrWindow.filePanel.view); (IF rdrView.HasFile THEN ,BEGIN ,SetQDTypestyle(statusTypestyle); ,pStr := @rdrView.filePath; ,END (ELSE ,BEGIN ,process.GetAlert(phNoName, str); ,pStr := @str; ,END; (DrawString(pStr^); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TFileDialog; $FUNCTION TFileDialog.CREATE(object:TObject; heap: THeap; itsDiView: TView; HitsRdrView: TRdrView): TFileDialog; (VAR itsExtentLRect: LRect; ,inLoc: LPoint; ,prLoc: LPoint; ,fInfo: FontInfo; ,inpExtent: LRect; ,itsInputFrame: TInputFrame; ,legend: TLegend; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TFileDialog(TDialog.CREATE(object, heap, 'FILE', itsDiView)); (SELF.AddOKButton(noCmdNumber); (SELF.AddCancelButton(noCmdNumber); (SELF.SetDefaultButton(TButton(SELF.ObjWithID(cancelString))); (legend := SELF.NewLegend(phPrompt, sysTypeStyle); (itsInputFrame := SELF.NewInputFrame(phInpFr, statusTypeStyle, zeroPt, :>1-CIST'T.XT̴̴$ureader.TEXTxxN$@ ureader.TEXTer.TEXTr.TEXTE̕R$@"N.8~.81-CIXT̴XT̴  :#ST'T.XT}'̕RLH.9START.TEXT /*-#1#1-Samples-ureader; PReader.TEXT for LisaReader ;This is a sample phrase file for ToolKit applications ;NOTE: The wording of the alerts may not conform to the standards of the ; first release applications ; 28Sept83 Added page-numbering-order commands to Page Layout Menu 1 3 2300 $-#boot-tk/PABC ; Other application alerts can be included here, numbered between 1001 and 32000 1001 wait alert ^0 is reading the file "^1".^L^L The operation is ^999% completed.^L^L To terminate the operation, hold down the Apple key while you type a period. 1002 stop alert ^0 could not open the file "^1".^L^L (^2) 1004 stop alert ^0 has detected an error while reading the file.^L^L (^1) 1007 note alert The version of the file in memory is different than the version on disk.^L^L To read the disk version, choose "Read File" from the "Edit" menu. 1500 Current File: 1501 --None-- 1502 Error #: error message text not available 1503 Read File Named: [.TEXT]@10,45 ;The following gives the location of the input frame 1504 @10,65 ;The following gives the height of the dialog box 1505 125 2000 note alert The preceding operation took ^1 seconds. 0 1 $-#boot-tk/PABC~File/Print 2 $-#boot-tk/PABC~Edit - Clear#208 Select All of Document/A#204 - Read File...#1000 - Copy to LisaWrite#2000 Read Icons#2001 3 Type Style Modern#320 Classic#321 - 8 Point 20 Pitch#330 8 Point 15 Pitch#331 10 Point 12 Pitch#332 12 Point 10 Pitch#333 5 Page Layout Preview Actual Pages#401 Preview Page Breaks#402 Don't Preview Pages#403 - Headings and Margins...#405 - Set Horizontal Page Break#411 Clear All Manual Breaks#413 99 $-#boot-tk/PABC~Debug 100 $-#boot-tk/PABC~Buzzwords 1000 $-#boot-tk/PABC~Clipboard File/Print 0 3. "6F^9deD!$ǐ^eHdon't change the opening rectangle ;The next 2 lines specify the default tool number and tool volume 202 ;no assembler files $ ;we use the uiconref building block uiconref $ ;we also use StdUnit, which is in SULIB -#boot-sulib $ ;install parameters: we handle documents; we handle >1 document; we don't change the opening rectangle y y n Reader $ 3. "6F^9tOD!$ǐ^  TGlT /UNIT UIconRefs; {Unit to provide read/write of icon references} INTERFACE USES ${$U UnitStd} UnitStd, ${$U UnitHz} UnitHz, ${$U LIBOS/SysCall} SysCall, ${$U UObject} UObject, ${$U QuickDraw} QuickDraw, ${$U FontMgr} FontMgr, ${$U UDraw} UDraw, ${$U WM.Events} Events, ${$U WM.Folders} Folders, ${$U WM.Menus} UNIT UIconRefs; {Unit to provide read/write of icon references} INTERFACE USES ${$U UnitStd} UnitStd, ${$U UnitHz} UnitHz, ${$U -#BOOT-SysCall} SysCall, ${$U UObject} UObject, ${$U QuickDraw} QuickDraw, ${$U FontMgr} FontMgr, ${$U UDraw} UDraw, ${$U WM.Events} Events, ${$U WM.Folders} Folders, ${$U WM.Menus} Menus, ${$U Scrap} Scrap, ${$U FilerComm} FilerComm, ${$U UABC} UABC; CONST ${known tool IDs} $idLisaWrite = 1; $idLisaGraph = 2; $idLisaCalc = 3; $idLisaDraw = 4; $idLisaList = 5; $idLisaBalls = 6; $idLisaGuide = 7; $idLisaProject = 8; $idLisaTerminal = 10; $idPreferences = 11; $idCalculator = 12; $idClock = 13; $idMacWrite = 14; $idMacPaint = 15; $idMacDraw = 16; TYPE $TIconKind = (iDocument, iStationery, iTool); $TIconName = STRING[80]; $TCopyIconRefCmd = SUBCLASS OF TCommand ({Fields} ({Creation/Destruction} (FUNCTION TCopyIconRefCmd.CREATE(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber; @itsImage: TImage; itsRevelation: TRevelation): TCopyIconRefCmd; &{Command Execution} (PROCEDURE TCopyIconRefCmd.Perform(cmdPhase: TCmdPhase); OVERRIDE; ({Enumerating Icon References} (PROCEDURE TCopyIconRefCmd.EachIconRef(PROCEDURE CopyIcon(iconKind: TIconKind; TtoolNumber: LONGINT; TiconName: TIconName; TexternalName: S255)); DEFAULT; $END; $TPasteIconRefCmd = SUBCLASS OF TPasteCommand ({Fields} ({Creation/Destruction} (FUNCTION TPasteIconRefCmd.CREATE(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber; @itsImage: TImage; itsRevelation: TRevelation): TPasteIconRefCmd; ({Command Execution} (PROCEDURE TPasteIconRefCmd.Perform(cmdPhase: TCmdPhase); OVERRIDE; ({Enumerating Icon References} (PROCEDURE TPasteIconRefCmd.BeginPaste; DEFAULT; (PROCEDURE TPasteIconRefCmd.PasteIcon(iconKind: TIconKind; MtoolNumber: LONGINT; MVAR iconName: TIconName; MVAR prefix: TFilePath; MVAR password: TPassword); DEFAULT; (PROCEDURE TPasteIconRefCmd.EndPaste(error: INTEGER); DEFAULT; $END; $TIRefView = SUBCLASS OF TView ({Fields} ({Creation/Destruction} (FUNCTION TIRefView.CREATE(object: TObject; heap: THeap; DitsExtent: LRect; itsPanel: TPanel): TIRefView; ({Drawing} (PROCEDURE TIRefView.Draw; OVERRIDE; $END; IMPLEMENTATION {$I UIconRef2.TEXT} END. 3. "6F^5D!$ǐ^B%Y?Y?VAR $kindMapping: ARRAY[TIconKind] OF INTEGER; $identity: TIconRef; {global used by PastIcon procedure} $pasteIconCmd: TPasteIconRefCmd; METHODS OF TCopyIconRefCmd; $FUNCTION TCopyIconRefCmd.CREATE(object: TObject; heap: THeap; itsCmdNumber: TCmdNumber;  0 THEN 4ABCbreak('Error from StartIconRef=',err); 0{$ENDC} 0SELF.EachIconRef(CopyIcon); 0EndIconRef; 0theClipboard := clipboard; 0StartPutScrap(err); 0{$IFC fDbgOK} 0IF err > 0 THEN 4ABCbreak('TCopyIconRefCmd.Perform: Error from StartPutScrap=', err); 0{$ENDC} 0heap := POINTER(ORD(hzOfScrap)); 0theClipboard.docHeap := heap; 0{Create a standard window onto the clipboard} 0window := theClipboard.NewWindow(heap, ORD(scrapFolder)); 0theClipboard.window := window; 0panel := TPanel.CREATE(NIL, heap, window, 0, 0, [aScroll, aSplit], [aScroll, aSplit]); 0clipPrintPref := boundDocument.dataSegment.preludePtr^.printPref; 0GetScrap(scrapKind, heapHdl); 0{$IFC fDbgOK} 0IF scrapKind <> scrapRef THEN 4ABCbreak('scrapKind <> scrapRef', scrapKind); 0{$ENDC} 0noPad.RectToLRect(PicHandle(heapHdl)^^.picFrame, viewLRect); 0WITH viewLRect.topLeft DO 4OffsetLRect(viewLRect, -h ,-v); 0iconRefView := TIRefView.CREATE(NIL, heap, viewLRect, panel); 0{UABC2 assumes that if we put icons in the scrap, 4then the refcon of the scrapFolder is the docDirectory} 0docDirectory := TDocDirectory.CREATE(NIL, heap, window, myWorld); 0SetFldrRefcon(scrapFolder, Ord(docDirectory)); 0EndPutScrap(err); 0{$IFC fDbgOK} 0IF err > 0 THEN 4ABCbreak('TCopyIconRefCmd.Perform: Error from EndPutScrap=', err); 0{$ENDC} 0theClipboard.Inspect; 0END; ,undoPhase, redoPhase: 0IF NOT clipboard.UndoCut THEN 4BEGIN 4{$IFC fDbgABC} 4ABCbreak('clipboard.UndoCut returns FALSE', ORD(cmdPhase)); 4{$ENDC} 4END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; ${Enumerating Icon References} $PROCEDURE TCopyIconRefCmd.EachIconRef(PROCEDURE CopyIcon(iconKind: TIconKind; PtoolNumber: LONGINT; PiconName: TIconName; PexternalName: S255)); $BEGIN ({$IFC fTrace}BP(10);{$ENDC} ({$IFC fDbgOK} (ABCbreak('TCopyIconRefCmd.EachIconRef was not implemented', 0); ({$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; BEGIN kindMapping[iDocument] := docKind; kindMapping[iStationery] := docPad; kindMapping[iTool] := toolKind; END; {This must be a procedure at the top level} $PROCEDURE DoPasteIcon; (VAR iconKind: TIconKind; $BEGIN (WITH identity DO ,BEGIN ,CASE kind OF 0toolKind: iconKind := iTool; 0docPad: iconKind := iStationery; 0docKind: iconKind := iDocument; 0OTHERWISE 4BEGIN 4{$IFC fDbgOK} 4WriteLn('Unexpected kind of icon=', kind:1, ' toolID=', toolId:1); 4WriteLn('userName="', userName, '"'); 4WriteLn('diskName="', diskName, '"'); 4WriteLn('password="', password, '"'); 4{$ENDC} 4Exit(DoPasteIcon); 4END; 0END; ,pasteIconCmd.PasteIcon(iconKind, toolID, TIconName(userName),  0 THEN ,ABCbreak('Error from StartIconRef=',err); ({$ENDC} (StartGetScrap(err); {DrawRefScrap does EndGetScrap} ({$IFC fTrace}EP;{$ENDC} $END; END; %F B-LOWER-MBOXER.TEXT,$ B-LOWER-UBOXER=.TEXT,$ Y B-LOWER-PBOXER.TEXT,$ B-LOWER-XBOXER.TEXT,$ B-LOWER-UPALETTE=.TEXT,$ Y B-LOWER-MCB2SAMPLE.TEXT,$ B-LOWER-UCB2SAMPLE=.TEXT,$ Y B-LOWER-PCB2SAMPLE.TEXT,$ B-LOWER-XCB2SAMPLE.TEXT,$ B-LOWER-MCLOCK.TEXT,$ B-LOWER-UCLOCK=.TEXT,$ Y B-LOWER-PCLOCK.TEXT,$ B-LOWER-XCLOCK.TEXT,$ B-LOWER-UTIMER=.TEXT,$ Y B-LOWER-MKEYBOARD.TEXT,$ B-LOWER-UKEYBOARD=.TEXT,$ Y B-LOWER-PKEYBOARD.TEXT,$ B-LOWER-XKEYBOARD.TEXT,$ B-LOWER-MREADER.TEXT,$ B-LOWER-UREADER=.TEXT,$ Y B-LOWER-PREADER.TEXT,$ B-LOWER-XREADER.TEXT,$ B-LOWER-UICONREF=.TEXT,$ Y Q %% %%% eCmd.CREATE(object: TObject; heap: THeap; itsImage: TImage): TPasteRecipeCmd; (PROCEDURE TPasteRecipeCmd.DoPaste(clipSelection: TSelection; Ppic: PicHandle; cmdPhase: TCmdPhase); OVERRIDE; (END; {Subclasses that are always required so that we operate in the application's environment rather than the ToolKit's generic environment} $TMyProcess = SUBCLASS OF TProcess &{Creation/Destruction} (FUNCTION TMyProcess.CREATE: TMyProcess; (PROCEDURE TMyProcess.Commence(phraseVersion: INTEGER); OVERRIDE; (FUNCTION TMyProcess.NewDocManager(volumePrefix: TFilePath; openAsTool: BOOLEAN): TDocManager; OVERRIDE; (END; $TMyDocManager = SUBCLASS OF TDocManager &{Creation/Destruction} (FUNCTION TMyDocManager.CREATE(object: TObject; heap: THeap; itsPathPrefix: TFilePath): TMyDocManager; (FUNCTION TMyDocManager.NewWindow(heap: THeap; wmgrID: TWindowID): TWindow; OVERRIDE; (END; $TMyWindow = SUBCLASS OF TWindow &{Variables} (styleSheet: TStyleSheet; (cookBookPanel: TPanel; (chapterPanel: TPanel; (recipePanel: TPanel; (dialogWindow: TDialogWindow; (dialog: TDialog; (inputFrame: TInputFrame; (okayToHilite: BOOLEAN; {kludge described in implementation of PerformLast} &{Creation/Destruction} (FUNCTION TMyWindow.CREATE(object: TObject; heap: THeap; itsWmgrID: TWindowID): TMyWindow; ({$IFC fDebugMethods} (PROCEDURE TMyWindow.Fields(PROCEDURE Field(nameAndType: S255)); OVERRIDE; ({$ENDC} &{Document Creation} (PROCEDURE TMyWindow.BlankStationery; OVERRIDE; &{Commands} (FUNCTION TMyWindow.CanDoCommand(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN; OVERRIDE; (FUNCTION TMyWindow.NewCommand(cmdNumber: TCmdNumber): TCommand; OVERRIDE; (PROCEDURE TMyWindow.PerformLast(cmdPhase: TCmdPhase); OVERRIDE; (END; IMPLEMENTATION "{$I URecipes2.text} END. 3. "6F^9D!$ǐ^<<KC1W.8~21-ST'XT 1 1. XTxXH:>:>1-CIST'T.XT$Samples/URECIPES2.TEXTxXxSamples/URECIPES2.TEXTS2.T̋H"N.8~.81-CIXTXT :#ST'T.XT'̋HLH.9START.TEXT n*-#3#1-Samples/URECIPE{URecipes2} {Implementation part of URecipes} {Copyright 1984, Apple Computer Inc.} {Note: This is a sample program that demonstrates many of the features of the Text Building Block. Not 'everything is implemented. The reader of this sample may wish to complete some the unfinished 'portions or add enhancements of his or her own. This sample has not undergone rigorous testing 'and there may be some bugs. If you find one, fix it!} CONST $tkTeam = 'Apple ToolKit/32 Team'; $direcFormat = 3; $tabColumn = 12; $ingredHeight = 10; $phReallyDelRecipe = 4002; {$IFC NOT debugMe} $fDrawRects = FALSE; $fRecipeTrace = FALSE; {$ENDC} VAR foodTitles: ARRAY [TFoodType] OF STR255; $titlesLRect: ARRAY [TFoodType] OF LRect; $chapStyles: TArray; $chapDfltStyle: TTypeStyle; $nameInRecipeStyle: TTypeStyle; $ingredStyle: TTypeStyle; $cbStyle: TTypeStyle; $direcStyle: TTypeStyle; {$IFC debugMe} $fRecipeTrace: BOOLEAN; $fDrawRects: BOOLEAN; {$ENDC} $rHandle: RgnHandle; METHODS OF TRecipe; $FUNCTION TRecipe.CREATE(object: TObject; heap: THeap; itsName: TString; itsIngredients: TList; hitsDirections: TList): TRecipe; $VAR firstIngred: TString; (firstPara: TParagraph; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TRecipe(object); (IF itsName = NIL THEN ,itsName := TString.CREATE(NIL, heap, 0); (IF itsIngredients = NIL THEN ,BEGIN ,itsIngredients := TList.CREATE(NIL, heap, 0); ,firstIngred := TString.CREATE(NIL, heap, 0); ,itsIngredients.InsLast(firstIngred); ,END; (IF itsDirections = NIL THEN ,BEGIN ,itsDirections := TList.CREATE(NIL, heap, 0); ,firstPara := TParagraph.CREATE(NIL, heap, 0, direcStyle); ,itsDirections.InsLast(firstPara); ,END; (WITH SELF DO ,BEGIN ,name := itsName; ,ingredients := itsIngredients; ,directions := itsDirections; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRecipe.Free; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.name.Free; (SELF.ingredients.Free; (SELF.directions.Free; (SUPERSELF.Free; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TRecipe.Clone(heap: THeap): TObject; $VAR clName: TString; (clIngred: TList; (clDirec: TList; (clRecipe: TRecipe; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (clName := TString(SELF.name.Clone(heap)); (clIngred := TList(SELF.ingredients.Clone(heap)); (clDirec := TList(SELF.directions.Clone(heap)); (clRecipe := TRecipe(SUPERSELF.Clone(heap)); (WITH clrecipe DO ,BEGIN ,name := clName; ,ingredients := clIngred; ,directions := clDirec; ,END; (Clone := clRecipe; ({$IFC fTrace}EP;{$ENDC} $END; #{$IFC fDebugMethods} $PROCEDURE TRecipe.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('name: TString'); (Field('ingredients: TList'); (Field('directions: TList'); (Field(''); $END; ${$ENDC} $FUNCTION TRecipe.MakeIntoImage(itsView: TView): TRecipeImage; ${This Function creates a displayable image from a TRecipe object. It takes each field of TRecipe %and creates a text image capable of displaying it. The reader may wish modify this routine to %implement one of the features not demonstrated in this sample program. That feature is the ability %to have text flow from one box to another. There is a boolean field in TRecipeImage called %twoColumn that is unused but is intended to be used to indicate whether the directions are to %be displayed as one column or two. It would be a simple matter to add the code to create a %second text image and set up the link fields in it and the directions text image so that the %directions would now appear as two columns. You may also wish to add a command to switch between %the two display modes} $VAR image: TTextImage; (nameImage: TTextImage; (direcImage: TTextImage; (ingredList: TList; (heap: THeap; (direcText: TText; (imageLRect: LRect; (styleSheet: TStyleSheet; (format: TParaFormat; (FUNCTION CreateImage(imageLRect: LRect; str: TString): TTextImage; (VAR image: TTextImage; ,text: TText; (BEGIN ,text := TText.CREATE(NIL, heap, styleSheet); ,image := text.DfltTextImage(itsView, imageLRect, FALSE); ,TEditPara(text.paragraphs.First).ReplTString(0, 0, str, 0, str.size); ,image.InvalAll; ,TParaImage(image.imageList.First).InvalLinesWith(0, MAXINT); ,image.RecomputeImages(actionNone, TRUE); ,CreateImage := image; (END; (PROCEDURE InstallImage(obj: TObject); (BEGIN ,ingredList.InsLast(CreateImage(imageLRect, TString(obj))); ,OffSetLRect(imageLRect, 0, ingredHeight); (END; (PROCEDURE AddToText(obj: TObject); (VAR editPara: TEditPara; (BEGIN ,editPara := TEditPara.CREATE(NIL, heap, TParagraph(obj).size, XTParaFormat(styleSheet.formats.At(direcFormat))); ,editPara.ReplPara(0, 0, TParagraph(obj), 0, TParagraph(obj).size); ,direcText.paragraphs.InsLast(editPara); (END; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (heap := SELF.Heap; (styleSheet := TMyWindow(itsView.panel.window).styleSheet; (SetLRect(imageLRect, 30, 10, 400, 35); ({Our local procedure CreateImage creates a textImage from the string passed in. It uses )the TText routine DfltTextImage to generate all the neccessary data structures. The problem )with using this short cut routine, however, is that it uses the first paraFormat in the )styleSheet when creating the paragraph. For the recipe name we want to use the second format )so we do a little funny stuff here to temporarily make the second format become the first format} (format := TParaFormat(styleSheet.formats.First); (styleSheet.formats.DelAt(1, FALSE); (nameImage := CreateImage(imageLRect, SELF.name); (styleSheet.formats.InsFirst(format); (ingredList := TList.CREATE(NIL, heap, 0); (SetLRect(imageLRect, 50, 40, 400, 40+ingredHeight); (SELF.ingredients.Each(InstallImage); (direcText := TText.CREATE(NIL, heap, TMyWindow(itsView.panel.window).styleSheet); (SELF.directions.Each(AddToText); (WITH imageLRect DO ,SetLRect(imageLRect, 30, bottom+15, 500, bottom+100); (direcImage := TTextImage.CREATE(NIL, heap, itsView, imageLRect, direcText, TRUE); (direcText.txtImgList.InsLast(direcImage); ({Test for two colmns goes here. NOTE: Do NOT add the text image of the seconmd column to )direcText.txtImgList. Only "head" textImages are put in this list} (direcImage.RecomputeImage(actionNone, TRUE); (MakeIntoImage := TRecipeImage.CREATE(NIL, heap, itsView, nameImage, ingredList, direcImage); ({$IFC fTrace}EP;{$ENDC} $END; END;{METHODS OF TRecipe} METHODS OF TRecipeImage; $FUNCTION TRecipeImage.CREATE(object: TObject; heap: THeap; itsView: TView; nameImage: TTextImage; DingredList: TList; direcImage: TTextImage): TRecipeImage; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TRecipeImage(TImage.CREATE(object, heap, itsView.extentLRect, itsView)); (WITH SELF DO ,BEGIN ,name := nameImage; ,ingredients := ingredList; ,directions := direcImage; ,changed := FALSE; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRecipeImage.Free; (PROCEDURE FreeText(obj: TObject); (BEGIN ,TTextImage(obj).text.Free; (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.name.text.Free; (SELF.ingredients.Each(FreeText); (SELF.ingredients.FreeObject; (SELF.directions.text.Free; (SUPERSELF.Free; ({$IFC fTrace}EP;{$ENDC} $END; #{$IFC fDebugMethods} $PROCEDURE TRecipeImage.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('name: TTextImage'); (Field('ingredients: TList'); (Field('twoColumn: BOOLEAN'); (Field('directions: TTextImage'); (Field('changed: BOOLEAN'); (Field(''); $END; ${$ENDC} $FUNCTION TRecipeImage.CursorAt(mouseLPt: LPoint): TCursorNumber; $VAR index: LONGINT; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF SELF.ImageAt(mouseLPt, index) <> NIL THEN ,CursorAt := textCursor (ELSE ,CursorAt := SUPERSELF.CursorAt(mouseLPt); ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TRecipeImage.DismantleImage: TRecipe; $VAR nameStr: TString; (direcList: TList; (ingredList: TList; (recipe: TRecipe; (FUNCTION CreateString(textImage: TTextImage): TString; (VAR para: TEditPara; ,str: TString; (BEGIN ,para := TEditPara(textImage.text.paragraphs.First); ,str := TString.CREATE(NIL, SELF.Heap, para.size); ,str.InsManyAt(1, para, 1, para.size); ,CreateString := str; (END; (PROCEDURE InstallString(obj: TObject); (BEGIN ,ingredList.InsLast(CreateString(TTextImage(obj))); (END; (PROCEDURE AddParagraph(obj: TObject); (VAR paragraph: TParagraph; ,editPara: TEditPara; (BEGIN ,editPara := TEditPara(obj); ,paragraph := TParagraph.CREATE(NIL, SELF.heap, editPara.size, editPara.format.dfltTStyle); ,paragraph.ReplPara(0, 0, editPara, 0, editPara.size); ,direcList.InsLast(paragraph); (END; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (nameStr := CreateString(SELF.name); (ingredList := TList.CREATE(NIL, SELF.Heap, 0); (SELF.ingredients.Each(InstallString); (direcList := TList.CREATE(NIL, SELF.Heap, 0); (SELF.directions.text.paragraphs.Each(AddParagraph); (recipe := TRecipe.CREATE(NIL, SELF.Heap, nameStr, ingredList, direcList); (DismantleImage := recipe; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRecipeImage.Draw; $VAR r: LRect; (i: INTEGER; (x: LONGINT; (y: LONGINT; (PROCEDURE DrawEach(obj: TObject); (BEGIN ,IF fDrawRects THEN 0BEGIN 0PenSize(1,1); 0FrameLRect(TTextImage(obj).extentLRect); 0END; ,SetQDTypeStyle(ingredStyle); ,WITH TTextImage(obj).extentLRect DO {$H-} 0BEGIN 0MoveToL(left - 6, (top+bottom) DIV 2 + 2); 0DrawChar(''); 0END; ,TTextImage(obj).Draw; (END; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (PenNormal; (SELF.name.Draw; (SELF.ingredients.Each(DrawEach); ({draw dashed line between ingredients and directions} (r := TTextImage(SELF.ingredients.Last).extentLRect; (x := 25; (y := r.bottom + 5; (PenSize(2,2); (FOR i := 1 TO 11 DO ,BEGIN ,MoveToL(x, y); ,LineToL(x + 30, y); ,x := x + 45; ,END; (IF fDrawRects THEN ,BEGIN ,PenSize(1,1); ,FrameLRect(SELF.directions.extentLRect); ,END; (SELF.directions.Draw; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TRecipeImage.ImageAt(mouseLPt: LPoint; VAR ingredIndex: LONGINT): TTextImage; $VAR hitTxtImage: TTextImage; (s: TListScanner; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (hitTxtImage := NIL; (ingredIndex := 0; (IF LPtInLRect(mouseLPt, SELF.name.extentLRect) THEN ,hitTxtImage := SELF.name (ELSE IF LPtInLRect(mouseLPt, SELF.directions.extentLRect) THEN ,hitTxtImage := SELF.directions (ELSE ,BEGIN ,s := SELF.ingredients.Scanner; ,WHILE s.Scan(hitTxtImage) DO 0IF LPtInLRect(mouseLPt, hitTxtImage.extentLRect) THEN 4BEGIN 4ingredIndex := s.position; 4s.Done; 4END; ,END; (ImageAt := hitTxtImage; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRecipeImage.MousePress(mouseLPt: LPoint); $VAR hitTxtImage: TTextImage; (noSelection: TSelection; (panelSelection: TSelection; (needNewSel: BOOLEAN; (ingredIndex: LONGINT; (heap: THeap; (textImage: TTextImage; ({$IFC debugMe} (str: S255; ({$ENDC} $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (heap := SELF.Heap; (panelSelection := SELF.view.panel.selection; ({The user has clicked the mouse in the recipe panel. The first thing we need to do is see )which textImage the mouse was over, if any} (hitTxtImage := SELF.ImageAt(mouseLPt, ingredIndex); ({$IFC debugMe} (IF fRecipeTrace THEN ,BEGIN ,LIntToHex(ORD(hitTxtImage), @str); ,WriteLn('** In TRecipeImage.MousePress, hitTxtImg = ', str); ,END; ({$ENDC} ({If the mouse was not over any textImage we simply want to Deselect} (IF hitTxtImage = NIL THEN ,{Calling BeginSelection automatically dehighlights and frees the current selection in all -panels and replaces them with a NoSelection. Note that in this application we override -this behaviour for the two left panels (see TBookSelection.DeSelect and TChapSelection.DeSelect)} ,SELF.view.panel.BeginSelection (ELSE ,BEGIN ,{The mouse was over a textImage so we want to create a cover selection specific to which -textImage was clicked upon. We will then call the textImage's MousePress which will -establish a textSelection in our cover selection's coSelection field. -First, however we need to see if we have already done the above on a previous click, since -if we click again on the same textImage there is no need to CREATE a whole new cover -selection. We discover we need to CREATE a new cover selection if there is no current -coSelection at all or, if there is one, it's textImage is not the one that we just now -clicked on} ,needNewSel := FALSE; ,IF panelSelection.coSelection = NIL THEN 0needNewSel := TRUE ,ELSE IF TTextSelection(panelSelection.coSelection).textImage <> hitTxtImage THEN 0needNewSel := TRUE; ,IF needNewSel THEN 0BEGIN 0SELF.view.panel.BeginSelection; 0IF hitTxtImage = SELF.name THEN 4BEGIN 4panelSelection := panelSelection.FreedAndReplacedBy( HTNameSelection.CREATE(NIL, heap, SELF.view, mouseLPt)); 4{Clicking on the recipe name requires special treatment because we want any editing 5of the title to be reflected in the title displayed in the chapter panel. Thus we 5call CreateSecondTxtImg which creates all the necessary data structures} 4textImage := TRecipeView(SELF.view).CreateSecondTxtImg; 4END 0ELSE IF hitTxtImage = SELF.directions THEN 4panelSelection := panelSelection.FreedAndReplacedBy( HTDirecSelection.CREATE(NIL, heap, SELF.view, mouseLPt)) 0ELSE 4panelSelection := panelSelection.FreedAndReplacedBy( HTIngredSelection.CREATE(NIL, heap, SELF.view, mouseLPt, TSELF.ingredients, ingredIndex)); 0{When we CREATE a cover selection, we need to set its coSelection field to NoSelection 1beacause MousePress below will try to Free and replace it with a textSelection} 0noSelection := SELF.view.NoSelection; 0panelSelection.coSelection := noSelection; 0END ,ELSE IF hitTxtImage = SELF.name THEN 0{The user has clicked a second or greater time on the name field in the recipe. 1Normally all selections are automatically turned off by the Text Building block 1in textImage.MousePress which would turn off the insertion point in the chapter 1panel, but it cannot automatically turn off selections in other panels if the 1selection is a coSelection of the panel selection, so we must do it ourselves here} 0BEGIN 0panelSelection := TMyWindow(SELF.view.panel.window).chapterPanel.selection.coSelection; 0TMyWindow(SELF.view.panel.window).chapterPanel.Highlight(panelSelection, hOnToOff); 0END; ,hitTxtImage.MousePress(mouseLPt); ,END; ({Until we can think of something better, always set changed flag if the user clicks here} (SELF.changed := TRUE; ({$IFC fTrace}EP;{$ENDC} $END; BEGIN {$IFC debugMe} $fDrawRects := FALSE; {$ENDC} END; METHODS OF TCookBookView; $FUNCTION TCookBookView.CREATE(object: TObject; heap: THeap; itsPanel: TPanel; `itsExtent: LRect): TCookBookView; $VAR aList: TList; (food: TFoodType; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TCookBookView(itsPanel.NewView(object, itsExtent, NIL, stdMargins, FALSE)); (FOR food := mainCourse TO dessert DO ,BEGIN ,aList := TList.CREATE(NIL, heap, 0); ,SELF.headings[food] := aList; ,END; ({$IFC fTrace}EP;{$ENDC} $END; #{$IFC fDebugMethods} $PROCEDURE TCookBookView.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('headings: ARRAY [1..5] OF TList'); (Field(''); $END; ${$ENDC} $PROCEDURE TCookBookView.Draw; $VAR food: TFoodType; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (PenNormal; (PenSize(1,1); (SetQDTypeStyle(cbStyle); (FOR food := mainCourse TO dessert DO ,BEGIN ,MoveToL(titlesLRect[food].left + 10, titlesLRect[food].top + 10); ,DrawString(foodTitles[food]); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TCookBookView.MousePress(mouseLPt: LPoint); $VAR food: TFoodType; (bookSel: TBookSelection; (chapView: TChapterView; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.panel.BeginSelection; (bookSel := TBookSelection(SELF.panel.selection); (chapView := TChapterView(TMyWindow(SELF.panel.window).chapterPanel.view); (titlesLRect[noFood] := SELF.extentLrect; (food := mainCourse; (WHILE NOT LPtInLRect(mouseLPt, titlesLRect[food]) DO ,food := SUCC(food); (IF bookSel.currFood <> food THEN ,BEGIN ,SELF.panel.Highlight(bookSel, hOnToOff); ,bookSel.currFood := food; ,SELF.panel.Highlight(bookSel, hOffToOn); ,chapView.ChangeFood(food); ,END; ({$IFC fTrace}EP;{$ENDC} $END; {Creation Block} BEGIN ${SHOULD READ FROM PHRASE FILE!!!} $foodTitles[mainCourse] := 'Main Courses'; $foodTitles[soup] := 'Soups'; $foodTitles[appetizer] := 'Appetizers'; $foodTitles[sandwich] := 'Sandwiches'; $foodTitles[dessert] := 'Desserts'; $SetLRect(titlesLRect[mainCourse], 10, 5, 170, 20); $SetLRect(titlesLRect[soup], 10, 20, 170, 35); $SetLRect(titlesLRect[appetizer], 10, 35, 170, 50); $SetLRect(titlesLRect[sandwich], 10, 50, 170, 65); $SetLRect(titlesLRect[dessert], 10, 65, 170, 80); END; METHODS OF TChapterView; $FUNCTION TChapterView.CREATE(object: TObject; heap: THeap; itsPanel: TPanel; `itsExtent: LRect): TChapterView; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TChapterView(itsPanel.NewView(object, itsExtent, NIL, stdMargins, FALSE)); (WITH SELF DO ,BEGIN ,recipes := NIL; ,editImage := NIL; ,foodType := noFood; ,END; ({$IFC fTrace}EP;{$ENDC} $END; #{$IFC fDebugMethods} $PROCEDURE TChapterView.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('foodType: INTEGER'); (Field('recipes: TList'); (Field('editImage: TTextImage'); (Field(''); $END; ${$ENDC} $PROCEDURE TChapterView.ChangeFood(food: TFoodTypes); $VAR recipeView: TRecipeView; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} ({This forces the last commmand to Commit so we don't have to hang on to old data structures )just in case the user wants to Undo. (Hence, of course, the user cannot Undo after bringing )up a new chapter)} (SELF.panel.window.CommitLast; (SELF.panel.window.SaveCommand(NIL); (recipeView := TRecipeView(TMyWindow(SELF.panel.window).recipePanel.view); (recipeView.FreeRecipeImage; (SELF.foodType := food; (IF food = noFood THEN ,SELF.recipes := NIL (ELSE ,SELF.recipes := TCookBookView(TMyWindow(SELF.panel.window).cookBookPanel.view).headings[food]; (TChapSelection(SELF.panel.selection).recipeIndex := 0; (SELF.panel.Invalidate; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TChapterView.CursorAt(mouseLPt: LPoint): TCursorNumber; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF SELF.editImage <> NIL THEN ,IF LPtInLRect(mouseLPt, SELF.editImage.extentLRect) THEN 0CursorAt := textCursor ,ELSE 0CursorAt := arrowCursor (ELSE ,CursorAt := SUPERSELF.CursorAt(mouseLPt); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TChapterView.Draw; $VAR r: LRect; (x: LONGINT; (y: LONGINT; (index: INTEGER; (theIndex: INTEGER; (PROCEDURE DrawIt(obj: TObject); (VAR name: TString; (BEGIN ,index := index + 1; ,IF index = theIndex THEN 0BEGIN 0TTextImage(TRecipeView(TMyWindow( 4SELF.panel.window).recipePanel.view).recipeImage.name.text.txtImgList.Last).Draw; 0SetQDTypeStyle(chapDfltStyle); 0END ,ELSE 0BEGIN 0MoveToL(x, y); 0name := TRecipe(obj).name; 0name.Draw(1, name.size); 0y := y + 14; 0END; (END; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (PenNormal; (SetQDTypeStyle(chapDfltStyle); (IF SELF.panel.selection.coSelection <> NIL THEN ,theIndex := TChapSelection(SELF.panel.selection).recipeIndex (ELSE ,theIndex := 0; (x := 10; (y := 14; (index := 0; (IF SELF.recipes <> NIL THEN ,IF SELF.recipes.size > 0 THEN 0SELF.recipes.Each(DrawIt) ,ELSE 0BEGIN 0MoveToL(10, 14); 0TextFace([italic]); 0DrawString('no recipes'); 0END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TChapterView.MousePress(mouseLPt: LPoint); $VAR recipe: TRecipe; (currRecipe: TRecipe; (recipeView: TRecipeView; (chapSelection: TChapSelection; (textImage: TTextImage; (index: INTEGER; (selection: TSelection; (noSelection: TSelection; (FUNCTION FindRecipe(lPt: LPoint): TRecipe; (VAR stillLooking: BOOLEAN; ,x: LONGINT; (BEGIN ,x := 14; ,index := 0; ,stillLooking := SELF.recipes.size > 0; ,WHILE stillLooking DO 0BEGIN 0index := index + 1; 0IF lPt.v < x THEN 4stillLooking := FALSE 0ELSE 4IF index >= SELF.recipes.size THEN 8BEGIN 8stillLooking := FALSE; 8index := 0; 8END 4ELSE 8x := x + 14; 0END; ,IF index = 0 THEN 0FindRecipe := NIL ,ELSE 0FindRecipe := TRecipe(SELF.recipes.At(index)); (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF SELF.recipes <> NIL THEN ,BEGIN ,recipe := FindRecipe(mouseLPt); ,recipeView := TRecipeView(TMyWindow(SELF.panel.window).recipePanel.view); ,chapSelection := TChapSelection(SELF.panel.selection); ,IF chapSelection.recipeIndex <> 0 THEN 0currRecipe := TRecipe(SELF.recipes.At(chapSelection.recipeIndex)) ,ELSE 0currRecipe := NIL; ,IF currRecipe <> recipe THEN 0BEGIN 0SELF.panel.BeginSelection; 0recipeView.ChangeRecipe(recipe); 0chapSelection.panel.Highlight(chapSelection, hOnToOff); 0chapSelection.recipeindex := index; 0chapSelection.panel.Highlight(chapSelection, hOffToOn); 0SELF.editImage := NIL; 0END ,ELSE IF recipe <> NIL THEN 0BEGIN 0{The user has clicked a second time on the same recipe name, which means she wants 1to edit it. Thus we need to set up a textImage in this panel that points to the 1same text object as the name in the recipe panel. When we do this, editing of the 1recipe name will be reflected in both panels simultaneously. CreateSecondTxtImg also 1unhighlights the chapterSelection and installs a NoSelection in its coSelection field. 1Notice that CreateSecondTxtImg is also called when the user clicks on the recipe name 1in the recipe panel (See TRecipeImage.MousePress)} 0IF chapSelection.coSelection = NIL THEN 4BEGIN 4SELF.panel.BeginSelection; 4textImage := recipeView.CreateSecondTxtImg; 4selection := recipeView.panel.selection.FreedAndReplacedBy( HTNameSelection.CREATE(NIL, SELF.Heap, recipeView, mouseLPt)); 4noSelection := recipeView.NoSelection; 4selection.coSelection := noSelection; 4textImage.MousePress(mouseLPt); 4END 0ELSE 4BEGIN 4{We must explicitly turn off the highlighting of the name in the recipe panel because 5the text building block is unable to do this automatically when coSelections are used} 4selection := recipeView.panel.selection.coSelection; 4recipeView.panel.Highlight(selection, hOnToOff); 4SELF.editImage.MousePress(mouseLPt); 4END 0END ,ELSE 0SELF.editImage := NIL; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TChapterView.NewRecipe(recipeName: STR255): TRecipe; $VAR itsName: TString; (firstIngred: TString; (itsIngredients: TList; (itsDirections: TList; (firstPara: TParagraph; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (itsName := TString.CREATE(NIL, SELF.Heap, Length(recipeName)); (itsName.InsPStrAt(1, @recipeName); (NewRecipe := TRecipe.CREATE(NIL, SELF.Heap, itsName, NIL, NIL); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TRecipeView; $FUNCTION TRecipeView.CREATE(object: TObject; heap: THeap; itsPanel: TPanel; `itsExtent: LRect): TRecipeView; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TRecipeView(itsPanel.NewView(object, itsExtent, TPrintManager.CREATE(NIL, heap), pstdMargins, FALSE)); (WITH SELF DO ,BEGIN ,recipeImage := NIL; ,{The Reader may wish to use this field to disallow editing of recipes} ,canEdit := TRUE; ,END; ({$IFC fTrace}EP;{$ENDC} $END; #{$IFC fDebugMethods} $PROCEDURE TRecipeView.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('recipeImage: TRecipeImage'); (Field('canEdit: BOOLEAN'); (Field(''); $END; ${$ENDC} $PROCEDURE TRecipeView.ChangeRecipe(recipe: TRecipe); $VAR recipeImage: TRecipeImage; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} ({This forces the last commmand to Commit so we don't have to hang on to old data structures )just in case the user wants to Undo. (Hence, of course, the user cannot Undo after bringing )up a new recipe)} (SELF.panel.window.CommitLast; (SELF.panel.window.SaveCommand(NIL); (SELF.FreeRecipeImage; (IF recipe <> NIL THEN ,BEGIN ,recipeImage := recipe.MakeIntoImage(SELF); ,SELF.recipeImage := recipeImage; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TRecipeView.CreateSecondTxtImg: TTextImage; ${This routine is called when the user clicks on the recipe name either the first time in the recipe %panel (this view's panel) or the second time on the name in the chapterPanel. (See TRecipeImage. %MousePress and TChapterView.Mousepress.) Here we CREATE a TChapTextImage of the name in the %chapter panel. (See TChapTextImage.FilterAndDo for discussion of why we sub-classed TTextImage.) %Also in this routine we unhighlight the current chapter panel selection and install a NoSelection %in the coSelection field. The calling routine will next call textImage.MousePress to install the %textSelection in the coSelection. Finally, in this routine, we call RecomputeImages which will %compute the paraImage for the chapter panel} $VAR name: TTextImage; (textImage: TTextImage; (chapView: TChapterView; (r: LRect; (fInfo: FontInfo; (recipeIndex: LONGINT; (selection: TSelection; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (chapView := TChapterView(TMyWindow(SELF.panel.window).chapterPanel.view); (name := SELF.recipeImage.name; (recipeIndex := TChapSelection(chapView.panel.selection).recipeIndex; (SetQDTypeSTyle(chapDfltStyle); (GetFontInfo(fInfo); (SetLRect(r, 10, recipeIndex * 14 - fInfo.ascent, 150, (recipeIndex + 1) * 14 - fInfo.ascent); (textImage := TChapTextImage.CREATE(NIL, SELF.Heap, chapView, r, name.text, FALSE); (name.text.txtImgList.InsLast(textImage); (textImage.RecomputeImage(actionNone, TRUE); (chapView.panel.Highlight(chapView.panel.selection, hOnToOff); (selection := chapView.NoSelection; (chapView.panel.selection.coSelection := selection; (textImage.RecomputeImages(actionNone, TRUE); (SELF.recipeImage.changed := TRUE; (chapView.editImage := textImage; (CreateSecondTxtImg := textImage; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TRecipeView.CursorAt(mouseLPt: LPoint): TCursorNumber; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF SELF.recipeImage <> NIL THEN ,CursorAt := SELF.recipeImage.CursorAt(mouseLPt) (ELSE ,CursorAt := SUPERSELF.CursorAt(mouseLPt); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRecipeView.Draw; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF SELF.recipeImage <> NIL THEN ,SELF.recipeImage.Draw; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRecipeView.FreeRecipeImage; $VAR chapPanel: TPanel; (chapView: TChapterView; (chapSelection: TChapSelection; (recipe: TRecipe; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF SELF.recipeImage <> NIL THEN ,BEGIN ,IF SELF.recipeImage.changed THEN 0BEGIN 0recipe := SELF.recipeImage.DismantleImage; 0chapPanel := TMyWindow(SELF.panel.window).chapterPanel; 0chapView := TChapterView(chapPanel.view); 0chapSelection := TChapSelection(chapPanel.selection); 0chapView.recipes.PutAt(chapSelection.recipeIndex, recipe, TRUE); 0END; ,SELF.recipeImage.Free; ,SELF.recipeImage := NIL; ,END; (SELF.panel.Invalidate; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRecipeView.MousePress(mouseLPt: LPoint); $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF SELF.canEdit AND (SELF.recipeImage <> NIL) THEN ,SELF.recipeImage.MousePress(mouseLPt) (ELSE ,BEGIN ,{Alert about can't edit; use menu to enable; (based on recipeImage NIL or not} {*} ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TRecipeView.ScrollStuff(ingredIndex: LONGINT; moveDown: BOOLEAN); {This routine is called when an ingredient is inserted or deleted. It updates the appropriate text image's extentLRects and then calls QuickDraw's ScrollRect to Scroll the correct portion of the view up or down. Notice we use ScrollRect here instead of the normal paradigm of invalidating a portion of the screen and waiting for TWindow.Update to tell us to Draw. We're doing it here for speed; scrolling is faster than redrawing, but we have to know exactly what's going on on the screen lest we scroll something that should not have moved} $VAR recipeImage: TRecipeImage; (delta: INTEGER; (scanIndex: LONGINT; (s: TListScanner; (textImage: TTextImage; (deltaLPt: LPoint; (lr: LRect; (r: Rect; (top: LONGINT; (PROCEDURE ScrollIt; (BEGIN ,thePad.LRectToRect(lr, r); ,ScrollRect(r, 0, delta, rHandle); ,thePad.InvalRect(rHandle^^.rgnBBox); (END; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (recipeImage := SELF.recipeImage; (IF moveDown THEN ,BEGIN ,scanIndex := ingredIndex; ,delta := ingredHeight; ,END (ELSE ,BEGIN ,scanIndex := ingredIndex - 1; ,delta := -ingredHeight; ,END; (SetLPt(deltaLpt, 0, delta); (s := recipeImage.ingredients.ScannerFrom(scanIndex, scanForward); (WHILE s.Scan(textImage) DO ,textImage.OffSetBy(deltaLPt); (recipeImage.directions.OffsetBy(deltaLPt); (IF ingredIndex <= recipeImage.ingredients.size THEN ,top := TTextImage(recipeImage.ingredients.At(ingredIndex)).extentLRect.top (ELSE ,top := TTextImage(recipeImage.ingredients.Last).extentLRect.bottom; (SetLRect(lr, 0, top, 500, SELF.extentLRect.bottom); (SELF.panel.OnAllPadsDo(ScrollIt); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TRecipeClipView; $FUNCTION TRecipeClipView.CREATE(object: TObject; heap: THeap; itsPanel: TPanel; itsExtent: LRect; PitsFoodType: TFoodType; itsRecipe: TRecipe): TRecipeClipView; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TRecipeClipView(itsPanel.NewView(object, itsExtent, NIL, stdMargins, FALSE)); (WITH SELF DO ,BEGIN ,foodType := itsFoodType; ,recipe := itsRecipe; ,END; ({$IFC fTrace}EP;{$ENDC} $END; #{$IFC fDebugMethods} $PROCEDURE TRecipeClipView.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('foodType: INTEGER'); (Field('recipe: TRecipe'); (Field(''); $END; ${$ENDC} $PROCEDURE TRecipeClipView.Draw; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF SELF.recipe <> NIL THEN ,BEGIN ,SetQDTypeStyle(nameInRecipeStyle); ,MoveToL(10, 10); ,SELF.recipe.name.Draw(1, SELF.recipe.name.size); ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TClipSelection; $FUNCTION TClipSelection.CREATE(object: TObject; heap: THeap; itsView: TView): TClipSelection; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TClipSelection(TSelection.CREATE(object, heap, itsView, somethingKind, zeroLPt)); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TBookSelection; $FUNCTION TBookSelection.CREATE(object: TObject; heap: THeap; itsView: TView; GitsAnchorLPt: LPoint; whatFood: TFoodTypes): TBookSelection; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TBookSelection(TSelection.CREATE(object, heap, itsView, somethingKind, itsAnchorLPt)); (SELF.currFood := whatFood; ({$IFC fTrace}EP;{$ENDC} $END; #{$IFC fDebugMethods} $PROCEDURE TBookSelection.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('currFood: INTEGER'); (Field(''); $END; ${$ENDC} $PROCEDURE TBookSelection.Deselect; $VAR selection: TSelection; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} ({When a selection is created, panel.BeginSelection is called which calls selection.Deselect )for each panel in the window. The default of Deselect is to unHighlight and replace SELF )with a noSelection. But in our case we don't want to do either of those when someone is )editing in the recipe panel so we override deselect to do nothing} ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TBookSelection.Highlight(highTransit: THighTransit); $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (SetPenState(highPen[highTransit]); (IF (SELF.currFood <> noFood) AND TMyWindow(SELF.window).okayToHilite THEN ,CASE highTransit OF 0hOnToDim: 4BEGIN 4InvrtLRect(titlesLRect[SELF.currFood]); {this is the same as hOnToOff} 4SELF.Highlight(hOffToDim); {this is NOT the same as just doing `FrameLRect(titlesLRect[SELF.currFood]); ]because the pen state is different} 4END; 0hDimToOn: 4BEGIN 4SELF.Highlight(hDimToOff); 4InvrtLRect(titlesLRect[SELF.currFood]); {this is the same as hOnToOff} 4END; 0hOffToDim, hDimToOff: 4BEGIN 4FrameLRect(titlesLRect[SELF.currFood]); 4END; 0OTHERWISE 4PaintLRect(titlesLRect[SELF.currFood]); ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TTextCoverSelection; $FUNCTION TTextCoverSelection.CREATE(object: TObject; heap: THeap; itsView: TView; XitsAnchorLPt: LPoint): TTextCoverSelection; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TTextCoverSelection(TSelection.CREATE(object, heap, itsView, somethingKind, itsAnchorLPt)); ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TTextCoverSelection.CanDoCommand(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (CASE cmdNumber OF ,uModern, uClassic, u20Pitch, u15Pitch, u12Pitch, u10Pitch, ,u12Point, u14Point, u18Point, u24Point: 0BEGIN 0CanDoCommand := FALSE; 0END; ,uPlain, uBold, uItalic, uUnderline, uShadow, uOutline: 0BEGIN 0CanDoCommand := FALSE; 0END; ,uPaste: 0BEGIN 0CanDoCommand := FALSE; 0END; ,OTHERWISE 0CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TChapSelection; $FUNCTION TChapSelection.CREATE(object: TObject; heap: THeap; itsView: TView; GitsAnchorLPt: LPoint): TChapSelection; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TChapSelection(TSelection.CREATE(object, heap, itsView, somethingKind, itsAnchorLPt)); (WITH SELF DO ,BEGIN ,recipeIndex := 0; ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TChapSelection.Free; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (IF SELF.coSelection <> NIL THEN ,TChapTextImage(TTextSelection(SELF.coSelection).textImage).ChangeRefCountBy(-1); (SUPERSELF.Free; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TChapSelection.Clone(heap: THeap): TObject; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (Clone := SUPERSELF.Clone(heap); (IF SELF.coSelection <> NIL THEN ,TChapTextImage(TTextSelection(SELF.coSelection).textImage).ChangeRefCountBy(1); ({$IFC fTrace}EP;{$ENDC} $END; #{$IFC fDebugMethods} $PROCEDURE TChapSelection.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('recipeIndex: INTEGER'); (Field(''); $END; ${$ENDC} $PROCEDURE TChapSelection.AddRecipe(recipeName: STR255); $VAR chapView: TChapterView; (str: STR255; (newRecipe: TRecipe; (s: TListScanner; (recipe: TRecipe; (inserted: BOOLEAN; (recipes: TList; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} ,chapView := TChapterView(SELF.view); ,recipes := chapView.recipes; ,newRecipe := chapView.NewRecipe(recipeName); ,TRecipeView(TMyWindow(SELF.window).recipePanel.view).ChangeRecipe(newRecipe); ,s := recipes.Scanner; ,inserted := FALSE; ,WHILE s.Scan(recipe) DO 0BEGIN 0recipe.name.ToPStr(@str); 0IF recipeName < str THEN 4BEGIN 4inserted := TRUE; 4SELF.recipeIndex := s.position; 4s.Skip(-1); 4s.Append(newRecipe); 4s.Done; 4END; 0END; ,IF NOT inserted THEN 0BEGIN 0recipes.InsLast(newRecipe); 0SELF.recipeIndex := recipes.size; 0END; ,chapView.panel.Invalidate; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TChapSelection.Deselect; $VAR selection: TSelection; $BEGIN ({$IFC fTrace}BP(7);{$ENDC} ({When a selection is created, panel.BeginSelection is called which calls selection.Deselect )for each panel in the window. The default of Deselect is to unHighlight and replace SELF )with a NoSelection. But in our case we want the recipe name to remain highlighted when )someone is editing in the recipe panel so we override Deselect so that it does not Free )the selection. )However, if someone was editing the recipe name, then we want to, unhighlight whatever )textSelections existed and rehighlight the entire recipe name} )IF SELF.coSelection <> NIL THEN ,BEGIN ,SELF.panel.Highlight(SELF.coSelection, hOnToOff); ,TChapTextImage(TTextSelection(SELF.coSelection).textImage).ChangeRefCountBy(-1); ,SELF.coSelection.Free; ,SELF.coSelection := NIL; ,SELF.panel.Highlight(SELF, hOffToOn); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TChapSelection.Highlight(highTransit: THighTransit); $VAR r: LRect; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (SetPenState(highPen[highTransit]); (IF SELF.coSelection = NIL THEN ,BEGIN ,IF (SELF.recipeIndex <> 0) AND TMyWindow(SELF.window).okayToHilite THEN 0BEGIN 0SetLRect(r, 5, SELF.recipeIndex*14 - 10, 150, SELF.recipeIndex*14 + 4); 0CASE highTransit OF 4hOnToDim: 8BEGIN 8InvrtLRect(r); {this is the same as hOnToOff} 8SELF.Highlight(hOffToDim); {this is NOT the same as just doing dFrameLRect(titlesLRect[SELF.currFood]); abecause the pen state is different} 8END; 4hDimToOn: 8BEGIN 8SELF.Highlight(hDimToOff); 8InvrtLRect(r); {this is the same as hOnToOff} 8END; 4hOffToDim, hDimToOff: 8BEGIN 8FrameLRect(r); 8END; 4OTHERWISE 8PaintLRect(r); 4END; 0END; ,END (ELSE ,SELF.coSelection.Highlight(highTransit); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TChapSelection.KeyReturn; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} ({We don't want to allow multiple paragraphs when someone is editing the name, so we )override KeyReturn to do nothing} ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TChapSelection.NewCommand(cmdNumber: TCmdNumber): TCommand; $VAR heap: THeap; (inputString: S255; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (heap := SELF.heap; (NewCommand := NIL; (CASE cmdNumber OF ,{Adding a recipe is NOT undoable. We do not create a command here, although AddRecipe -indirectly Commits the last command via TRecipeView.ChangeRecipe. The user can simply -delete the recipe if she didn't really want it} ,uAddRecipe: 0BEGIN 0TMyWindow(SELF.window).inputFrame.GetContents(inputString); 0IF inputString <> '' THEN 4SELF.AddRecipe(inputString); 0TMyWindow(SELF.window).recipePanel.selection.MarkChanged; 0END; ,OTHERWISE 0NewCommand := SUPERSELF.NewCommand(cmdNumber); ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TNameSelection; $FUNCTION TNameSelection.CREATE(object: TObject; heap: THeap; itsView: TView; XitsAnchorLPt: LPoint): TNameSelection; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TNameSelection(TTextCoverSelection.CREATE(object, heap, itsView, itsAnchorLPt)); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TNameSelection.KeyReturn; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} ({We don't want to allow multiple paragraphs when someone is editing the name, so we )override KeyReturn to do nothing} ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TIngredSelection; $FUNCTION TIngredSelection.CREATE(object: TObject; heap: THeap; itsView: TView; XitsAnchorLPt: LPoint; itsIngredients: TList; Xindex: INTEGER): TIngredSelection; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TIngredSelection(TTextCoverSelection.CREATE(object, heap, itsView, itsAnchorLPt)); (WITH SELF DO ,BEGIN ,ingredients := itsIngredients; ,ingredIndex := index; ,END; ({$IFC fTrace}EP;{$ENDC} $END; #{$IFC fDebugMethods} $PROCEDURE TIngredSelection.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('ingredients: TList'); (Field('ingredIndex: INTEGER'); (Field(''); $END; ${$ENDC} $FUNCTION TIngredSelection.CanDoCommand(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (CASE cmdNumber OF ,uAddIngred, uInsIngred: 0BEGIN 0CanDoCommand := TRUE; 0END; ,uDeleteIngred: 0BEGIN 0CanDoCommand := SELF.ingredients.size > 1; 0END; ,OTHERWISE 0CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TIngredSelection.KeyReturn; $VAR recipeImage: TRecipeImage; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (recipeImage := TRecipeView(SELF.view).recipeImage; (SELF.coSelection.KeyPause; (IF SELF.ingredIndex = recipeImage.ingredients.size THEN ,SELF.window.PerformCommand(TAddIngredCmd.CREATE(NIL, SELF.Heap, SELF.view, uAddIngredient, \SELF.ingredients, SELF.ingredIndex + 1)) (ELSE ,SELF.view.MousePress(TTextImage(SELF.ingredients.At(SELF.ingredIndex+1)).extentLRect.topLeft); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TIngredSelection.KeyTab(fBackward: BOOLEAN); $VAR textRange: TTextRange; (textImage: TTextImage; (str: S255; (selection: TSelection; (i: INTEGER; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (textRange := TTextSelection(SELF.coSelection).textRange; (textImage := TTextSelection(SELF.coSelection).textImage; (IF textRange.firstLP < tabColumn THEN ,BEGIN ,IF tabColumn > textRange.firstPara.size THEN 0BEGIN 0str := ''; 0FOR i := 1 TO tabColumn - textRange.firstPara.size DO 4str := Concat(str, ' '); 0textRange.firstPara.ReplPStr(textRange.firstPara.size, 0, @str); 0TParaImage(textImage.imageList.First).InvalLinesWith(0, MAXINT); 0textImage.text.RecomputeImages; 0END; ,SELF.coSelection.panel.Highlight(SELF.coSelection, hOnToOff); ,selection := SELF.coSelection.FreedAndReplacedBy(TInsertionPoint.CREATE(NIL, SELF.Heap, @SELF.view, textImage, zeroLPt, textRange.firstPara, 1, tabColumn)); ,selection.panel.Highlight(selection, hOffToOn); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TIngredSelection.NewCommand(cmdNumber: TCmdNumber): TCommand; $VAR heap: THeap; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (heap := SELF.heap; (CASE cmdNumber OF ,uAddIngred, uInsIngred: 0BEGIN 0NewCommand := TAddIngredCmd.CREATE(NIL, heap, SELF.view, cmdNumber, SELF.ingredients, LSELF.ingredIndex + (uInsIngred - cmdNumber)); 0END; ,uDeleteIngred: 0NewCommand := TDelIngredCmd.CREATE(NIL, heap, SELF.view, YSELF, SELF.ingredients, SELF.ingredIndex); ,OTHERWISE 0NewCommand := SUPERSELF.NewCommand(cmdNumber); ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TDirecSelection; $FUNCTION TDirecSelection.CREATE(object: TObject; heap: THeap; itsView: TView; XitsAnchorLPt: LPoint): TDirecSelection; $BEGIN ({$IFC fTrace}BP(9);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TDirecSelection(TTextCoverSelection.CREATE(object, heap, itsView, itsAnchorLPt)); ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TDirecSelection.CanDoCommand(cmdNumber: TCmdNumber; VAR checkIt: BOOLEAN): BOOLEAN; (VAR dummy: BOOLEAN; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (CASE cmdNumber OF ,u18Point, u24Point: 0BEGIN 0CanDoCommand := FALSE; {don't allow these sizes} 0END; ({for the command numbers ,uModern, uClassic, u20Pitch, u15Pitch, u12Pitch, u10Pitch, ,u12Point, u14Point, ,uPlain, uBold, uItalic, uUnderline, uShadow, uOutline )we can just call SELF.coSelection.CanDoCommand because we know that we have a coSelection that )is a TTextSelection. TTextSelections always enable typestyle commands and (at no extra )charge) check off the appropriate menu items.} ,uModern, uClassic, u20Pitch, u15Pitch, u12Pitch, u10Pitch, ,u12Point, u14Point, ,uPlain, uBold, uItalic, uUnderline, uShadow, uOutline: 0CanDoCommand := SELF.coSelection.CanDoCommand(cmdNumber, checkIt); ,uPaste: {allow pasting into the directions} 0BEGIN 0CanDoCommand := TRUE; 0END; ,OTHERWISE 0CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TChapTextImage; $FUNCTION TChapTextImage.CREATE(object: TObject; heap: THeap; itsView: TView; DitsLRect: LRect; itsText: TText; isGrowable: BOOLEAN): TChapTextImage; $VAR imgList: TList; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TChapTextImage(TTextImage.CREATE(object, heap, itsView, itsLRect, itsText, isGrowable)); (SELF.refCount := 1; ({$IFC fTrace}EP;{$ENDC} $END; #{$IFC fDebugMethods} $PROCEDURE TChapTextImage.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('refCount: INTEGER'); (Field(''); $END; ${$ENDC} $PROCEDURE TChapTextImage.ChangeRefCountBy(delta: INTEGER); $VAR editPara: TEditPara; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (SELF.refCount := SELF.refCount + delta; (IF SELF.refCount <= 0 THEN ,BEGIN ,TChapterView(SELF.view).editImage := NIL; ,editPara := TEditPara(SELF.text.paragraphs.First); ,editPara.images.DelObject(SELF.imageList.First, FALSE); ,SELF.text.txtImgList.DelObject(SELF, TRUE); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TChapTextImage.FilterAndDo(actualObj: TObject; PROCEDURE DoToObject(filteredObj: TObject)); $VAR saveStyles: TArray; (saveDflt: TTypeStyle; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} ({This procedure does our own bit of filtering on the paragraph. We're getting a little fancy )in that when the recipe name is being edited we want the editing to be reflected in both panels )at the same time. However, we want the names in the two panels to appear in a different type )style. Since all access to the paragraph's typeStyles goes through FilterAndDo, we override )it to stuff in our version of the paragraph's character runs array. Notice that we can only )do this because we don't allow typeStyle changes on the recipe title. If we did, this would )cause strange ambiguities with conflicting filters. (I don't even want to think about it!)} (saveStyles := TParaImage(actualObject).paragraph.typeStyles; (saveDflt := TParaImage(actualObject).paragraph.format.dfltTStyle; (TParaImage(actualObject).paragraph.typeStyles := chapStyles; (TParaImage(actualObject).paragraph.format.dfltTStyle := chapDfltStyle; (SUPERSELF.FilterAndDo(actualObject, DoToObject); (TParaImage(actualObject).paragraph.typeStyles := saveStyles; (TParaImage(actualObject).paragraph.format.dfltTStyle := saveDflt; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TChapTextImage.NewParaImage(itsParagraph: TEditPara; itsLRect: LRect; DlineTop: LONGINT; lineLeft: LONGINT): TParaImage; $VAR paraImage: TParaImage; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (paraImage := TChapParaImage.CREATE(NIL, SELF.Heap, SELF.view, itsParagraph, itsLRect, lineTop, lineLeft); (paraImage.textImage := SELF; (itsParagraph.InsImage(paraImage); (NewParaImage := paraImage; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TChapParaImage; $FUNCTION TChapParaImage.CREATE(object: TObject; heap: THeap; itsView: TView; itsParagraph: TEditPara; ?itsLRect: LRect; lineTop: LONGINT; lineLeft: LONGINT): TChapParaImage; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TChapParaImage(TParaImage.CREATE(object, heap, itsView, itsParagraph, itsLRect, XlineTop, lineLeft)); ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TChapParaImage.FilterAndDo{(actualObj: TObject; PROCEDURE DoToObject(filteredObj: TObject))}; $VAR saveStyles: TArray; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} ({See the comments for TChapTextImage.FilterAndDo} (SELF.textImage.FilterAndDo(actualObj, DoToObject); ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TAddIngredCmd; $FUNCTION TAddIngredCmd.CREATE(object: TObject; heap: THeap; itsImage: TImage; cmdNumber: TCmdNumber; SitsIngredients: TList; itsIndex: INTEGER): TAddIngredCmd; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TAddIngredCmd(TCommand.CREATE(object, heap, cmdNumber, itsImage, FALSE, revealAll)); (WITH SELF DO ,BEGIN ,ingredients := itsIngredients; ,ingredIndex := itsIndex; ,unHiliteBefore[doPhase] := FALSE; ,unHiliteBefore[redoPhase] := FALSE; ,END; ({$IFC fTrace}EP;{$ENDC} $END; {$IFC fDebugMethods} $PROCEDURE TAddIngredCmd.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('ingredients: TList'); (Field('ingredIndex: INTEGER'); (Field(''); $END; {$ENDC} $PROCEDURE TAddIngredCmd.Perform(cmdPhase: TCmdPhase); $VAR textImage: TTextImage; (text: TText; (imageLRect: LRect; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (CASE cmdPhase OF ,doPhase, redoPhase: 0BEGIN 0text := TText.CREATE(NIL, SELF.Heap, TMyWindow(TView(SELF.image).panel.window).styleSheet); 0imageLRect := TTextImage(SELF.ingredients.At( LMin(SELF.ingredIndex, SELF.ingredients.size))).extentLRect; 0IF SELF.ingredIndex > SELF.ingredients.size THEN 4OffSetLRect(imageLRect, 0, ingredHeight); 0textImage := text.DfltTextImage(TView(SELF.image), imageLRect, FALSE); 0SELF.ingredients.InsAt(SELF.ingredIndex, textImage); 0TRecipeView(SELF.image).ScrollStuff(SELF.ingredIndex, TRUE); 0TRecipeView(SELF.image).MousePress(textImage.extentLRect.topLeft); 0END; ,undoPhase: 0BEGIN 0END; ,END; (TView(SELF.image).panel.selection.MarkChanged; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TDelIngredCmd; $FUNCTION TDelIngredCmd.CREATE(object: TObject; heap: THeap; itsImage: TImage; PitsSelection: TIngredSelection; PitsIngredients: TList; itsIndex: INTEGER): TDelIngredCmd; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TDelIngredCmd(TCommand.CREATE(object, heap, uDeleteIngred, itsImage, TRUE, revealAll)); (WITH SELF DO ,BEGIN ,ingredients := itsIngredients; ,ingredIndex := itsIndex; ,ingredSelection := itsSelection; ,unHiliteBefore[undoPhase] := FALSE; ,END; ({$IFC fTrace}EP;{$ENDC} $END; {$IFC fDebugMethods} $PROCEDURE TDelIngredCmd.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('ingredients: TList'); (Field('ingredIndex: INTEGER'); (Field('ingredSelection: TIngredSelection'); (Field('saveTextImage: TTextImage'); (Field(''); $END; {$ENDC} $PROCEDURE TDelIngredCmd.Commit; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (IF SELF.saveTextImage <> NIL THEN ,SELF.saveTextImage.text.Free; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TDelIngredCmd.Perform(cmdPhase: TCmdPhase); $VAR textImage: TTextImage; (mouseLPt: LPoint; (newIndex: LONGINT; (selection: TSelection; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (CASE cmdPhase OF ,doPhase, redoPhase: 0BEGIN 0textImage := TTextImage(SELF.ingredients.At(SELF.ingredIndex)); 0SELF.saveTextImage := textImage; 0SELF.ingredients.DelAt(SELF.ingredIndex, FALSE); 0newIndex := Min(SELF.ingredIndex, SELF.ingredients.size); 0textImage := TTextImage(SELF.ingredients.At(newIndex)); 0selection := SELF.ingredSelection.coSelection.FreedAndReplacedBy( DTInsertionPoint.CREATE( LNIL, SELF.Heap, TView(SELF.image), textImage, LzeroLPt, TEditPara(textImage.text.paragraphs.First), 1, 0)); 0TRecipeView(SELF.image).ScrollStuff(SELF.ingredIndex, FALSE); 0END; ,undoPhase: 0BEGIN 0SELF.ingredients.InsAt(SELF.ingredIndex, SELF.saveTextImage); 0TRecipeView(SELF.image).ScrollStuff(SELF.ingredIndex, TRUE); 0TRecipeView(SELF.image).MousePress(SELF.saveTextImage.extentLRect.topLeft); 0END; ,END; (TView(SELF.image).panel.selection.MarkChanged; ({$IFC fTrace}EP;{$ENDC} $END; END; {An exercise for the reader is to make this undoable; then, of course you would not need to confirm $the command with the user in TMyWindow.NewCommand.} METHODS OF TDelRecipeCmd; $FUNCTION TDelRecipeCmd.CREATE(object: TObject; heap: THeap; itsImage: TImage; hitsIndex: INTEGER): TDelRecipeCmd; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TDelRecipeCmd(TCommand.CREATE(object, heap, uDeleteRecipe, itsImage, FALSE, revealAll)); (WITH SELF DO ,BEGIN ,recipeIndex := itsIndex; ,END; ({$IFC fTrace}EP;{$ENDC} $END; {$IFC fDebugMethods} $PROCEDURE TDelRecipeCmd.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('recipeIndex: INTEGER'); (Field(''); $END; {$ENDC} $PROCEDURE TDelRecipeCmd.Commit; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TDelRecipeCmd.Perform(cmdPhase: TCmdPhase); $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (CASE cmdPhase OF ,doPhase: 0BEGIN 0END; ,redoPhase: 0BEGIN 0END; ,undoPhase: 0BEGIN 0END; ,END; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TCopyRecipeCmd; $FUNCTION TCopyRecipeCmd.CREATE(object: TObject; heap: THeap; HitsImage: TImage; itsIndex: INTEGER): TCopyRecipeCmd; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TCopyRecipeCmd( 8TCutCopyCommand.CREATE(object, heap, uCopyRecipe, itsImage, FALSE)); (WITH SELF DO ,BEGIN ,recipeIndex := itsIndex; ,END; ({$IFC fTrace}EP;{$ENDC} $END; {$IFC fDebugMethods} $PROCEDURE TCopyRecipeCmd.Fields(PROCEDURE Field(nameAndType: S255)); $BEGIN (SUPERSELF.Fields(Field); (Field('recipeIndex: INTEGER'); (Field(''); $END; {$ENDC} $PROCEDURE TCopyRecipeCmd.DoCutCopy(clipSelection: TSelection; deleteOriginal: BOOLEAN; IcmdPhase: TCmdPhase); $VAR clipHeap: THeap; (clipPanel: TPanel; (clipView: TRecipeClipView; (viewLRect: LRect; (clipRecipe: TRecipe; (selection: TSelection; (recipeImage: TRecipeImage; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (CASE cmdPhase OF ,doPhase, redoPhase: 0BEGIN 0clipHeap := clipSelection.heap; 0clipPanel := clipSelection.panel; 0recipeImage := TRecipeView(TMyWindow(TView( HSELF.image).panel.window).recipePanel.view).recipeImage; 0IF recipeImage.changed THEN 4clipRecipe := recipeImage.DismantleImage 0ELSE 4clipRecipe := TRecipe(TChapterView(SELF.image).recipes.At(SELF.recipeIndex)); 0clipRecipe := TRecipe(clipRecipe.Clone(clipHeap)); 0SetLRect(viewLRect, 0, 0, 500, 100); 0clipView := TRecipeClipView.CREATE(NIL, clipHeap, clipPanel, viewLRect, \TChapterView(SELF.image).foodType, clipRecipe); 0selection := clipSelection.FreedAndReplacedBy(TClipSelection.CREATE(NIL, clipHeap, clipView)); 0END; ,undoPhase: 0BEGIN 0END; ,END; (TView(SELF.image).panel.selection.MarkChanged; ({$IFC fTrace}EP;{$ENDC} $END; END; METHODS OF TPasteRecipeCmd; $FUNCTION TPasteRecipeCmd.CREATE(object: TObject; heap: THeap; itsImage: TImage): TPasteRecipeCmd; $BEGIN ({$IFC fTrace}BP(11);{$ENDC} (IF object = NIL THEN ,object := NewObject(heap, THISCLASS); (SELF := TPasteRecipeCmd(TPasteCommand.CREATE(object, heap, uPasteRecipe, itsImage)); (SELF.undoable := FALSE; ({$IFC fTrace}EP;{$ENDC} $END; $PROCEDURE TPasteRecipeCmd.DoPaste(clipSelection: TSelection; Ppic: PicHandle; cmdPhase: TCmdPhase); $VAR clipView: TRecipeClipView; (recipe: TRecipe; (pasteRecipe: TRecipe; (myWindow: TMyWindow; (recipeView: TRecipeView; (chapView: TChapterView; (recipes: TList; (s: TListScanner; (inserted: BOOLEAN; (recipeName: S255; (str: S255; (recipeImage: TRecipeImage; (bookSel: TBookSelection; $BEGIN ({$IFC fTrace}BP(10);{$ENDC} (CASE cmdPhase OF ,doPhase, redoPhase: 0BEGIN 0IF InClass(clipSelection.view, TRecipeClipView) THEN 4BEGIN 4clipView := TRecipeClipView(clipSelection.view); 4pasteRecipe := TRecipe(clipView.recipe.Clone(SELF.Heap)); 4myWindow := TMyWindow(TView(SELF.image).panel.window); 4myWindow.okayToHilite := TRUE; 4recipeView := TRecipeView(myWindow.recipePanel.view); 4chapView := TChapterView(myWindow.chapterPanel.view); 4recipes := TCookBookView(myWindow.cookBookPanel.view).headings[clipView.foodType]; 4pasteRecipe.name.ToPStr(@recipeName); 4s := recipes.Scanner; 4inserted := FALSE; 4WHILE s.Scan(recipe) DO 8BEGIN 8recipe.name.ToPStr(@str); 8IF recipeName < str THEN  noFood; ,uDeleteRecipe: 0WITH SELF.chapterPanel DO 8{We are always assured of having a TChapSelection in the chapterPanel,  NIL) AND D(TChapSelection(selection).recipeIndex <> 0); {$IFC debugMe} ,cmdRefresh: 0CanDoCommand := TRUE; ,uDrawRects: 0BEGIN 0CanDoCommand := TRUE; 0checkIt := fDrawRects; 0END; ,uTraceRecipe: 0BEGIN 0CanDoCommand := TRUE; 0checkIt := fRecipeTrace; 0END; {$ENDC} ,uCopyRecipe: 0BEGIN 0CanDoCommand := TRecipeView(SELF.recipePanel.view).recipeImage <> NIL; 0END; ,uPasteRecipe: 0BEGIN 0clipboard.Inspect; 0CanDoCommand := clipBoard.hasView; 0END; ,uOneColumn: 0BEGIN 0CanDoCommand := FALSE; {recipe panel has contents} {*} 0checkIt := FALSE; {currentlyOneColumn} 0END; ,uTwoColumn: 0BEGIN 0CanDoCommand := FALSE; {recipe panel has contents} 0checkIt := FALSE; {currentlyTwoColumn} {*} 0END; ,OTHERWISE 0CanDoCommand := SUPERSELF.CanDoCommand(cmdNumber, checkIt); ,END; ({$IFC fTrace}EP;{$ENDC} $END; $FUNCTION TMyWindow.NewCommand(cmdNumber: TCmdNumber): TCommand; $VAR selection: TSelection; (chapView: TChapterView; (chapSel: TChapSelection; (recipe: TRecipe; (oldRecipe: TRecipe; (s: S255; (newIndex: INTEGER; (PROCEDURE InvalAll(obj: TObject); (BEGIN ,TPanel(obj).Invalidate; (END; $BEGIN ({$IFC fTrace}BP(12);{$ENDC} (NewCommand := NIL; (CASE cmdNumber OF ,uRecipeDialog: 0IF SELF.dialogBox = NIL THEN 4BEGIN 4SELF.chapterPanel.BeginSelection; 4SELF.PutUpDialogBox(SELF.dialogWindow); 4SELF.inputFrame.SupplantContents(''); 4SELF.dialog.SelectInputFrame(SELF.inputFrame); 4END; ,uCopyRecipe: 0BEGIN 0NewCommand := TCopyRecipeCmd.CREATE(NIL, SELF.Heap, SELF.chapterPanel.view, TTChapSelection(SELF.chapterPanel.selection).recipeIndex); 0END; ,uPasteRecipe: 0BEGIN 0NewCommand := TPasteRecipeCmd.CREATE(NIL, SELF.Heap, SELF.cookBookPanel.view); 0END; ,uDeleteRecipe: 0BEGIN 0WITH SELF.chapterPanel DO 4BEGIN 4chapView := TChapterView(view); 4chapSel := TChapSelection(selection); 4END; 0oldRecipe := TRecipe(chapView.recipes.At(chapSel.recipeIndex)); 0oldRecipe.name.ToPStr(@s); 0process.ArgAlert(1, s); 0IF process.Caution(phReallyDelRecipe) THEN 8{Delete Recipe is not undoable (an exercise for the reader would be to  0 THEN 8recipe := TRecipe(chapView.recipes.At(newIndex)) 4ELSE 8recipe := NIL; 4TRecipeView(SELF.recipePanel.view).ChangeRecipe(recipe); 4oldRecipe.Free; 4chapSel.recipeIndex := newIndex; 4chapSel.MarkChanged; 4NewCommand := TCommand.CREATE(NIL, SELF.Heap, uDeleteRecipe, LchapView, FALSE, revealNone); 4SELF.cookbookPanel.Highlight(SELF.cookbookPanel.selection, hOffToOn); 4SELF.Update(TRUE); 8{do the updating & highlighting of the chapter panel here because of the 1 document; we don't change the opening rectangle y y n Checkerboard II $ 3. "6F^9D!$ǐ^7p̕RL.9START.TE*Ӱ-#1#1-Samples-xclock.textXT̡̡$UCLOCK2.TEXTxxŁR UCLOCK2.TEXTK2.TEXTTEXTN^̕RŁR"N.8~.81-CIXT̡XT̡\ :#ST'T.XT xclock.textck.textk.textTEXTtON -#1#1-SamplesjFFxpJ$̣" ̣"START.TEXT /204 SLOT2CHAN1 ;no assembler files $ utimer $ $ n y 7 313 227 364 Clock $ 3. "6F^9. D!$ǐ^sHommand;} rID: TWindowID): TKeyWindow; ; cManager; LRect; (panel: TPanel; (keyView: TKeyView; (keySelection: TKeySelection; (aWhiteKey: TBox; $BEGIN ({$'{PROCEDURE TKeySelection. KeyChar(ch: CHAR);} (END; $TKeyWindow = SUBCLASS OF TWindow &{Variables} (initialVolume: SpeakerVolume; { volume outside of application } (appVolume: SpeakerVolume; { volume inside applicati;The next 2 lines specify the default tool number and tool volume 203 ;no assembler files $ ;no building blocks $ ;nothing else to link in $ ;install parameters: does not use documents; don't change open rectangle ; (the program adjusts the window size itself) n n Keyboard $ 3. "6F^9deD!$ǐ^eHdon't change the opening rectangle ;The next 2 lines specify the default tool number and tool volume 202 ;no assembler files $ ;we use the uiconref building block uiconref $ ;we also use StdUnit, which is in SULIB -#boot-sulib $ ;install parameters: we handle documents; we handle >1 document; we don't change the opening rectangle y y n Reader $ (END; IMPLEMENTATION {$I USamDialog2.TEXT} END. $$$$$$$$$$ $ $ $ $ $$$$$$$$$$$$$ O  )*(+)*-.,/-.'6'75'86'7?NOMPNORSQTRSVWUXVWZ[Y\Z][^\] ` a_ b` a d ec fd ge hf ig jh ki lj mk nl om pn qo rp sq tr us vt wu xv yw zx y | }{ ~| } ~                             ! " # $ % & ' ( ) * + , - . / 0 1 2 3 4 5 6 7 8 9 : ; < = > ? @ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ \ ] ^ _ ` a b c d e f g h i j k l m                  l  m O       !" !$%#&$'%(&)'*(+),* -+ ., /- 0. 1/2031425364758697:8;9<:=;><?=@>A?B@CA DB!EC"FD#GE$HF%IG&JH'KI(LJ)MK*NL+OM,PN-QO.RP/SQ0TR1US2VT3WU4XV5YW6ZX7[Y8\Z9[^_]`^_bcadbcfgehfgjkiljmknlompnorsqtrusvtwuxvywzx {y |z }{ ~| }~ !"#$%&'()*+                      !!!!!!!!!! ! ! ! ! !!!!!! ! !  !  !  ! ! !!!!!!! !!!"!#!$!%!&!'!(!)!* !+!!," !-#!!.$"!/%#!0&$!1'%!2(&!3)'!4*(!5+)!6,*!7-+!8.,!9-"0"1/"20"31"42"3#6#75#86#7$:$;9$<:$=;$><$?=$@>$?%B%CA%DB%EC%FD%GE%HF%IG%JH% KI% LJ% MK% NL% OM%PN%O%&R&SQ&TR&S'V'WU'XV'WZX[Y\Z ][!\ _ `^ a_ b` ca db ec fd ge hf ig jh ki lj mk nl om pn qo rp sq tr us vt wu xv yw zx {y |z }{ ~| } !~ " # $ % & ' ( ) * + , - . / 0 1 2 3 4 5 6 7 8 9 : ; < = > ? @ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ \ ] ^ _ ` a b c d e f g h i j k l m n o p q r s t u v w x y z { | } ~               !!!!!!####$$$$%%%%&&&&$