-not a Macintosh disk-3@F$h @ 3` # @@%Ǟb:NF,  8!"@$|Gn"`I N.@A,H<( F<B<H111Bx<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 _!@"|xEx En"`CE"|xN"Ҹ< A  33"|@E E4n"`C&E"|@.N _LHNFLN*8&E@CJJKK f`  f `><$CS*<F|4>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 o0<BAN o0 _PON _"_$|0<J"PJQN _"_$|0<"PJQNHL$ 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 NV;n N^.NuEVINIT NVH,. ^J]g n0`4B?N. f n0`/.//. /.N(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?-Nh.H|)?NpN^ _TONRAP NV.HgVS@g`J.f& -XмS//<N(/<N+_X-mX . ѭX -Xo<Np`B . TJ.f/-T/<N/<N+_T-mT -Tl<N,N^ _PONGETSPACNV .мS//<N/<NJ-_ .=@ N^.NuINDSPARNVH.. Bg/N0Hހ m0.@I/./<N( 8//<N @n ?.Bg?<BgN(LN^ _ NETMMU NV0. S@g S@gS@g`=|`=|` =|`BnN^ _\ONONV_DEVNVH nCJp"S@n2BgHnNE g BgNN=_   nV@g8B. Bmh|` @BvRF Fo mXf=|;|@`Bm@`|BgN;_hBgN> Ggd G] G^g$ GdfBgN;_@BgN>`<ND`.BgN8JD] D^g<N$ @=BgN>`|`.H@ABpR. .oBg?./N;_"Bg?./Nz;_,Bg?./Nj;_.Bg?./NZ;_0-| nBPLN^.NuEAD_CONNVH nCJp"S@n~`LH6p@J@^H6pA A_gH6p@H"AA1`H @ABpR o;nh0.H@;@@A r<Ё(@&|H@6LN^.NuROCESS_NVLH nCJp"S@n2BgHnNAx/NAx/HndNJndV nxVgB-e`|e  gHnxNA&HA(AL,*<Hnf?-Z E0-NPH///NJnfg<N(A(H/ HndN.JndV TVg B-fmeg`l-eg*0.zlW"-BWD@f-f @g` B-g -Bf|f/ N`B-f  -e -fg/ NLN^.NuNIT_CONNVH+| \+|l+|(|+|t+|+|l+|(|;TN(|;TZ(|;TX&| n!SLN^.NuETVARS NVH/Nt;| ./+@ .м/м+@+|X*<(< E"D +@T&|?-Z0-NS?NHnHmBNJngp+@BAC6 0HnNBBg/-BgN+_ -Э+@PBB<0<H/BgNZN<+_H+mHBG` m @I G~V GTVgd Gl|p@ @8`$ Gf|p@BT`| p@BT H< @"@=A?.??<BgNJRG Gox mI|p@BT mIP|p@/-H/<N 8LN^NuOOTINIT system.configNVH(nB BgN@BgN8HH,BgNp0HѬ f,/, NBgNBgNHH,BgN>0HѬ f,/, NZBgNBgNHH,BgN 0HѬ f:J`f< N/, NBgNBgNHH,BgN0HѬ g<NHBN,BN+_ n/BN  _r Ё0p//-XN /-/-XN&mX:=E E0o<N0<H+@d+| -dЭ\ n2HҀ -Ё"-Ҁ(Bg Э/N0Hѭ -Є+@B</-BgN+_+m` -\Э`+@h -dЭh, n0HІ+@ -Э+@ -Э+@?<f/-/-?<N^-m/ /./-N n LN^ _ NUILD_SYNVH(nBGBF. gB `P-n n0. PoB."` n0. A-H&n/+/<N&  n0>+<+/, N$BgNBgNHH-@BgN0H(٬ JVJ_gB."`4JGW WJGV WgJFf n `H n n/B."n/BgN.  _ BN-_JGf n Q/ n P/N` Q@H/ n P/N|B. n=h-nA-H n-P/./.p/NJGgR-m`Bg n/( n r Ё/ n P/ nP/ | ? Q@?N9_Jlg< N( nQ f|"LN^ _NOADSEG NV/ BBg/-lBgN+_p -p"-Ҁ+Al(|`p}//<N -Пp((|p}//<N -Пp(?<}/-p/-l?<N(_N^.NuLLOC_SCNVHAC 0BgHnN __m_^+m-^gBBg/-BgNX+_`+m-_gBBg/<BgN4 м,BgBgBHnBgHnHnBg/.N g<NACD 0BgHnN p g B-n`.BgBgBHnBgHnHnBg/.N g<Nn .@+@n -Эn+@j` B -@+@n -м@+@j?</-n/-j?<NH <逐n.JfB` .ЇP-@JfB` .ЇP-@-_g -Ї/ -Ї//./.N\`/-/-BBNJ(|p((|t(LN^.NuOAD_DEB SYSTEM.DEBUG2 SYSTEM.DEBUGNVH nCJp"S@n2&n (nBBgHnN gZB /, N BgN FBgN >HH(BgN v0H* f&.B</BgN&B /, N ~//N LN^ _ NOAD_UNPNVBgBgBHn</. /.Bg/.N g<NN^ _ NOAD_LLDNVH(n 0-F|>Jg,, .* Ю(H//<N ( Д-@`,.(.H//<N p-_?//?<N6 .P/N LN^ _NNSTALL_NVH(n=n ~`/, N dBgN _BgN HH(BgN 0H-@Jg .Ѭ `<N .fBN 4(BN ,( GfAqB0pB5pB`ACZ 0z`BgN f_ .ARE EoHn?<?<HnN AC 0HnHzNdg(AqB0pp @A^B @AB`2HnHzN,gAqB0pB5pB`Aqpp| 5pgnBg?/.Hn @AHp @A^Hp</.Nd g<NN?. @A^/0 @A"0Ҽ/?<NPRGinoLLN^ _ NOADCODEkrni NVBBg/-BgN +_?<e/-/-?<NN^.NuAKESUPSNVH(m . R A T&@-kLN^ _ NINDMAINNVBg/-|NN0Hѭ|B</-|BgN+_?<g/-/-|?<NdBg/-tN0HѭtB</-tBgNF+_x?<{/-x/-t?<N*N^.NuREATEOPNV/Jmho@ mFhomFh0-hH.//<N .0<AHЭX"-ToT.N^.NuONFIG_DNV A0C ArC 0AC 0/NHnHm`/NBgHn0N g< N0HnHn/NfBgHnrN g<N/NBg/.Hn$/N;_F/./.Hm`/Nh-MgN/.$?-F/N/N n /B/.$0-FH//N  _ /N&/NN^ _PONOADSYS $ SYSTEM.UNPACK SYSTEM.OS SYSTEM.LLDN NV,_NUTN z+|T mT PVD@MN0HmHmNHm?- -tЭx//-NNިNRN]N (NuN^NuOADER NVHAT(HA<&HHn?-0-H".Ҁ// / N Jng<NLN^.NuEAD_PAGNV0.H H"-"Ҁ-A0.H H@J@=@/.NvAT0.HЈ-@ N^ _TONIND_SENNVH n-h .S/0-H/N ;@8-n p+@4;m:BF` ATIBBlRF Fo=mA-HA<-HBE n0-HА(BnJf<NHn?-0-HЄ//./.NJng<NxBGA0.HЈ&@Bn=knnZ Eo<NJ ATI ( 9s Jlf<N0,n0.ްm8o`RERG`(-L`HLN^.NuPEN_FILNVH(n| @=@~`84p@k|nAP2IDA0 <f 4pAFRGinoLN^.NuHIFTNAMNVH(n @:JEnBn`pp4A4P@R@H. Eo U@<`BFJFo$ R@4A T@4BRBHށSF`Jl D./0.H/N =@LN^ _\ONDHASH NV~H n CJp"S@n2BA&/Nb 8<-HnNBgHn?-N>H/p6/NNBp6/A/NdACp S@n0HnN^J.gHHnHnN .Wgz n/B?.N~  _ `SFRGmfBGBNJFfELN^ _PONOOKUP_ENVH;n ;m?.?-N;nBNAT(HJg<N;l~+l";l ;l;l;lB?,N&_+S&+k*+k.LN^.NuNITMEDINVBg/.HnNr_n .gB/.N-_N^.NuPENINPUNVH(.BGBF Go<N AT:0JEf<N EHl@ ATH"Ұ n n Jf<NHH " n ``RGE`LN^ _ NIND_POSNV-m4/.0-H/N+_4J4]2-8H4]g<N&0-H/-4/Nl .;@: -4g/-4HnHnN/.NN^.NuILLBUF NV0-:mf -4R2-H//NNT0-:ATpRm:N^NuETBYTE NVHBgNHH<BgNH>JGl H м> G=@LN^NuETWORD NVHBgN0H//<N~,BgN0H.Jl޼ Ї-@LN^NuETLONG NVH,. 0-m:>HǼl>JGo0-:ATA//.H/N$H߮Hǜm:0-HnJ4]2-8H4]g<N -4R/HnHnNn-nA<(H/0-H/N*l-EJoZHn?-0-H".Ҁ/?././ NJng<N0-H/./NV(ٮ .Ѯ .ѭ4`:Jo -4R2-H//N"NhJfLN^ _PONOVEMULT//0/2/ AH@B@2/Ё/@" /WXNu// /"/ N2/A" /WXNu// /"/ N/@" /WXNuH>*jD,jD$&BBx㉰mRSDlJjDjDL|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`QNuHr`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\NuNuNuJoNu j [MacSupplement 3&;f/Nt0. @ g0@#g2S@g6U@g:_@ [ F9H*`$-kT,k [ &$DeLHpt8,6<T( h!l," # $%H&'B(F) *+,-./ 0 1234X56789CFN rootcatalogːp8@ G_#, [  Example/Grow.TexthTexthExample/SoundLabR.TextbR.TextPONexample/showpaint.textint.texSerial/Execute.Texte.Text!Serial/TaskDefs.Textfs.Text(EXAMPLE/QDSAMPLER.TEXTLER.TEXSerial/SerDefs.Texts.Text%Example/FileR.Texth.TextExample/EditR.Texth.Texth example/scrollr.textlr.textexample/MODALR.TEXTR.TEXTexample/picscrapr.textapr.texExample/GrowR.Texth.TexthSerial/TaskImpl.Textpl.Text)example/showpaintR.textntR.teserial/Tasks.texthtexth*example/picscrap.TEXTrap.TEXTSerial/Async.TexthTexth Example/BoxesR.TextR.Textexample/ADESKACCR.TEXTCCR.TEXExample/Boxes.Texth.Texthserial/Ascii.texthtexthEXAMPLE/QDSAMPLEL.OBJSA&,Serial/PipeDefs.Textfs.Text"Serial/PipeImpl.Textpl.Text#Example/FileAsm.Textsm.Texts memory by &Serial/TaskAsm.Textm.Text'example/SCROLL.TEXTL.TEXTEXAMPLE/MODAL.TEXTh.TEXThExample/BoxesX.TextX.Text Serial/SerImpl.Textl.Text&WorkShop.TempXTLAB.TEXT&EXAMPLE/QDSAMPLE.OBJaDEXAMPLE/EXEC.TEXT˰EXAMPLE/SOUNDLAB.TEXT˰ serial/TermUtil.textil.text+Example/ADeskAcc.TextAcc.TextEXAMPLE/QDSAMPLE.TEXTPLE.TEXTExample/Edit.TexthTexth Example/File.TexthText serial/Pipes.texthtexth$Example/ADeskAcc.TextAcc.TextΝ k [&F0F $ L$example/ADESKACCR.TEXTCCR.TEXΝ l [&F06F pExample/Boxes.Texth.TexthΝ m [&'  tExample/BoxesR.TextR.TextΝ n [& u'ߝ x Example/BoxesX.TextX.TextΝ o [&. Example/Edit.TexthTexthΝ p [&999"  Example/EditR.Texth.TexthΝ q [&8/8 EXAMPLE/SOUNDLAB.TEXT˰ZV( [ovVl~eag Example/File.TexthTextΝ) [&^> Example/FileAsm.Textsm.TextΝ* [&lҝV @l , Example/FileR.Texth.TextΝ+ [&۔7ۗ 6 example/SCROLL.TEXTL.TEXTΝ, [&ܝ6  Example/Grow.TexthTexthΝ w [& 9  TExample/GrowR.Texth.TexthΝ x [&?91s?< hEXAMPLE/MODAL.TEXTh.TEXThΝ y [& 'ŝ   lexample/MODALR.TEXTR.TEXTΝ z [&в0е example/picscrap.TEXTrap.TEXTΝ { [& /)  example/picscrapr.textapr.texΝ | [&Q0PW EXAMPLE/QDSAMPLE.TEXTPLE.TEXTΝ } [&Lb-GSLh$ $EXAMPLE/QDSAMPLER.TEXTLER.TEXΝ ~ [&K-KLK example/scrollr.textlr.textΝ- [&6%! Bexample/showpaint.textint.texΝ' ='f'k'kRb FEXAMPLE/QDSAMPLE.OBJaD,H=,,,& example/showpaintR.textntR.teΝ  [&T/CT Example/SoundLabR.TextbR.TextPONН5\g ]VpFPNV n  EXAMPLE/EXEC.TEXT˰ZV0 [ 3-K/9  serial/Ascii.texthtexthΝ  [&-,=- Serial/Async.TexthTexthΝ  [&rVƝ ݰrVh hSerial/Execute.Texte.TextΝ  [&sM,hsM Serial/PipeDefs.Textfs.TextΝ  [&uY ݾu\ Serial/PipeImpl.Textpl.TextΝ  [&u` Ĝuc  serial/Pipes.texthtexthΝ  [&.s ͜.v Serial/SerDefs.Texts.TextΝ  [&uł uŅ Serial/SerImpl.Textl.TextΝ  [&uʼn uŐ, ,Serial/TaskAsm.Textm.TextΝ  [&sM sM  Serial/TaskDefs.Textfs.TextΝ  [&uś uŜ Serial/TaskImpl.Textpl.TextΝ  [&uŠ uţ serial/Tasks.texthtexthΝ  [&0 #0 9 W^g5P:H r^!!0 { Copyright 1983, 1984 by Apple Computer 8Mike Boich 8Martin P. Haeberli } {$I NewSerial/TrmSwtch } { Compile switches and constants } Unit Tasks; Interface Uses {$U obj/QuickDraw } QuickDraw, %{$U obj/OSIntf } OSIntf; Type (Task = ^TaskRec; (TaskRec = Record @next: Task; { Pointer to next Task or Nil } @sp: Ptr; { Saved stack pointer } @fDeAll: Boolean; { Deallocate task object on \death } :End; Procedure InitTasks; Procedure RunTasks; Procedure EndTasks; Procedure Yield; Procedure HaraKiri; Procedure Kill(t: Task); Function ThisTask: Task; Function Fork(proc: ProcPtr; arg: LongInt; t: Task; s: Size): Task; Implementation { Const "OffsetDelta = 24; } Var "TaskFirst: Task; "TaskCurrent: Task; Procedure InitTA; External; Procedure Yield; External; Procedure Resume(t: Task); External; Function RegA5: LongInt; External; Procedure HaraKiri; External; Procedure InitTasks; Begin "TaskFirst := Nil; "TaskCurrent := Nil; "InitTA; End; Procedure RunTasks; Begin "TaskCurrent := TaskFirst; "While TaskCurrent <> Nil Do $Begin &Resume(TaskCurrent); &TaskCurrent := TaskCurrent^.next; $End; End; Procedure EndTasks; Var "taskKill: Task; "taskNext: Task; Begin "If TaskCurrent = Nil Then $Begin &taskKill := TaskFirst; &While taskKill <> Nil Do (Begin *taskNext := taskKill^.next; *Kill(taskKill); *taskKill := taskNext; (End; &TaskFirst := Nil; &InitTA; $End; End; Procedure Kill(t: Task); Var "taskPrev: Task; "taskCur: Task; "taskNext: Task; "found: Boolean; Begin "taskPrev := Pointer(Ord(@TaskFirst)); "taskCur := taskPrev^.next; "found := False; "While (taskCur <> Nil) And (Not found) Do $Begin &If taskCur = t Then (Begin *found := True; *taskPrev^.next := taskCur^.next; (End; &taskPrev := taskCur; &taskCur := taskPrev^.next; $End; "If t^.fDeAll Then $DisposPtr(Pointer(Ord(t))); End; Function ThisTask: Task; Begin "ThisTask := TaskCurrent; End; Procedure IniTskRec(proc: ProcPtr; arg: LongInt; t: Task; s: Size); Var "pArg: ^LongInt; "pProc: ^ProcPtr; "pStack: ^LongInt; "i: Integer; Begin "pArg := Pointer(Ord(t) + s - 4); "pProc := Pointer(Ord(pArg)- 4); "pStack := Pointer(Ord(pProc) - 4); "pArg^ := arg; "pProc^ := Pointer(Ord(@HaraKiri)); "pStack^ := Ord(proc); "pStack := Pointer(Ord(pStack) - 4); "pStack^ := 0; "pStack := Pointer(Ord(pStack) - 4); "pStack^ := RegA5; "For i := 1 to 13 Do $Begin &pStack := Pointer(Ord(pStack) - 4); &pStack^ := 0; $End; "t^.sp := Pointer(Ord(pStack)); End; Function Fork(proc: ProcPtr; arg: LongInt; t: Task; s: Size): Task; Begin "If t = Nil Then $Begin &t := Pointer(Ord(NewPtr(s))); &If t <> Nil Then (t^.fDeAll := True $End "Else $t^.fDeAll := False; "If t <> Nil Then $Begin &IniTskRec(proc, arg, t, s); &t^.next := TaskFirst; &TaskFirst := t; $End; "Fork := t; End; End. serial/TermUtil.textil.textΝ  [&. -.9E D{ IntToStr(x: Integer; Var s: Str255); } { converts pos integer to str } Procedure IntToStr; { Should replace all references to IntToStr with NumToStr! *** } Begin "NumToStr(x, s); End; Procedure PushInteger(int: Integer); External; Procedure PushString(str: Str255); External; Procedure PushPointer(p: Ptr); External; Procedure CallProc(proc: ProcPtr); External; Procedure DebugTrap; External; {$S Util } Procedure ChkErr(err: Integer; explain: Str255); Const "IOAlrt = 4191; { catch-all Alert for IO errors } Var "itemHit: Integer; "myString: Str255; Begin "If err <> 0 Then $Begin &NumToStr(err, myString); &ParamText(myString, explain,' ', ' '); &itemHit := noteAlert(IOAlrt, Nil); $End; End; End. EXAMPLE/QDSAMPLEL.OBJSA&,H=,,,$ N G?<Z?<P?<HzB(_?<?<"?<?<?<2?< ?<Z?< ?<P?<?<_?<"?<?<"/ / ?<?<?<?</ / / ?<?</ / ?<?<Ψ/ Hmj/ / ?<?</ Hn/ / ?<@?<Hz:B&_ڨHn?<?<?<?<^Hn?<?<?<?<O?<E?<?<w?<O?<?<OHn?<m?<?<?<EHn/ / ?<D?<HzHn?<?<?<:?<&HnHn?<?<?<?<HnHnHn?<?<HnHn?<?<HnHmjHnHn?<?<HnHn樻HnLN^NuRAWSTUFOvalsRegionsPolygonsArcsBitMaps RoundRects RectanglesLinesShadowOutline UnderlineItalicBoldText%Look what you can draw with QuickDraw8040200002040800NV/ mI/-X/-0,|?0S@?Y/-?<0,T| ?\/-W/-X/-0,S@?0,|?Y/-0,l| ??<\/-W(_N^NuOVESCRONV mCA""0-|;@0-|;@N^NuESIZEPRNVH(nB/ /-Hm+.Jf`Bg/j<Bg/k:AC 0.|=@Hn(AC 0.|=@Hn(/ ??<NNDAC 0.|=@Hn(AC 0.|=@Hn(LN^.NuROWWND NV mHh{/-B$ -f/-i mCA""0.|=@0.|=@Hn?-?-Hn{?-?-xNBgBgx mHh{N^.NuRAWWINDNV-mBg/-`0@;@Bg/-`0@;@0.m=@0.m=@B+_Hm?.?./-?-?-x m PHh?-?- m PHh{NP/-BgBgx mHh{N^NuCROLLBINV nf/. Bg/. `0S@?cN0N^ _\ONCROLLUPNV nf/. Bg/. `0R@?cNN^ _\ONCROLLDONVHnrBg/-/.f0n f/-Bg/-`0._?cNBgs gN^.NuAGESCRONV/0B?<+_/-/:BMB?<+_~`0S@A @/5Bg5RG Go7.N^NuETUPMENDRVRNVBg/.j;_Bg/.k;_0-S@g@g*`./-?-HnFBgA?<N /;_`|Bg8N^.NuOCOMMANNNV,_NUNA/N?B/-ة=Nb`"Hm/-`/-/-Hm%`Bg/-/-ةg|`B$ -f /-N`/-`B$ -g /-`HmبqBg/-Hm設 gBg/-/-Hml;_0-@gS@g(S@g 67 -- ignore ;------------------------------------------------ ; DoRun 0MOVE.L DCtlStorage(A4),A3 ; get the heap 0MOVE.L (A3),A3 ; dereference it 0TST.B cAutoUpdate(A3) 0BEQ.S @1 0BSR DrawWindow ; then fall through... @1 ;------------------------------------------------ ; CtlDone 0MOVE.L A4,A1 ; return DCE ptr to A1 0MOVEM.L (SP)+,A2-A4 ; A3 and A4 0MOVEQ #0,D0 ; no error 0RTS ; bye-bye ;------------------------------------------------ ; DoMenu 0MOVE.L DCtlStorage(A4),A3 ; get orn storage handle 0MOVE.L (A3),A3 ; dereference it 0MOVE CSParam+2(A0),D0 ; Get the menuItem 0SUBQ #1,D0 ; See if item 1 0BEQ.S SetSysHeap 0SUBQ #1,D0 ; See if item 2 0BEQ.S SetAppHeap 0SUBQ.W #2,D0 ; Can't be 3 0BEQ.S SetAutoUpdate 0SUBQ.W #1,D0 0BEQ.S HandUpdate 0BRA.S CtlDone SetSysHeap 0MOVE.L SysZone,cUseHeap(A3) ; set so sys heap shown 0MOVE.B #00,D0 ; not the application 0BRA.S ToggleHeap SetAppHeap 0MOVE.L ApplZone,cUseHeap(A3) ; set so application heap shown 0MOVE.B #01,D0 ; the application ToggleHeap 0MOVE.B D0,-(SP) 0MOVE.B #2,D1 0BSR.S MarkIt 0MOVE.B (SP)+,D0 0EOR.B #01,D0 ; flip it 0MOVE.B #1,D1 ; 0BSR.S MarkIt ; ; Erase the display window before drawing other window. ; 0MOVEA.L DCtlWindow(A4),A0 ; get port 0PEA portRect(A0) ; push rect for EraseRect 0PEA (A0) ; push the window for SetPort 0_SetPort ; make it the port 0_EraseRect 0BSR DrawWindow 0BRA.S CtlDone ;------------------------------------------------ ; D0 contains boolean true or false ; D1 contains item number ; A3 contains local storage ; markIt 0MOVE.L cMenuHandle(A3),-(SP) ; get the menu handle 0MOVE D1,-(SP) ; push the item 0MOVE.B D0,-(SP) ; push the boolean 0_CheckItem 0RTS ;------------------------------------------------- ; Flip auto-update boolean ; SetAutoUpdate 0MOVE.B cAutoUpdate(A3),D0 ; get auto flag 0EORI.B #1,D0 ; toggle it 0MOVE.B D0,cAutoUpdate(A3) ; replace ;------------------------------------------------- ; Common menu update code ; MarkMenu ,MOVE.W CSParam+2(A0),D1 ; item number ,BSR.S MarkIt ,BRA.S CtlDone ;------------------------------------------------- ; Just redraw the window ; HandUpdate 0BSR DrawWindow 0BRA.S CtlDone ; ; DoCtlCursor might be used to change the cursor shape when over our window ; and back to the arrow when it's not. ; DoCtlCursor 0BRA.S CtlDone ;all done ; ; DoCtlEvent handles the events received by the memWindow ornament. It handles ; mouse down, keyDown and update events ; DoCtlEvent 0MOVE.L A3,-(SP) ;save registers 0MOVE.L CSParam(A0),A3 ;get the event pointer 0MOVE.W EvtNum(A3),D0 ;get the event number ; case out on the event number. We handle events 1 (mouse down), and ; 6 (update event), 0CMP #8,D0 ;is it an activate? 0BEQ DoTheActivate ;if so, go handle it 0SUBQ #1,D0 ;is it mouse down? 0BEQ.S ItsMouseDown ;branch if it is 0SUBQ #2,D0 ;is it key down? 0BEQ.S ItsKeyDown ;branch to handle keyDown 0SUBQ #3,D0 ;is it an update? 0BEQ.S ItsUpdate ;if so, handle it ; its not an event we handle so ignore it CtlEvtDone MOVE.L (SP)+,A3 ;restore registers 0BRA CtlDone ; ignore keyDowns for now ItsKeyDown 0BRA.S CtlEvtDone ;all done ; handle the update event by redrawing the contents of the window ItsUpdate 0MOVE.L EvtMessage(A3),-(SP) ;push the window ptr 0MOVE.L (SP),-(SP) ;push it again 0_BeginUpdate ;set vis to update 0BSR DrawWindow ;draw it 0_EndUpdate 0BRA.S CtlEvtDone ; handle the mouseDown by calling FindControl and tracking the control if its in one ItsMouseDown 0BRA CtlEvtDone ;all done! ; DoTheActivate either puts shows or hides the scroll bar, depending on ; the state of the activate bit. DoTheActivate 0BTST #0,EvtMeta+1(A3) ; activate or de-activate? 0BEQ.S TakeItDown ; if deactivate, take it down ; show the menu 0MOVE.L DCtlStorage(A4),A3 ; Insert the menu item 0MOVE.L (A3),A3 ; dereference it 0MOVE.L cMenuHandle(A3),-(SP) ; 0CLR.W -(SP) ; on the end 0_InsertMenu 0_DrawMenuBar ; Display it 0BRA CtlEvtDone ; all done ; ; hide the menu ; TakeItDown 0MOVE.W #cMenuID,-(SP) ; Delete the menu from bar 0_DeleteMenu 0_DrawMenuBar ; Redisplay it 0BRA CtlEvtDone ; ; CloseStorage deallocates the menu and sets up local memory ; CloseStorage 0MOVE.W #cMenuID,-(SP) ; Delete the menu from bar 0_DeleteMenu 0_DrawMenuBar ; Redisplay it 0MOVE.L DCtlStorage(A4),A0 ; Delete the menu data 0MOVE.L (A0),A0 0MOVE.L cMenuHandle(A0),A0 ; get handle in A0 0_DisposHandle 0RTS ; ; DrawWindow scans the heap and redraws the window. ; DrawWindow ,MOVEM.L D3-D6/A2-A3,-(SP) ; save work regs ,MOVE.L DCtlWindow(A4),-(SP) ; push the window ptr twice for ,MOVE.L (SP),-(SP) ; SizeWindow and setport ; ; Initialize the topLeft pointer (D6) to 0,0. ; Then work down and to the right. ; ,MOVEQ #0,D6 ,MOVE.L DCtlStorage(A4),A3 ; get the heap ,MOVE.L (A3),A3 ; dereference it ,MOVE.L cUseHeap(A3),A3 ; get zone ptr ; ; Size the window by computing the heap extent and dividing by 260 to get ; the number of columns of pixels. Force width up to a multiple of 8 and ; require a minimum. ; ,LEA HeapData(A3),A1 ; ptr to first block ,MOVE.L A1,D1 ,MOVE.L BkLim(A3),D0 ; ptr beyond last usable block ,AND.L maskBC,D1 ,AND.L maskBC,D0 ,SUB.L D1,D0 ; size of heap in bytes ,DIVU #260,D0 ; number of pixel columns ,LSR.L #3,D0 ; divide by eight... ,ADDQ.L #1,D0 ; round up... ,LSL.L #3,D0 ; and multiply by eight ,CMPI.W #152,D0 ; a reasonable minimum ,BHS.S @2 ,MOVE.W #152,D0 @2 ,MOVE.W D0,-(SP) ; width ,MOVE.W #260,-(SP) ; fixed height ,MOVE.B #0,-(SP) ; FALSE, no update ,_SizeWindow ,_SetPort ; make it the port ,LEA HeapData(A3),A0 ; ptr to first block, for loop Continue ; ; Compute the next pointer right away. For the purposes of displaying even ; blocks of 8 bytes, round the first pointer down to nearest 8-byte block. ; ,MOVE.L tagBC(A0),D0 ; size/tag ,MOVE.L handle(A0),D1 ; handle ,MOVE.L D0,D2 ,ANDI.L #BCMask,D0 ; block size in bytes ,MOVEA.L D0,A2 ,ADDA.L A0,A2 ; ptr to next block ,MOVE.L A0,D0 ,ANDI.L #$FFFFFFF8,D0 ; kill low 3 bits ,SUB.L A2,D0 ,NEG.L D0 ,LSR.L #3,D0 ; number of indicator lines ; ; Now set up the pen pattern in A0 for call to display routine. ; ,MOVEA.L 0(A5),A1 ; get global ptr for graphics ,LEA white(A1),A0 ; pen pattern for nonrelocatable ,AND.L #TagMask,D2 ,BEQ.S FreeBlock ,BGT.S GotBlock ; ; Classify the relocatable blocks as ; (1) unlocked and not purged ; (2) locked ; (3) purged ; ,LEA dkGray(A1),A0 ; assume (1) unlk and not prgbl ,MOVE.B 0(A3,D1),D1 ; master ptr, if relocatable ,BMI.S LockedBlock ,ADD.B D1,D1 ; get purgeable bit in sign ,BPL.S GotBlock ,LEA PurgeablePat,A0 ; purgeable relocatable ,BRA.S GotBlock LockedBlock ,LEA ltGray(A1),A0 ; locked relocatable block ,BRA.S GotBlock FreeBlock ,LEA black(A1),A0 ; free block GotBlock ,BSR.S ShowLines ,MOVEA.L A2,A0 ; get next block pointer ,CMP.L bkLim(A3),A0 ; see if at end ,BNE Continue ,MOVEM.L (SP)+,D3-D6/A2-A3 ,RTS ;------------------------------------------------ ; Display D0.W lines of pattern (A0) ; D6 is the current topLeft pointer, which is updated ; after each block is displayed. ; ShowLines ,MOVE.W D0,D3 ; safe place for index ,PEA (A0) ,_PenPat ; pen pattern for PaintRect ShQuickEntry ,MOVE.L D6,D0 ; top/left ,MOVE.L D6,D1 ; will be bottom/right ,ADDQ.W #8,D1 ; right := left + 8 ,SWAP D1 ; align bottom in low word ,ADD.W D3,D1 ; tentative bottom ,CMPI.W #260,D1 ; farther down than 260? ,BHS.S ShTwoBlocks ,SWAP D1 ; align bottom/right ,MOVE.L D1,D6 ; new top/left ,SUBQ.W #8,D6 ; convert top/right to top/left ,BRA.S PaintTheRect ; Easy case -- paint and go ; ; If there is a spillover, just paint the rest of this column ; and fake another call to routine. ; ShTwoBlocks ,SUBI.W #260,D1 ; what's left after this column ,MOVE.W D1,D3 ; the next count ,MOVE.W #260,D1 ; set bottom to the real bottom ,SWAP D1 ; align bottom/right ,MOVEQ #0,D6 ; next top will be zero ,MOVE.W D1,D6 ; this right will be next left ,BSR.S PaintTheRect ,BRA.S ShQuickEntry ;------------------------------------------------ ; D0 = top/left ; D1 = bottom/right ; PaintTheRect ,MOVEM.L D0-D1,-(SP) ; push rect value ,PEA (SP) ,_PaintRect ,ADDQ.L #8,SP ; kill rect value ,RTS FreePat .WORD $FFFF, $FFFF, $FFFF, $FFFF RelPat .WORD $AAAA, $AAAA, $AAAA, $AAAA NonRelPat .WORD $0000, $0000, $0000, $0000 PurgeablePat .WORD $E7E7, $E7E7, $E7E7, $E7E7 LockedPat .WORD $BDBD, $BDBD, $BDBD, $BDBD cMenuTitle .BYTE 6 0.ASCII 'Uriah ' cMenuItems .BYTE 52 0.ASCII 'System;Application;-------' ; 26 each 0.ASCII ';Auto-Refresh;Hand-Refresh' cBounds .WORD 42,0,302,200 0.END 3. "6F^5D!$ǐ^DDF*example/adeskaccr.text --- resource definition file for adeskacc *To create and install this desk accessory, exec the file example/execdeskacc, *then use Resource Mover to copy & paste DRVR resource into system example/adeskacc.rsrc type DRVR #example/adeskacc!Uriah,25 5 ^;{$X-} PROGRAM Boxes; #USES {$U-} &{$U obj/Memtypes } Memtypes, &{$U obj/QuickDraw } QuickDraw, &{$U obj/OSIntf } OSIntf, &{$U obj/ToolIntf } ToolIntf, &{$U obj/Sane } Sane, &{$U obj/Elems } Elems, &{$U obj/Graf3D } Graf3D; #CONST &boxCount = 15; #TYPE &Box3D = RECORD 1pt1: Point3D; 1pt2: Point3D; 1dist: extended; .END; #VAR &myPort: GrafPtr; &myPort3D: Port3DPtr; &boxArray: ARRAY [0..boxCount] OF Box3D; &nBoxes: INTEGER; &i: INTEGER; &etop,ebottom,eleft,eright,temp: extended; #PROCEDURE Distance(pt1,pt2: Point3D; VAR result: extended); &VAR )dx,dy,dz: extended; &BEGIN )dx := pt2.X; { dx:=pt2.X - pt1.X; } )SubX(pt1.X,dx); )dy := pt2.Y; { dy:=pt2.Y - pt1.Y; } )SubX(pt1.Y,dy); )dz := pt2.Z; { dz:=pt2.Z - pt1.Z; } )SubX(pt1.Z,dz); )MulX(dx,dx); { result:=SQRT(dx*dx + dy*dy + dz*dz); } )MulX(dy,dy); )MulX(dz,dz); )AddX(dx,dy); )AddX(dy,dz); )SqrtX(dz); )result := dz &END; #PROCEDURE DrawBrick(pt1,pt2: Point3D); #{ draws a 3D brick with shaded faces. } #{ only shades correctly in one direction } &VAR )tempRgn: RgnHandle; &BEGIN )tempRgn := NewRgn; )OpenRgn; )MoveTo3D(pt1.X,pt1.Y,pt1.Z); { front face, y=y1 } )LineTo3D(pt1.X,pt1.Y,pt2.Z); )LineTo3D(pt2.X,pt1.Y,pt2.Z); )LineTo3D(pt2.X,pt1.Y,pt1.Z); )LineTo3D(pt1.X,pt1.Y,pt1.Z); )CloseRgn(tempRgn); )FillRgn(tempRgn,white); )OpenRgn; )MoveTo3D(pt1.X,pt1.Y,pt2.Z); { top face, z=z2 } )LineTo3D(pt1.X,pt2.Y,pt2.Z); )LineTo3D(pt2.X,pt2.Y,pt2.Z); )LineTo3D(pt2.X,pt1.Y,pt2.Z); )LineTo3D(pt1.X,pt1.Y,pt2.Z); )CloseRgn(tempRgn); )FillRgn(tempRgn,gray); )OpenRgn; )MoveTo3D(pt2.X,pt1.Y,pt1.Z); { right face, x=x2 } )LineTo3D(pt2.X,pt1.Y,pt2.Z); )LineTo3D(pt2.X,pt2.Y,pt2.Z); )LineTo3D(pt2.X,pt2.Y,pt1.Z); )LineTo3D(pt2.X,pt1.Y,pt1.Z); )CloseRgn(tempRgn); )FillRgn(tempRgn,black); )PenPat(white); )MoveTo3D(pt2.X,pt2.Y,pt2.Z); { outline right } )LineTo3D(pt2.X,pt2.Y,pt1.Z); )LineTo3D(pt2.X,pt1.Y,pt1.Z); )PenNormal; )DisposeRgn(tempRgn); &END; #PROCEDURE MakeBox; &VAR )myBox: Box3D; )i,j,h,v: INTEGER; )p1,p2: Point3D; )myRect: Rect; )testRect: Rect; )temp: extended; &BEGIN )I2X(Random,p1.X); {p1.x:=Random mod 70 -15;} )I2X(140,temp); )RemX(temp,p1.X,i); )I2X(15,temp); )SubX(temp,p1.X); )I2X(Random,p1.Y); {p1.y:=Random mod 70 -10;} )I2X(140,temp); )RemX(temp,p1.Y,i); )I2X(10,temp); )SubX(temp,p1.Y); )I2X(0,p1.Z); {p1.z:=0.0;} )I2X(Random,p2.X); {p2.x:=p1.x + 10 + ABS(Random) MOD 30; } )I2X(60,temp); )RemX(temp,p2.X,i); )AbsX(p2.X); )I2X(10,temp); )AddX(temp,p2.X); )AddX(p1.X,p2.X); )I2X(Random,p2.Y); {p2.y:=p1.y + 10 + ABS(Random) MOD 45; } )I2X(90,temp); )RemX(temp,p2.Y,i); )AbsX(p2.Y); )I2X(10,temp); )AddX(temp,p2.Y); )AddX(p1.Y,p2.Y); )I2X(Random,p2.Z); {p2.z:=p1.z + 10 + ABS(Random) MOD 35; } )I2X(70,temp); )RemX(temp,p2.Z,i); )AbsX(p2.Z); )I2X(10,temp); )AddX(temp,p2.Z); )AddX(p1.Z,p2.Z); ){ reject box if it intersects one already in list } )WITH myRect DO ,BEGIN { 1SetRect(myRect,ROUND(p1.x),ROUND(p1.y),ROUND(p2.x),ROUND(p2.y)); 3} ,X2I(p1.X,left); ,X2I(p1.Y,top); ,X2I(p2.X,right); ,X2I(p2.Y,bottom) ,END; )FOR i := 0 TO nBoxes-1 DO ,BEGIN ,WITH boxArray[i],testRect DO /BEGIN { SetRect(myRect,ROUND(pt1.x),ROUND(pt1.y) } /X2I(pt1.X,left); { ,ROUND(pt2.x),ROUND(pt2.y)); } /X2I(pt1.Y,top); /X2I(pt2.X,right); /X2I(pt2.Y,bottom) /END; ,IF SectRect(myRect,testRect,testRect) THEN EXIT(MakeBox) ,END; )myBox.pt1 := p1; )myBox.pt2 := p2; ){ calc midpoint of box and its distance from the eye } )AddX(p2.X,p1.X); { p1.x:=(p1.x + p2.x)/2.0; } )I2X(2,temp); )DivX(temp,p1.X); )AddX(p2.Y,p1.Y); { p1.y:=(p1.y + p2.y)/2.0; } )I2X(2,temp); )DivX(temp,p1.Y); )AddX(p2.Z,p1.Z); { p1.z:=(p1.z + p2.z)/2.0; } )I2X(2,temp); )DivX(temp,p1.Z); )Transform(p1,p2); )Distance(p2,myPort3D^.eye,myBox.dist); { distance to eye } )i := 0; )boxArray[nBoxes].dist := myBox.dist; { sentinel } )WHILE CmpX(myBox.dist,GT,boxArray[i].dist) { myBox.dist > UboxArray[i].dist } /DO ,i := i+1; { insert in order of dist } )FOR j := nBoxes DOWNTO i+1 DO boxArray[j] := boxArray[j-1]; )boxArray[i] := myBox; )nBoxes := nBoxes+1; &END; #BEGIN { main program } &InitGraf(@thePort); &HideCursor; &NEW(myPort); OpenPort(myPort); &NEW(myPort3D); Open3DPort(myPort3D); &ViewPort(myPort^.portRect); { put the image in this rect } &I2X(-100,eleft); &I2X(75,etop); &I2X(100,eright); &I2X(-75,ebottom); &LookAt(eleft,etop,eright,ebottom); { aim the camera into 3D space } &I2X(30,temp); &ViewAngle(temp); { choose lens focal length } &Identity; &I2X(20,temp); &Roll(temp); &I2X(70,temp); &Pitch(temp); { roll and pitch the plane } &REPEAT )nBoxes := 0; )REPEAT ,MakeBox )UNTIL nBoxes=boxCount; )PenPat(white); )BackPat(black); )EraseRect(myPort^.portRect); )FOR i := -10 TO 10 DO ,BEGIN ,I2X(i*10,eleft); ,I2X(-100,etop); ,I2X(0,temp); ,MoveTo3D(eleft,etop,temp); ,I2X(100,ebottom); ,LineTo3D(eleft,ebottom,temp); ,END; )FOR i := -10 TO 10 DO ,BEGIN ,I2X(i*10,eleft); ,MoveTo3D(etop,eleft,temp); ,LineTo3D(ebottom,eleft,temp); ,END; )FOR i := nBoxes-1 DOWNTO 0 DO DrawBrick(boxArray[i].pt1,boxArray[i].pt2); &UNTIL button #END. 3. "6F^5D!$ǐ^   uexample/boxes.rsrc Type CODE example/boxesl,0 3. "6F^5D!$ǐ^ $EXEC PExample/boxes g$M+ Example/boxes l? +X Example/boxes obj/macpaslib obj/sane obj/saneasm obj/elems obj/elemsasm obj/quickdraw obj/graf3d obj/tooltraps obj/ostraps Example/boxesl Rrmaker Example/boxesr R{un}MacCom FYLexample/boxes.RSRC boxes APPL{set type to APPL} {set creator to ????} N{o bundle bit}QFDExample/boxes.i ydExample/boxes.obj ydExample/boxl.obj yq $ENDEXEC 5^))9{$X-} PROGRAM Edit; "{ Edit -- A small sample application written in Pascal } "{ by Macintosh Technical Support } "{SK 6/18 Added Memtypes, if GetNextEvent, EraseRect in update event, #fixed for new Edit menu } "{This program is a sample. Don't use it as a skeleton or template; instead, #understand each line and redo it yourself, only better!} #USES {$U-} &{$U Obj/Memtypes } Memtypes, &{$U Obj/QuickDraw } QuickDraw, &{$U Obj/OSIntf } OSIntf, &{$U Obj/ToolIntf } ToolIntf; #CONST &lastMenu = 3; { number of menus } &appleMenu = 1; { menu ID for desk accessory menu } &fileMenu = 256; { menu ID for File menu } &editMenu = 257; { menu ID for Edit menu } #VAR &myMenus: ARRAY [1..lastMenu] OF MenuHandle; &screenRect,dragRect,pRect: Rect; &doneFlag,temp: BOOLEAN; &myEvent: EventRecord; &code,refNum: INTEGER; &wRecord: WindowRecord; &myWindow,whichWindow: WindowPtr; &theMenu,theItem: INTEGER; &hTE: TEHandle; #PROCEDURE SetUpMenus; #{ Once-only initialization for menus } &VAR )i: INTEGER; &BEGIN )InitMenus; { initialize Menu Manager } )myMenus[1] := GetMenu(appleMenu); )AddResMenu(myMenus[1],'DRVR'); { desk accessories } )myMenus[2] := GetMenu(fileMenu); )myMenus[3] := GetMenu(editMenu); )FOR i := 1 TO lastMenu DO InsertMenu(myMenus[i],0); )DrawMenuBar; &END; { of SetUpMenus } #PROCEDURE DoCommand(mResult: LongInt); &VAR )name: STR255; &BEGIN )theMenu := HiWord(mResult); theItem := LoWord(mResult); )CASE theMenu OF ,appleMenu: /BEGIN /GetItem(myMenus[1],theItem,name); /refNum := OpenDeskAcc(name); /END; ,fileMenu: doneFlag := TRUE; { Quit } ,editMenu: /IF NOT SystemEdit(theItem-1) THEN 2BEGIN 2SetPort(myWindow); 2CASE theItem OF 53: TECut(hTE); 54: TECopy(hTE); 55: TEPaste(hTE); 2END; { of item case } /END; { of editMenu } )END; { of menu case } )HiliteMenu(0); &END; { of DoCommand } #BEGIN { main program } &InitGraf(@thePort); &InitFonts; &FlushEvents(everyEvent,0); &InitWindows; &SetUpMenus; &TEInit; &InitDialogs(NIL); &InitCursor; &screenRect := screenBits.bounds; &SetRect(dragRect,4,24,screenRect.right-4,screenRect.bottom-4); &doneFlag := FALSE; &myWindow := GetNewWindow(256,@wRecord,POINTER(-1)); &SetPort(myWindow); &pRect := thePort^.portRect; &InsetRect(pRect,4,0); &hTE := TENew(pRect,pRect); &REPEAT )SystemTask; )TEIdle(hTE); )if GetNextEvent(everyEvent,myEvent) then )CASE myEvent.what OF ,mouseDown: /BEGIN /code := FindWindow(myEvent.where,whichWindow); /CASE code OF 2inMenuBar: DoCommand(MenuSelect(myEvent.where)); 2inSysWindow: SystemClick(myEvent,whichWindow); 2inDrag: DragWindow(whichWindow,myEvent.where,dragRect); 2inGrow,inContent: 5BEGIN 5IF whichWindow<>FrontWindow THEN 8SelectWindow(whichWindow) 5ELSE 8BEGIN 8GlobalToLocal(myEvent.where); 8TEClick(myEvent.where,(BitAnd (myEvent.modifiers,512) <> 0) @,hTE); 8END; 5END; /END; { of code case } /END; { of mouseDown } ,keyDown,autoKey: 0TEKey(CHR(myEvent.message MOD 256),hTE); ,activateEvt: /IF ODD(myEvent.modifiers) { window is becoming active } 2THEN 5TEActivate(hTE) 2ELSE 5TEDeactivate(hTE); ,updateEvt: /BEGIN /SetPort(myWindow); /BeginUpdate(myWindow); /EraseRect (thePort^.visRgn^^.rgnBBox); /TEUpdate(thePort^.portRect,hTE); /EndUpdate(myWindow); /END; { of updateEvt } )END; { of event case } &UNTIL doneFlag; #END. 3. "6F^5D!$ǐ^778* EditR -- Resource input for small sample application * Written by Macintosh Technical Support * SK 6/18 Made Edit menu items standard, added menu 1 * Example/Edit.Rsrc Type MENU ",1 "\14 ",256 "File $Quit ",257 "Edit $Undo $(- $Cut $Copy $Paste Type WIND ",256 "A Sample "50 40 300 450 "Visible NoGoAway "0 "0 Type EDIT = STR ,0 Edit Version 1.0 - 12 December 83 Type CODE Example/editL,0 3. "6F^9D!$ǐ^EFPelectWindow(whichWindow);RFFFF`D`Z̕$lFPFPaa.FFx`|a.̕Lode := FindContrFa̕La.̓̓,FF̕$̕6̕L̕L88`x̕L̕L88,ÈFFF|`̕6̕$`̕$L~xyUHH"N̕"W* * Resource Definition File for Sound Demo * * Example/SoundLab.Rsrc Type MENU ",1 "\14 ",256 "Channel $Channel A $Channel B $Channel C $Channel D ",257 "WaveForm $Triangle $Square $Sine $Channel A $Channel B $Channel C $Channel D #,258 #On/Off %Sound Off Type WIND ",1 "Mac Sound Lab "40 40 280 340 "Visible GoAway "0 "1 ",2 "Channel A WaveForm "100 100 356 356 "Visible GoAway "0 "3 Type CODE "example/soundlabL,0 3. "6F^56D!$ǐ^huu4$EXEC ${ This single exec file can generate a Macintosh resource file from most of the } ${ example source files. The source can be Pascal, or assembly, or both. The } ${ naming convention is that assembly files have 'ASM' appended to the file name, } ${ and resource files have an added 'R', although this can easily be changed below. } ${ ${ The exec file is run by typing 'R' from the command line, then typing a line of } ${ of the form: } $ ${ '' THEN {If a source volume is specified, } $$SET %8 TO CONCAT('-', %3, '-') {set '%8' to the name of the source volume} $ELSE $$SET %8 TO '' {otherwise use the prefix volume } $ENDIF $IF %4 <> '' THEN {If a library volume is specified, } $$SET %7 TO CONCAT('-', %4, '-') {set '%7' to the name of the library volume} $ELSE $$SET %7 TO '' $ENDIF $ $ $SET %9 TO 'F' {Start out assuming there is no file to assemble} $IF EXISTS(CONCAT(%8, %1, '.TEXT')) THEN {If a text ASM file exists, } $$IF NOT(EXISTS(CONCAT(%8, %1, '.OBJ'))) THEN {and if no code file exists,} ($SET %9 TO 'T' {then assemble it } $$ELSEIF NEWER(CONCAT(%8, %1, '.TEXT'), CONCAT(%8, %1, '.OBJ')) THEN ($SET %9 TO 'T' {Otherwise assemble if the text is newer than the code } $$ENDIF $ENDIF $ $IF %9 = 'T' THEN {Assemble if the assembly file is true} $$WRITELN CONCAT('Assemble: ', %8, %1, '.TEXT') {a debugging statement} A{ssemble}%8%1 {&8 is the volume prefix, and &1 is the file name} D{this blank line is for the listing file} D{this blank line is for the default output file} $ENDIF $ $ $SET %9 TO 'F' {Assume there is no Pascal program} 3. "6F^5D!$ǐ^**{ File -- Example code for printing, reading and writing files, and Text Edit } { -- by Cary Clark, Macintosh Technical Support } PROGRAM MyFile; { Please read 'more about File,' included on the MacStuff 1 disk. } {$DECL BUG} {$SETC BUG := 0} {One good way of debugging code is to write status information to one of the serial ports. Even while debugging code which uses one of the ports, the other can be used for transmitting information to an external terminal. In this program, the compile time variable BUG is set to either -1, 0 or 1 according to the extent of the debugging information required. Since compile time variables or constants are used, setting a single flag should cause the resulting program to have no more code than is required by the debugging level requested. If BUG is set equal to -1, then no debugging information appears; this is as you would want the end user to see your product. BUG set to 0 provides an additional menu bar called 'debug' that can display the amount of memory available, compact memory, and discard segments and resources resident in memory. You can do something similar to display some debugging information on the Mac itself if you do not have a terminal, but the penalty here is that you may spend much of your time debugging the code which is intended to debug some other part of the program. Obviously, creating and maintaining a window on a screen full of other windows in untested code is a difficult thing to do. BUG set to 1 adds an additional item to the 'debug' menu that writes various runtime information to an external terminal. This is the preferred method of debugging, since it does not interfere with the Macintosh display. Even if you do not have a separate terminal, you can use the LISA terminal program to act as one. Since writing a lot of debugging information to a serial port can slow the program down, I would recommend a way of turning the information on and off. In this program, the variable DEBUG is set to true or false in the beginning of one of the first procedures executed, SETUP, to provide debugging information. The DEBUG variable may also be set by the bottom item on the rightmost menu.} {$U-} {Turn off the Lisa Libraries. This is required by Workshop.} {$X-} {Turn off stack expansion. This is a Lisa concept, not needed on Mac.} {$R-} {Turn off range checking.} {$IFC BUG > -1} #{$D+} {Put the procedures name just after it in the code, to help in debugging} {$ELSEC} #{$D-} {Do not include the procedure name in the 'production' code} {$ENDC} {$L-} {don't list the interfaces} USES #{$U Obj/MemTypes } MemTypes, #{$U Obj/QuickDraw } QuickDraw, #{$U Obj/OSIntf } OSIntf, #{$U Obj/ToolIntf } ToolIntf, #{$U Obj/PackIntf } PackIntf, #{$U Obj/MacPrint } MacPrint; {$L+} {just list the program} CONST #appleMenu = 1; #FileMenu = 2; #EditMenu = 3; #DebugMenu = 4; {These constants are declared for this application to distinguish between the various types of windows that it can create. The number is stored in the window field windowkind.} #MyDocument = 8; #Clipboard = 9; #FreeMemory = 10; {$IFC BUG = -1} #lastMenu = 3; { number of menus w/o debug} {$ELSEC} #lastMenu = 4; { number of menus w/ debug} {$ENDC} #lf = CHR(10); { At present, information written to the external terminal 8needs its own linefeed.} {$IFC BUG < 1} #debug = FALSE; { compiler will discard code after 'If debug ...'} {$ENDC} TYPE #ProcOrFunc = (proc, func, neither); #edset = set of 1..9; #LomemPtr = ^LongInt; #MyData = RECORD {each document window keeps a handle to this in WRefCon} .TERecord: TEHandle; {the text associated with this document} .FileVolume: INTEGER; {which volume, if loaded from disk} .changed: BOOLEAN; {the document is 'dirty'} .titled: BOOLEAN; {the document has never been saved to disk} ,END; #MyDataPtr = ^MyData; #MyDataHandle = ^MyDataPtr; { <<< this little beauty does a form feed when you print this out. 'Copy and Paste it to move it to your source code} {Here are a ton of global variables. This is not a good programming example. You professionals, of course, will keep the number of globals in your own programs to a much smaller number than shown here.} {these first six values are changed as windows are activated} VAR #MyWindow: WindowPtr; #MyPeek: WindowPeek; {MyPeek is the same as MyWindow} #WindowData: MyDataHandle; {this record is pointed to by the WRefCon.} #hTE: TEHandle; {The active text edit handle} #vScroll: ControlHandle; {The active vertical scroll bar.} #whichpart: INTEGER; {The last button pressed} #topline: INTEGER; {the value of VScroll, also the visible top line.} #printhdl: THPrint; {initialized in SetUp, used by MyPrint} #myMenus: ARRAY %[1..lastMenu] OF MenuHandle; {Handles to all of the menus} #growRect, {contains how big and small the window can grow} #dragRect: Rect; {contains where the window can be dragged} #tempwindow: WindowPtr; {window referenced by GetNextEvent (bad pgmming.)} #theChar: CHAR; {keyboard input goes here} #myPoint: Point; {the point where an event took place} #lastCount: INTEGER; {last scrap count, to see if it has changed} #lastPaste: INTEGER; {the scrap value when the last paste was made} #doneFlag: BOOLEAN; {set when the user quits the program} #myEvent: EventRecord; {returned by GetNextEvent} #scrapwind: WindowPtr; {the ClipBoard window, which contains the scrap} #iBeamHdl: CursHandle; {the text editing cursor} #watchHdl: CursHandle; {the wait cursor} #windownum: LongInt; {the # of untitled windows opened} #windowpos: LongInt; {the # of windows opened} #MyFileTypes: SFTypeList; {same as txtfile, in a format for Standard File} #firstchar: INTEGER; {position of first character on top visible line} #printflag: BOOLEAN; {the user selected 'Print' from the File menu} #finderprint: BOOLEAN; {the user selected 'Print' from the Finder} #Dlogptr: DialogPtr; {the dialog box used when printing from Finder} #printing: BOOLEAN; {printing is currently in progress} #printport: grafptr; {port preserved during background printing} #numfiles: INTEGER; {number of files selected in finder} #applLimit, {a pointer to the bottom of the stack area} #heapend: LomemPtr; {a pointer to the end of the application heap} #dummy: Handle; {a temporary handle used to grow the heap} {$IFC BUG > -1} #FreeWind: WindowPtr; {the free memory window} #oldmem: LongInt; {the last amount of free memory} {$ENDC} {$IFC BUG = 1} #debug: BOOLEAN; {$ENDC} #debugger: text; {the external terminal file} {------------------------------------------------------------------------------------} PROCEDURE AutoScroll; EXTERNAL; {This assembly routine is called by the innerds of TextEdit when the user drags a selection range outside of the current window.} FUNCTION NewPtrClear (byteCount: Size): Ptr; EXTERNAL; {The NewPtr and NewHandle traps have a bit that clears the memory reserved by the call when set. This assembly sets that bit for the NewPtr trap.} PROCEDURE MainEventLoop; FORWARD; {This is declared forward so the printing can take the main event loop as a procedure to execute while it is idleing} FUNCTION MyGrowZone (cbNeeded: Size) : Size; FORWARD; {This is declared forward so that it can be resident in the blank segment, which is always loaded, and still be referenced by the SetUp procedure} {$S Utilities} {------------------------------------------------------------------------------------} PROCEDURE DebugInProc (prockind: ProcOrFunc; where: str255; location: ptr); {This procedure writes the executing routine's name and location in memory on the external terminal. The location is especially important in a program like this that has segments.} BEGIN {$IFC BUG = 1} "Write (debugger, 'in '); "IF prockind = proc THEN Write (debugger, 'Procedure '); "IF prockind = func THEN Write (debugger, 'Function '); "Writeln (debugger, where, ' @ ', ORD4(location), lf) {$ENDC} END; {------------------------------------------------------------------------------------} PROCEDURE SetScrollMax; Var cr : INTEGER; $return : char; $max: INTEGER; BEGIN {This adjusts the scroll value so that the scroll bar range is not allowed to exceed the end of the text. Also, the scroll bar is disabled if the max is set equal to the min, which is zero. The formula for determining the range is somewhat complex. Sorry.} "IF debug THEN debuginproc (proc, 'SetScrollMax', @SetScrollMax); "WITH hTE^^, hTE^^.viewrect DO "BEGIN $cr := 0; $return := CHR(13); $IF teLength > 0 THEN &IF Munger (htext, teLength-1, Pointer(ORD4(@return)+1), 1, NIL, 1) > 0 &THEN cr := 1; $max := nLines + cr - (bottom - top+1) DIV lineHeight; $IF max < 0 THEN max := 0; $SetCtlMax (VScroll, max); $IF debug THEN Writeln (debugger, 'vscrollmax =', max,lf); $topline := -destrect.top DIV lineheight; $SetCtlValue (vscroll, topline); $IF debug THEN Writeln (debugger, 'topline =',topline,lf) "END; END; {------------------------------------------------------------------------------------} PROCEDURE ScrollText (showcaret: BOOLEAN); {called to either show the caret after an action like 'Copy'; also called to adjust the text within the window after the window is resized. The same formula used in SetScrollMax is used here as well. Don't worry about how this works, too much. This possibly could be made much simpler.} Var bottomline, viewlines, SelLine, scrlAmount, numlines, blanklines, newtop %,return: INTEGER; BEGIN "IF debug THEN DebugInProc (proc, 'ScrollText', @ScrollText); "WITH hTE^^ DO "BEGIN $scrlAmount := 0; $numlines := nlines; {if the last character is a carriage return, add 1 to numlines} $return := $0D00; $IF teLength > 0 THEN &IF Munger (htext, teLength-1, @return, 1, NIL, 1) > 0 &THEN numlines := numlines + 1; $WITH HTE^^.viewrect DO %viewlines := (bottom - top+1) DIV lineHeight; {don't count partial lines} $topline := -destrect.top DIV lineheight; $bottomline := topline + viewlines - 1; $IF showcaret $THEN $BEGIN &selLine := 0; &WHILE (selLine+1 < nlines) AND (selstart >=linestarts[selLine+1]) DO 'selLine := selLine + 1; %{if selstart = selend is @ a cr, then add 1 to selstline} &IF (selstart = selend) AND (selstart > 0) THEN &IF Munger (htext, selstart-1, Pointer(ORD4(@return)+1), 1, NIL, 1) = selstart-1 &THEN selLine := selLine + 1; &IF debug THEN &BEGIN (Write (debugger, 'selstart=',selstart:5,'; selLine=',selLine:5); (IF selstart > 0 THEN &END; &IF SelLine > bottomline THEN &BEGIN (scrlAmount := bottomline - SelLine; (IF numlines - SelLine > viewlines DIV 2 (THEN scrlAmount := scrlAmount - viewlines DIV 2 (ELSE ScrlAMount := ScrlAmount - numlines + SelLine + 1 &END; &IF SelLine < topline THEN &BEGIN (scrlAmount := topline - SelLine; (IF selLine > viewlines DIV 2 (THEN scrlAmount := scrlAmount + viewlines DIV 2 (ELSE ScrlAMount := ScrlAmount + selLine &END $END; $IF scrlAmount = 0 THEN $BEGIN &blanklines := viewlines - numlines + topline; &IF blanklines < 0 THEN blanklines := 0; &IF (blanklines > 0) AND (topline > 0) THEN &BEGIN (scrlAmount := blanklines; (IF scrlAmount > topline THEN scrlAmount := topline &END; &IF NOT showcaret THEN &BEGIN (newtop := 0; (WHILE (newtop+1 < nlines) AND (firstchar >= linestarts[newtop+1]) DO )newtop := newtop + 1; (IF (newtop <> topline) AND (ABS(newtop - topline) > ABS(scrlAmount)) THEN )scrlAmount := topline - newtop &END $END; $IF debug THEN $BEGIN &Write (debugger, 'newtop=',newtop:4,'; blanklines=',blanklines:4); &Writeln (debugger, '; newtop - topline=',newtop - topline,lf) $END; $IF scrlamount <> 0 THEN $BEGIN &IF selstart = selend THEN TEDeactivate (hTE); &TEScroll (0, scrlAmount * lineheight, hTE); &IF selstart = selend THEN TEActivate (hTE) $END; $IF debug THEN Writeln (debugger, 'scrlAmount=',scrlAmount:4,lf); $SetScrollMax "END END; {------------------------------------------------------------------------------------} PROCEDURE ToggleScrap; Var temppeek: windowPeek; $getwhich: INTEGER; $showhidestr: Str255; BEGIN {The clipboard comes and goes, here. The last item in the editmenu is alternately made to read, 'Show Clipboard' and 'Hide Clipboard'.} "IF debug THEN DebugInProc (proc, 'ToggleScrap', @ToggleScrap); "IF ScrapWind = NIL THEN {make it appear} "BEGIN $scrapwind := GetNewWindow (257, NIL, Pointer (-1)); $Temppeek := windowPeek (scrapwind); $Temppeek^.windowkind := Clipboard; $SetPort (scrapwind); $InvalRect (scrapwind^.Portrect); $GetWhich := 5 {hide clipboard} "END "ELSE {make it disappear} "BEGIN $DisposeWindow (scrapwind); $Scrapwind := NIL; $GetWhich := 4 {show clipboard} "END; "GetIndString (showhidestr, 256, getwhich); "SetItem (myMenus[EditMenu], 9, showhidestr); END; {$IFC BUG > -1} {------------------------------------------------------------------------------------} PROCEDURE ToggleFree; Var temppeek: windowpeek; $getwhich: INTEGER; $showhidestr: Str255; BEGIN {just about the same as ToggleClipboard, above. This is just for debugging fun.} "IF debug THEN DebugInProc (proc, 'ToggleFree', @ToggleFree); "IF FreeWind = NIL THEN {make it appear} "BEGIN $Freewind := GetNewWindow (258, NIL, Pointer (-1)); $Temppeek := windowPeek (Freewind); $Temppeek^.windowkind := FreeMemory; $SetPort (Freewind); $InvalRect (Freewind^.Portrect); $GetWhich := 3; "END "ELSE {make it disappear} "BEGIN $DisposeWindow (Freewind); $Freewind := NIL; $GetWhich := 2 "END; "GetIndString (showhidestr, 257, getwhich); "SetItem (myMenus[DebugMenu], 1, showhidestr); END; {$ENDC} {------------------------------------------------------------------------------------} PROCEDURE SetViewRect; BEGIN {text edit's view rect is inset in the content of the window, to prevent it from running into the lefthand side or the scroll bar.} "IF debug THEN DebugInProc (proc, 'SetViewRect', @SetViewRect); "WITH hTE^^.viewrect DO "BEGIN $hTE^^.viewrect := MyWindow^.portRect; $left := left +4; $right := right -15 "END END; {------------------------------------------------------------------------------------} PROCEDURE MoveScrollBar; BEGIN {When the window is resized, the scroll bar needs to be stretched to fit.} "IF debug THEN DebugInProc (proc, 'MoveScrollBar', @MoveScrollBar); "WITH MyWindow^.portRect DO "BEGIN $HideControl(vScroll); $MoveControl(vScroll,right-15,top-1); $SizeControl(vScroll,16,bottom-top-13); $ShowControl(vScroll) "END END; {------------------------------------------------------------------------------------} PROCEDURE GrowWnd; { Handles growing and sizing the window and manipulating the update region. } VAR longStuff: RECORD CASE INTEGER OF &1 : (longResult : LONGINT); {Information returned by MenuSelect} &2 : (height, {Which menu was selected} +width : INTEGER) {Which item within the menu} $END; $height, width, newvert, oldstart: INTEGER; $tRect, oldportrect: Rect; BEGIN "IF debug THEN DebugInProc (proc, 'GrowWnd', @GrowWnd); "WITH longStuff DO "BEGIN $longResult := GrowWindow(MyWindow,myEvent.where,growRect); $IF longResult = 0 THEN EXIT(GrowWnd); $Setcursor (watchhdl^^); {because the word wrap could take a second or two} $SizeWindow(MyWindow,width,height,TRUE); { Now draw the newly sized window. } $InvalRect (MyWindow^.portrect); $IF MyPeek^.windowkind = MyDocument THEN {it's not the clipboard} $BEGIN &MoveScrollBar; &WITH MyWindow^.portRect DO &BEGIN (width := right-left-19; (height := bottom-top &END; &WITH HTE^^ DO &BEGIN (destrect.right := destrect.left + width; (viewrect.right := viewrect.left + width; (viewrect.bottom := viewrect.top + height; (firstchar := hTE^^.linestarts [topline]; (TECalText (hTE); {re-wrap the text to fit the new screen.} ({if the rectangle is grown such that there is now blank space on the bottom (of the screen, backpedal the screen to fill it back up, if there is enough (scrolled off the screen to do so. Otherwise, the first character in the top line on (the screen should continue to be somewhere on the top line after resizing} (ScrollText (FALSE); &END $END "END END; { of GrowWnd } {------------------------------------------------------------------------------------} PROCEDURE MyActivate; VAR tRect : rect; BEGIN {activate events occur when one window appears in front of another. This takes care of hiliting the scroll bar and deactivating the insertion caret or the text selection.} "IF debug THEN DebugInProc (proc, 'MyActivate', @MyActivate); "MyWindow := windowPtr (MyEvent.message); "MyPeek := windowPeek (MyWindow); "IF MyPeek^.windowkind in [MyDocument,Clipboard] THEN "BEGIN {redraw the scrollbar area, if a document or the clipboard} $SetPort (MyWindow); $tRect := MyWindow^.portRect; $tRect.left := tRect.right-16; $InvalRect(tRect) "END; "IF MyPeek^.windowkind = MyDocument THEN "BEGIN {make global variables point to the information associated with this window} $WindowData := MyDataHandle (GetWRefCon (MyWindow)); $VScroll := ControlHandle (MyPeek^.ControlList); $hTE := WindowData^^.TERecord; $IF ODD (myEvent.modifiers) $THEN $BEGIN {this window is now top most} &TEActivate(hTE); &ShowControl (VScroll); &topline := GetCtlValue (VScroll) $END $ELSE $BEGIN {this window is no longer top most} &HideControl (VScroll); &TEDeactivate(hTE); &hTE := NIL {a document is no longer on top} $END "END END; { of activateEvt } {------------------------------------------------------------------------------------} PROCEDURE DialogueDeactivate; var temprect: rect; BEGIN {This routine takes care of cases where, for instance, a modal dialog is about to pop up in front of all the other windows. Since the Dialog Manager handles all activate events for you, you do not get a chance to 'turn off' the controls associated with the window. This routine is called just before the dialog box makes its appearance, and takes care of the hiliting as if an activate event had occured.} "IF debug THEN DebugInProc (proc, 'DialogueDeactivate', @DialogueDeactivate); "IF hTE <> NIL THEN {for documents, only} "BEGIN $TEDeactivate(hTE); $HideControl (VScroll); $SetCursor (arrow) "END; "IF (frontwindow <> NIL) AND (Mypeek^.windowkind IN [MyDocument, Clipboard]) THEN "BEGIN {this is a little kludgy, but it works.} $Mypeek^.hilited := FALSE; {DrawGrowIcon will now unhilite.} $temprect := MyWindow^.PortRect; $temprect.left := temprect.right - 15; $Cliprect (temprect); {clipaway the horizontal scrollbar part} $DrawGrowIcon (MyWindow); $Cliprect (MyWindow^.PortRect); $Mypeek^.hilited := TRUE {fix things back} "END END; {$S READFILE} {------------------------------------------------------------------------------------} Function ReadFile (VrefNo: INTEGER; FName : str255) : BOOLEAN; Var refNo, io : INTEGER; $logEOF: LongInt; $errin: str255; {------------------------------------------------------------------------------------} "Procedure DiskRErr (io : INTEGER); "Var str: str255; &readfromstr, loadedstr, str1: Str255; &dummy: INTEGER; "BEGIN {A generic error is reported to the user if something goes wrong. Amazingly little can go wrong, since the user does not get the chance to do things like type file names, remove the disk himself, and so on. About the only error that could happen is: an error occured while reading the disk (damaged media or hardware) Can you think of anything else? A similar routine further down handles writing to disk. Note that in both reading and writing, the entire file is handled by a single read/write call, and no 'disk buffer' needs to be specified by the programmer.} $IF debug THEN $BEGIN &DebugInProc (func, 'DiskRErr', @DiskRErr); &Writeln (debugger, errin, ' err = ', io, lf) $END; $GetIndString (readfromstr, 256, 9); {this says 'reading from'} $GetIndString (loadedstr ,256, 11); {this says 'loaded'} $IF io = IOErr $THEN GetIndString (str, 256, 21) {this says 'IO error'} $ELSE $BEGIN &NumToString (io, str1); &GetIndString (str, 256, 22); {this is the generic 'ID ='} &str := Concat (str, str1) $END; $Paramtext (readfromstr, FName, loadedstr, str); $SetCursor (arrow); $dummy := StopAlert (256, NIL); {discribe error to user in generic way.} $Exit (readfile) "END; BEGIN "IF debug THEN "BEGIN $DebugInProc (func, 'ReadFile', @ReadFile); $writeln (debugger, 'volume = ', vrefno, '; file = ', fname, lf) "END; "SetCursor (watchHdl^^); "ReadFile := FALSE; "io := FSOpen (Fname, VRefNo, RefNo); {$IFC BUG = 1} {these debugging statements are for the external terminal, only} "errin := 'FSOpen'; {$ENDC} "IF io <> 0 THEN DiskRErr (io); "io := GetEOF (RefNo, logEOF); {$IFC BUG = 1} "errin := 'GetEOF'; {$ENDC} "IF io <> 0 THEN DiskRErr (io); "{add code here: if file is too large, then notify user and truncate} "SetHandleSize (hTE^^.hText, logEOF); "IF debug THEN IF memerror<>0 THEN Writeln (debugger, 'memerr = ',memerror:4); "io := FSRead (refNo, logEOF, hTE^^.hText^); {$IFC BUG = 1} "errin := 'FSRead'; {$ENDC} "IF io <> 0 THEN DiskRErr (io); "io := FSClose (refNo); {$IFC BUG = 1} $errin := 'FSClose'; {$ENDC} "IF io <> 0 THEN DiskRErr (io); "hTE^^.teLength := logEOF; "IF NOT finderprint THEN {if printing from the finder, no window or editing #information is needed} "BEGIN $TESetSelect (0,0,hTE); $TECalText (hTE); $Invalrect (hTE^^.viewrect); $SetScrollMax; $WindowData^^.titled := TRUE; $WindowData^^.changed := FALSE; $WindowData^^.FileVolume := VRefNo "END; "ReadFile := TRUE {everything worked out OK} END; {------------------------------------------------------------------------------------} PROCEDURE MakeAWindow (str : str255; disk : BOOLEAN); Var bounds: rect; BEGIN {A window is created here, and all associated data structures are linked to it} "IF debug THEN DebugInProc (proc, 'MakeAWindow', @MakeAWindow); "windowpos := windowpos + 1; {this position it is created to on the screen} "bounds.left := windowpos MOD 16 * 20 + 5; "bounds.top := windowpos MOD 11 * 20 + 45; "bounds.right := bounds.left + 200; "bounds.bottom := bounds.top + 100; "MyWindow := NewWindow(NIL, bounds, str, TRUE, 0, Pointer(-1), TRUE, 0); "SetPort (MyWindow); "Mypeek := windowPeek (MyWindow); "TextFont (applFont); "DrawChar (' '); SetFontLock (TRUE); "Mypeek^.windowkind := MyDocument; {a number > 8 identifies the type of window} "hTE := TENew(MyWindow^.portRect, MyWindow^.portRect); "WindowData := MyDataHandle (NewHandle (8)); {1 handle, an integer, and 2 booleans} "SetWRefCon (MyWindow, ORD(WindowData)); "WindowData^^.TERecord := hTE; "SetViewRect; "hTE^^.destrect := hTE^^.viewrect; "WindowData^^.changed := FALSE; "WindowData^^.titled := FALSE; "vScroll := GetNewControl(256,MyWindow); "MoveScrollBar; "topline := 0; "hTE^^.clikLoop := ORD(@AutoScroll) END; {------------------------------------------------------------------------------------} PROCEDURE MyGetFile; Var reply: SFReply; $wher: point; $temprect: rect; $tempport:grafptr; $copyIt, foundIt : BOOLEAN; {if the name is already in use, this will be true} $temppeek: Windowpeek; $tempstr, oldfname: str255; $str: str255; $tempdata: MyDataHandle; BEGIN {This calls Standard File to allow the user to choose the document on disk that she wishes to edit.} "IF debug THEN DebugInProc (proc, 'MyGetFile', @MyGetFile); "wher.h := 90; "wher.v := 100; "DialogueDeactivate; "SFGetFile (wher, '', NIL, 1, MyFileTypes, NIL, reply); "WITH Reply DO "IF good THEN "BEGIN ${check to see if this name already resides on a document window. If so, change %the title to 'Copy of ' and remember to check it as untitled? after the readfile} $foundit := FALSE; $oldfname := fname; $REPEAT &temppeek := windowPeek(Frontwindow); ©It := FALSE; &IF temppeek <> NIL THEN &REPEAT (GetWTitle (windowPtr (temppeek), tempstr); (IF tempstr = fname THEN (BEGIN *tempdata := MyDataHandle(temppeek^.refCon); *IF tempdata^^.FileVolume = vrefnum THEN *BEGIN ,copyIt := TRUE; ,foundIt := TRUE *END (END; (temppeek := temppeek^.nextwindow &UNTIL (temppeek = NIL) OR copyIt; &GetIndString (str, 256, 16);{copy of} &IF copyIt THEN fname := Concat (str,fname); $UNTIL NOT copyIt; $IF foundIt THEN $BEGIN &Paramtext (fname,'','',''); ©It := (NoteAlert (258, NIL) = OK) $END; $IF NOT foundIt OR copyIt THEN $BEGIN &MakeAWindow (fname, TRUE); &IF ReadFile (vrefnum, oldfname) &THEN &BEGIN (IF foundIt THEN windowdata^^.titled := FALSE &END &ELSE &BEGIN (TEDispose (hTE); (hTE := NIL; (DisposHandle (Handle (WindowData)); (IF debug THEN Writeln (debugger, 'dispose WindowData; memerr = ', MemError, lf); (DisposeWindow (MyWindow) &END $END "END END; {------------------------------------------------------------------------------------} PROCEDURE OpenAWindow; VAR s: str255; $untitled: Str255; BEGIN {this creates a new window that is untitled and empty.} "IF debug THEN DebugInProc (proc, 'OpenAWindow', @OpenAWindow); "{see if enough mem exists to open a window} "NumToString(windownum, s); "windownum := windownum + 1; "GetIndStr (untitled, 256, 1); "MakeAWindow (Concat (untitled, s), FALSE); END; {$S WRITFILE} {------------------------------------------------------------------------------------} FUNCTION WriteFile (vRefNo: INTEGER; fName : str255) : BOOLEAN; var refNo, io : INTEGER; $txtlength : longint; $errin : str255; {------------------------------------------------------------------------------------} "PROCEDURE DiskWErr (io : INTEGER); "Var str:str255; &writetostr, savedstr, str1: Str255; &dummy, errstr: INTEGER; "BEGIN "{This is just about the same as DiskRErr (read). Since a few more errors can #happen during a write, the structure is just a little different} $IF debug THEN $BEGIN &DebugInProc (proc, 'DiskWErr', @DiskWErr); &Writeln (debugger, errin, ' err = ', io, lf) $END; $GetIndString (writetostr,256,10);{read resource for writeto} $GetIndString (savedstr,256,12);{read resource for saved} $errstr := 0; $Case io of &DskFulErr : errstr := 17; &DirFulErr : errstr := 18; &FLckdErr : errstr := 19; &VLckdErr, WPrErr : errstr := 20; &IOErr : errstr := 21; &OTHERWISE &BEGIN (NumToString (io, str); (GetIndStr (str1,256,22);{ID = } (str := Concat (str1,str) &END $END; $IF errstr <> 0 THEN GetIndStr (str,256,errstr); $Paramtext (writetostr,FName,savedstr,str); $SetCursor (arrow); $dummy := StopAlert (256, NIL); $io := FSClose (refNo); $Exit (writefile) "END; BEGIN {this isn't very different from read file. The only complication is finding out if the file exists. If it doesn't, create it. Also, assign the information that the finder needs to properly associate it with this application.} "IF debug THEN DebugInProc (proc, 'WriteFile', @WriteFile); "SetCursor (watchHdl^^); "WriteFile := FALSE; "io := FSOpen(FName, VRefNo, refNo); {$IFC BUG = 1} "errin := 'FSOpen'; {once again, these only benefit the external debugger.} {$ENDC} "IF debug THEN Writeln (debugger, 'file RefNum =', refNo, lf); "IF io = {file not found Err} -43 THEN "BEGIN $io := Create (FName,VRefNo,'CARY','TEXT'); {$IFC BUG = 1} $errin := 'Create'; {$ENDC} $IF io <> 0 THEN DiskWErr (io); $io := FSOpen(FName, VRefNo, refNo); {$IFC BUG = 1} $errin := 'FSOpen'; {$ENDC} $IF debug THEN Writeln (debugger, 'file RefNum = ', refNo, lf); $IF io <> 0 THEN DiskWErr (io) "END {Create} "ELSE IF io <> 0 THEN DiskWErr (io); "WITH hTE^^ DO "BEGIN $txtLength := teLength; $io := FSWrite (refNo, txtLength, hText^); "END; {$IFC BUG = 1} "errin := 'FSWrite'; {$ENDC} "IF io <> 0 THEN DiskWErr (io); "io := SetEOF (refNo, txtlength); {$IFC BUG = 1} "errin := 'SetEOF'; {$ENDC} IF io <> 0 THEN DiskWErr (io); "io := FSClose (refNo); {$IFC BUG = 1} "errin := 'FSClose'; {$ENDC} "IF io <> 0 THEN DiskWErr (io); "io := FlushVol (NIL, VrefNo); {this is important; without it, if the program died "(not possible as a result of a programming mistake, of course), the directory #information on the disk would not be accurate.} {$IFC BUG = 1} "errin := 'FlushVol'; {$ENDC} "IF io <> 0 THEN DiskWErr (io); "IF not windowdata^^.titled THEN "BEGIN $SetWTitle(MyWindow, FName); $WindowData^^.filevolume := VRefNo "END; "WindowData^^.titled := TRUE; "WindowData^^.changed := FALSE; "WriteFile := TRUE {everything is OK.} END; {------------------------------------------------------------------------------------} FUNCTION MyPutFile (Filename: str255): BOOLEAN; Var reply: SFReply; $wher: point; $Namestr: Str255; $temprect: rect; $tempport:grafptr; BEGIN {The user can select the name of the file that they wish to save the document with.} "IF debug THEN DebugInProc (func, 'MyPutFile', @MyPutFile); "MyPutFile := FALSE; "GetIndStrList (namestr,256,2); "wher.h := 100; "wher.v := 100; "DialogueDeactivate; "SFPutFile (wher, Namestr, Filename, NIL, reply); "WITH Reply DO "BEGIN $IF debug THEN Writeln (debugger, 'reply.good = ', good, lf); $IF good THEN MyPutFile := WriteFile (vrefnum, fname) "END; "IF debug THEN Writeln (debugger, 'release reserror = ', reserror, lf) END; {------------------------------------------------------------------------------------} PROCEDURE CloseAWindow; VAR itemhit: INTEGER; $DBoxPtr: DialogPtr; $str,str1: str255; $Goodwrite: BOOLEAN; $temprect: rect; $NamePtr: ^Str255; $typ: INTEGER; $itemhdl: handle; $box:rect; BEGIN {All sorts of windows can be closed through this single routine, which is accessed by the user through the go-away box on the window, or the Close item in the File menu, or by quitting the program.} "IF debug THEN DebugInProc (proc, 'CloseAWindow', @CloseAWindow); "MyPeek := windowPeek (FrontWindow); "Case Mypeek^.windowkind of "MyDocument : "BEGIN $GetWTitle (MyWindow, str); $itemhit := 0; $IF WindowData^^.changed THEN {give the user the chance to save his data before %you throw it away.} $BEGIN &DialogueDeactivate; &IF doneflag THEN &BEGIN (GetIndStr (str1,256,8); (IF debug THEN Writeln (debugger, 'err = ', Reserror, lf); &END &ELSE str1 := ''; &Paramtext (str,str1,'',''); &ItemHit := CautionAlert (259, NIL) $END; $IF debug THEN Writeln (debugger, 'itemhit = ', itemhit, lf); $Goodwrite := FALSE; $IF NOT windowdata^^.titled THEN str := ''; $IF itemhit = OK {save} THEN &IF WindowData^^.titled &THEN GoodWrite := WriteFile (WindowData^^.FileVolume, str) &ELSE Goodwrite := MyPutFile (str); $IF GoodWrite OR (itemhit IN [0, 3] {discard}) THEN $BEGIN &TEDispose (hTE); &hTE := NIL; &DisposHandle (Handle (WindowData)); &DisposeWindow (MyWindow) $END; $IF itemhit = Cancel THEN doneflag := FALSE "END; "Clipboard : ToggleScrap; {$IFC BUG > -1} "FreeMemory: ToggleFree; {$ENDC} $OTHERWISE CloseDeskAcc (MyPeek^.windowkind) {can't be anything else} "END {Case} END; {$S AboutMyPgm} {------------------------------------------------------------------------------------} PROCEDURE AboutMyEditor; const mousekey = mDownMask+keyDownMask; var str1hdl: stringHandle; $str2: Str255; $MyWindow: WindowPtr; $width, height, counter, strwidth, strdepth, factor, remainder, adjust: INTEGER; $newcount: longint; $txtinfo: fontinfo; $temprect, trect1: rect; $offscreen, tempbits: bitmap; $sz: size; BEGIN {this bit of fluff shows an inadequate method of telling the user something about my program, but it was fun to do.} "IF debug THEN DebugInProc (proc, 'AboutMyEditor', @AboutMyEditor); "DialogueDeactivate; "str1hdl := stringHandle(GetResource('CARY',0)); IF debug THEN Writeln (debugger, 'err = ', Reserror, lf); "GetIndStr (str2,256,3); IF debug THEN Writeln (debugger, 'err = ', Reserror, lf); "HLock (Handle(str1hdl)); "MyWindow := GetNewWindow (256, NIL, Pointer (-1)); "SetPort (MyWindow); "TextFont (NewYork); "TextSize (12); "GetFontInfo (TxtInfo); "width := MyWindow^.portrect.right - MyWindow^.portrect.left; "height := MyWindow^.portrect.bottom - MyWindow^.portrect.top; "strwidth := StringWidth (str1hdl^^); "IF StringWidth (str2) > strwidth THEN strwidth := StringWidth (str2); "WITH TxtInfo DO "BEGIN $strdepth := ascent*2+descent*2+leading+1; $WITH offscreen DO $BEGIN &rowbytes := (strwidth + 15) DIV 16 * 2;{rowbytes needs to be even} &SetRect (bounds, 0,0,strwidth,strdepth); &baseaddr := NewPtrClear (rowbytes * strdepth); &IF debug THEN Writeln (debugger, 'err = ', Memerror, lf); $END; $tempbits := MyWindow^.portbits; $SetPortBits (offscreen); $MoveTo ((strwidth - StringWidth (str1hdl^^)) DIV 2, ascent); $DrawString (str1hdl^^); $MoveTo ((strwidth - StringWidth (str2)) DIV 2, strdepth-descent); $DrawString (str2) "END; "HUnlock (Handle (str1hdl)); "SetPortBits (tempbits); "factor := strwidth DIV strdepth; "remainder := strwidth MOD strdepth; "SetRect (trect1, (width - remainder) DIV 2 - factor, height DIV 2 - 1, $(width + remainder) DIV 2 + factor, height DIV 2 + 1); "counter := 1; "REPEAT $SystemTask; $CopyBits (offscreen, MyWindow^.portbits, offscreen.bounds, trect1, srcCopy, NIL); $InsetRect (trect1, -factor, -1); $counter := counter + 2; "UNTIL EventAvail (mousekey, MyEvent) OR (counter >= strdepth); "newcount := TickCount + 300; {5 seconds} "REPEAT $SystemTask "UNTIL EventAvail (mousekey, MyEvent) OR (TickCount > newcount); "temprect := offscreen.bounds; "OffsetRect (temprect, (width-strwidth) DIV 2, (height-strdepth) DIV 2); "trect1 := offscreen.bounds; "WITH MyWindow^, temprect DO "WHILE NOT EventAvail(mousekey,MyEvent) AND $(trect1.right-factor * 2> trect1.left) DO "BEGIN $SystemTask; {the clock still ticks!} $factor := trect1.right DIV strdepth; $IF left > 0 THEN InsetRect (temprect, -factor, -2) $ELSE IF top > 0 THEN $BEGIN &InsetRect (trect1, factor, 0); &InsetRect (temprect, 0, -2) $END ELSE InsetRect (trect1, factor, 2); $CopyBits (offscreen, portbits, trect1, temprect, srcCopy, NIL); "END; "DisposPtr(offscreen.baseaddr); "IF debug THEN Writeln (debugger, 'err = ', Memerror, lf); "DisposeWindow (MyWindow) END; {$S MyPrint } {------------------------------------------------------------------------------------} PROCEDURE CheckButton; var bool : BOOLEAN; $item : INTEGER; BEGIN "bool := GetNextEvent (mDownMask+keyDownMask, MyEvent); "item := 0; "IF (myEvent.what = keydown) AND (BitAnd (myEvent.message, 255) = 13) "THEN item := 1 "ELSE "IF IsDialogEvent (myEvent) THEN bool := DialogSelect (myEvent, dlogptr, item); "IF item = 1 THEN PrSetError (iPrAbort); END; {------------------------------------------------------------------------------------} PROCEDURE MyPrint(finderFile:INTEGER; filename: str255); Const bottommargin = 20; {amount of space on the margins of the page in pixels} &leftmargin = 30; &rightmargin = 10; Var MyPPort: TPPrPort; $txt: handle; $txtptr: ptr; $pglen, start, finish, counter, count2, loop, io, numpages: INTEGER; $temprect, tmprect2, pagerect: rect; $status: TPrStatus; $userOK, canceldialog: BOOLEAN; $s: string[1]; $str: str255; $numToGo, numdone: str255; $temp: str255; $MyLngth: array [1..99] of INTEGER; BEGIN {For heavyweight programmers only. All modes of printing are handled by Macprint. The only things you have to do are: #image each page, using QuickDraw (or something that uses QuickDraw); #Do it once for the number of copies the user specified in draft mode only. #You do not have to worry with: %copies in normal or high res. %which pages the user chose to print. %tall, wide, etc. "Remember, these Page Setup dialog is printer specific. It will not always be the "same, so don't write any code around it. "The reason this program is heavily segmented is that printing normal or high-res "on line takes gobs of memory (in this example, up to 25K.) You may minimize the "by omitting 1 line below and creating a spooled file instead. "The finderprint boolean determines whether printing is has been selected while the "user is running the application, or whether it was selected from the finder. In the "application, printing is done in the background. From the finder, a simple dialog "is presented instead. Because printing takes a large amount of memory, up to 25K, "background printing is only possible if the memory required by the foreground "process can be kept to a minimum. Since this program does not yet have strong "memory full checking, you should set the debugging compile time variable DEBUG "to -1, and remove MacsBug from the Mac disk, to give the program a realistic amount "of free memory. MacsBug, when active, can use up to 16K. "Printing is not re-entrant. If your main program loop is the print idle proc, "as below, disable the Page Setup item and change 'Print' to 'Stop Printing' "in the File menu.} "IF debug THEN DebugInProc (proc, 'MyPrint', @MyPrint); "printflag := FALSE; "IF debug THEN #writeln (debugger, 'finderPrint =', finderprint, '; finderFile =', finderfile, lf); "userOK := TRUE; "IF finderfile = 1 THEN "BEGIN $SetCursor (arrow); $userOK := PrJobDialog (PrintHdl) "END; "IF userOK THEN "BEGIN ${try to see if enough memory exists to *1) duplicate the text portion of the te record *2) allow the printing pieces to be resident *3) allow the largest possible segment to be loaded by the main event loop *if so, allow the printing to go on in the background. *Otherwise, put up the 'press a button to cancel' dialog} $SetCursor (watchhdl^^); $IF NOT finderprint THEN numfiles := 1; $canceldialog := finderprint; $IF NOT canceldialog THEN $BEGIN &txt := NewHandle (hte^^.telength+16000); &{this calculation should be made considering: *the current font size *the printing mode (draft, normal, hires) *the textstyle overhead, if any *blank segment overhead *largest segment + largest local data *global data overhead --- 16000 is a crude, unprofessional approximation} &IF txt = NIL THEN canceldialog := TRUE &ELSE &BEGIN (disposHandle (txt); (txt := hte^^.hText; (ResrvMem (hte^^.teLength); (io := HandToHand (txt); &END $END; $IF canceldialog THEN $BEGIN &NumToString (finderFile, numToGo); &NumToString (numfiles, numdone); &Paramtext (filename,numToGo,numdone,''); &dlogptr := GetNewDialog (257, NIL, Pointer(-1)); &DrawDialog (dlogptr); &printHdl^^.prJob.pIdleProc := @CheckButton; &txt := hte^^.hText $END $ELSE $BEGIN &GetIndStr (temp,256,15); {change to 'Stop Printing'} &SetItem (myMenus[fileMenu], 8, temp); &printing := TRUE; &printHdl^^.prJob.pIdleProc := @MainEventLoop; &GetPort (printport); {get the port to be restored at the top of the 'main event loop} $END; ${for now, approximate a full page} $MyPPort := PrOpenDoc (PrintHdl, NIL, NIL); $WITH hTE^^, printhdl^^.prinfo DO $BEGIN &pagerect := rpage; &pagerect.left := pagerect.left + leftmargin; &pagerect.right := pagerect.right - rightmargin; &pagerect.bottom := pagerect.bottom - bottommargin &- (pagerect.bottom - bottommargin) MOD lineheight {get rid of partial line}; &temprect := destrect; &destrect := pagerect; &TECalText (hTE) $END; {TECalText could cause the memory manager to move the hTE and PrintHdl %handles. So, the 'WITH' statement is required below; the alternative would %be to use 1 'WITH' and 'HLock' the handles. Note that 'WITH' is much more %than a lexical convenience. It actually causes the compiler to optimize code %about the fields of hTE^^ and printhdl^^.prinfo} $WITH hTE^^, printhdl^^.prinfo DO $BEGIN &tmprect2 := viewrect; &pglen := (rpage.bottom - rpage.top - bottommargin) DIV lineheight; &finish := nlines; &start := 0; &counter := 1; &WHILE start < finish DO &BEGIN (IF finish - start > pglen (THEN MyLngth[counter] := linestarts[start + pglen] - linestarts[start] (ELSE MyLngth[counter] := teLength - linestarts[start]; IF debug THEN BEGIN "Writeln (debugger,'MyLngth[',counter:1,'] = ', MyLngth[counter]:5, '; start = ', start:5, '; pglen = ', pglen:5, lf); "Writeln (debugger, 'finish = ', finish:5, '; teLength = ', teLength:5, '; ORD(txt) = ', ord4(txt),lf) END; (start := start + pglen; (counter := counter + 1; &END; {While start < finish} &numpages := counter - 1; &IF NOT finderprint THEN &BEGIN (destrect := temprect; (TECalText (hTE) &END $END; $IF debug THEN Writeln (debugger,'BJDocLoop = ', PrintHdl^^.prjob.BJDocLoop,lf); $IF PrintHdl^^.prjob.BJDocLoop = BSpoolLoop $THEN loop := 1 $ELSE loop := PrintHdl^^.prjob.iCopies; $SetPort (GrafPtr(MyPPort)); $TextFont (applFont); $DrawChar (' '); SetFontLock (TRUE); $IF PrintHdl^^.prjob.BJDocLoop <> BSpoolLoop THEN SetCursor (arrow); $FOR counter := 1 to loop DO $BEGIN &Hlock (txt); &txtptr := txt^; &FOR count2 := 1 to numpages DO &BEGIN {if background printing, duplicate txt handle before starting} (PrOpenPage (MyPPort, NIL); (TextBox (txtptr, MyLngth[count2], pagerect, teJustLeft); (PrClosePage (MyPPort); (txtptr := Pointer (ORD4(txtptr) + MyLngth[count2]); (start := start + pglen &END; {For count2} &HUnlock (txt); $END; {For counter} $PrCloseDoc (MyPPort); $IF PrintHdl^^.prjob.BJDocLoop = BSpoolLoop THEN $BEGIN 'SetCursor (arrow); 'PRPicFile (Printhdl, NIL, NIL, NIL, status) {omit this for spooled files.} $END; $IF canceldialog THEN DisposDialog (dlogptr) $ELSE $BEGIN &disposHandle (txt); &printing := FALSE; &GetIndString (temp,256,14); {change to 'Print'} &SetItem (myMenus[fileMenu], 8, temp); &SetPort (printport) $END "END END; {$S EditMenu} {------------------------------------------------------------------------------------} Procedure EditMain (theItem: INTEGER; commandkey : BOOLEAN); const undo = 1; &cut = 3; &kopy = 4; {'Copy' is a Pascal string function} &paste = 5; &clear = 6; &selectAll = 7; &clipbored = 9; {'ClipBoard' is already used as a windowkind constant} VAR DeskAccUp , dummy: BOOLEAN; $Dscrap: PScrapStuff; $off: LongInt; $ticks: LongInt; $tempport: grafptr; $box: rect; $itemhdl, hdl: handle; $typ, io, tempstart, tempend: INTEGER; $tempptr: ptr; $TextLength: INTEGER; $Ptr2ScrapLength: LomemPtr; $topwindow: WindowPeek; BEGIN {Since the Edit menu does so much, it has been broken up into a separate procedure. It does not yet support undo, but does support Cutting, Copying and Pasting between the Desk Scrap and the TextEdit Scrap.} "DeskAccUp := FALSE; "IF (theItem < selectAll) and NOT CommandKey THEN DeskAccUp := SystemEdit(theItem-1); "topwindow := WindowPeek(FrontWindow); "IF (theItem > Clear) OR NOT DeskAccUp THEN "BEGIN $IF theItem in [cut, kopy] THEN $BEGIN 'tempend := hTE^^.selend; 'tempstart := hte^^.selstart $END; $IF debug THEN Writeln (debugger, 'not system edit', lf); ${ Delay so menu title will stay lit a little only if Command key } ${ equivalent was typed. } $IF commandkey THEN $BEGIN &ticks := TickCount + 10; &REPEAT UNTIL ticks <= TickCount $END; {** see if enough memory exists for move} $CASE theItem OF $undo: ; { no Undo/Z in this example } $cut: TECut(hTE); { Cut/X } $kopy: TECopy(hTE); { Copy/C } $paste: &BEGIN { Paste/V } (DScrap := InfoScrap; (IF DScrap^.scrapState <> LastPaste THEN (BEGIN *LastPaste := DScrap^.scrapState; *io := GetScrap (NIL, 'TEXT', off); *IF debug THEN Writeln (debugger, 'io = ', io); *IF io > 0 THEN {**?? enough space to paste} *BEGIN ,io := GetScrap (TEScrapHandle, 'TEXT', off); ,Ptr2ScrapLength := LomemPtr ($AB0); ,Ptr2ScrapLength^ := BitShift (io, 16);{***???***} *END (END; (TEPaste(hTE); &END; $clear: TEDelete(hTE); { Clear } $selectall: TeSetSelect(0,65535,hTE); { Select All/A } $clipbored: ToggleScrap { Show, Hide Clipboard } $END; { of item case } $IF theItem in [cut,kopy] THEN $BEGIN &io := ZeroScrap; &IF debug THEN Writeln (debugger, 'zero scrap err =', io, lf); &TextLength := GetHandleSize (TEScrapHandle); &IF debug THEN Writeln (debugger, 'TEScrapHandle @',ORD4(TEScrapHandle^),'; TextLength = ',textlength,lf); &Hlock (TEScrapHandle); &io := PutScrap (TextLength, 'TEXT', TEScrapHandle^); &IF debug THEN Writeln (debugger, 'put scrap err =', io, lf); &HUnlock (TEScrapHandle) $END; $IF theItem in [cut,clear,paste] THEN Windowdata^^.changed := TRUE; $IF (theItem in [cut..clear]) THEN ScrollText (TRUE) "END {not systemedit} END; { of editMain } {$S Command } {------------------------------------------------------------------------------------} PROCEDURE MyDisable; "const newitem = 1; (openitem = 2; (closeitem = 3; (saveitem = 4; (saveasitem = 5; (revertitem = 6; (pagesetupitem = 7; (printitem = 8; (quititem = 9; (undoitem = 1; (cutitem = 3; (copyitem = 4; (pasteitem = 5; (clearitem = 6; (selectallitem = 7; (clipboreditem = 9; var counter: INTEGER; $DScrap: PScrapStuff; $temppeek: windowpeek; $stycount: styleitem; $off : LongInt; {------------------------------------------------------------------------------------} "PROCEDURE KillFE (fileitems, edititems : edset); "var counter : INTEGER; "BEGIN {This guy disables the items in the File and Edit menus. This approach has a real disadvantage: If an entire menu should be disabled at some given time, there is no convenient way to do a DrawMenuBar here to disable the item in the bar itself.} $IF debug THEN $BEGIN &DebugInProc (proc, 'KillFE', @KillFE); &Write (debugger, 'file:'); &FOR counter := newitem to quititem DO 'IF counter in fileitems THEN Write (debugger, counter:2, ','); &Write (debugger, '; edit:'); &FOR counter := undoitem to clipboreditem DO 'IF counter in edititems THEN Write (debugger, counter:2, ','); &Writeln (debugger, lf) $END; $FOR counter := 1 to 9 DO $BEGIN &IF counter in fileitems THEN DisableItem (myMenus[FileMenu], counter); &IF counter in edititems THEN DisableItem (myMenus[EditMenu], counter); $END "END; BEGIN {This part goes through all of the applicable elements of the frontmost window, if any and from that decides what operations are allowable at this time.} "IF debug THEN DebugInProc (proc, 'MyDisable', @MyDisable); "FOR counter := 1 to 9 DO "BEGIN $EnableItem (myMenus[FileMenu], counter); $IF counter in [UndoItem,CutItem..SelectAllItem,ClipboredItem] &THEN EnableItem (myMenus[EditMenu], counter) "END; "IF printing THEN KillFE ([PageSetupItem],[]); {page setup, if printing} "IF Frontwindow = Nil "THEN KillFE ([CloseItem..PrintItem],[UndoItem..SelectAllItem]) "ELSE "BEGIN $Mypeek := windowPeek (FrontWindow); $Case Mypeek^.windowkind of $MyDocument: BEGIN *KillFE ([], [UndoItem]); *IF NOT WindowData^^.titled THEN KillFE ([SaveItem,RevertItem], []); *IF NOT WindowData^^.changed THEN KillFE ([SaveItem,RevertItem], []); *IF hTE^^.teLength = 0 THEN ,KillFE ([SaveItem,SaveAsItem,PageSetupItem,PrintItem], [SelectAllItem]); *IF hTE^^.selstart = hTE^^.selend THEN ,KillFE ([], [CutItem,CopyItem,ClearItem]); *IF GetScrap (NIL, 'TEXT', off) = noTypeErr THEN KillFE ([], [PasteItem]); (END; $Clipboard,FreeMemory: KillFE ([SaveItem..PrintItem], [UndoItem, CutItem..SelectAllItem]); &OTHERWISE KillFE ([SaveItem..PrintItem], [SelectAllItem]) {system window} $END {Case} "END; "IF printing THEN EnableItem (MyMenus[filemenu], PrintItem) {stop printing} END; {------------------------------------------------------------------------------------} PROCEDURE DoCommand (commandkey: BOOLEAN); VAR name, s, str: str255; $bstr: string[5]; $dummy: size; $err : BOOLEAN; $num, refnum, theMenu, theItem: INTEGER; $tempPeek: WindowPeek; $mresult, ticks: longint; $dipeek: DialogPeek; $box: rect; $itemhdl: handle; $typ: INTEGER; $menuStuff: RECORD CASE INTEGER OF &1 : (menuResult : LONGINT); {Information returned by MenuSelect} &2 : (theMenu, {Which menu was selected} +theItem : INTEGER) {Which item within the menu} $END; BEGIN {This handles the actions that are initiated through the Menu Manager} "IF debug THEN DebugInProc (proc, 'DoCommand', @DoCommand); "MyDisable; "WITH menuStuff DO "BEGIN $IF Commandkey $THEN menuResult := MenuKey(theChar) $ELSE menuResult := MenuSelect (myEvent.where); $CASE theMenu OF &appleMenu: {enough memory to allow desk accessory to open} &BEGIN (IF theItem = 1 (THEN AboutMyEditor (ELSE (BEGIN *GetItem(myMenus[appleMenu],theItem,name); *refNum := OpenDeskAcc(name) (END &END; &FileMenu: &BEGIN (IF FrontWindow <> NIL THEN )IF MyPeek^.WindowKind = MyDocument THEN +IF windowdata^^.titled +THEN GetWTitle (FrontWindow, str) +ELSE str := ''; (Case TheItem of *1: OpenAWindow; { New } *2: MyGetFile; { Open } *3: CloseAWindow; { Close } *4: err := { Save } 0WriteFile (windowdata^^.FileVolume, str); *5: err := MyPutFile (str); { Save As } *6: BEGIN { Revert to Saved } 0IF CautionAlert(257, NIL)=OK THEN 2err := ReadFile (windowdata^^.FileVolume, str); 0ScrollText (FALSE) {which is the user interfacy thing to do? Edisplay the top of the file, or display Ethe position in the file the user was looking @ Ewhen he said revert. Should I also maintain the Eflashing caret position?} .END; *7: BEGIN 0PrOpen; 0IF PrStlDialog (PrintHdl) { Page Setup } 0THEN ; 0PrClose .END; 0{eventually, store info in document resource fork} *8: IF NOT printing { Print } .THEN Printflag := TRUE .ELSE PrSetError(iPrAbort); *9: doneFlag := TRUE; { Quit } (END &END; $EditMenu: EditMain (theItem, commandkey); "{$IFC BUG > -1} $100: &Case theItem OF &1: ToggleFree; &2: dummy := MaxMem (dummy); "{$IFC BUG = 1} &3: BEGIN ,debug := NOT debug; ,CheckItem (MyMenus[DebugMenu], 3, debug) *END "{$ENDC} &END { of debug } "{$ENDC} $END; { of menu case } $HiliteMenu(0) "END END; { of DoCommand } {------------------------------------------------------------------------------------} PROCEDURE DrawWindow; VAR tempPort : GrafPtr; $tempscrap: handle; $scraplength, off: longint; $temprect, rectToErase: rect; $str: str255; $tempPeek: WindowPeek; $whichwindow: windowptr; $temphTE: TEHandle; $tempdata: mydatahandle; BEGIN { Draws the content region of the given window, after erasing whatever "was there before. } "IF debug THEN DebugInProc (proc, 'DrawWindow', @DrawWindow); "WhichWindow := WindowPtr (MyEvent.message); "BeginUpdate(WhichWindow); "GetPort (tempPort); "SetPort (WhichWindow); "tempPeek := WindowPeek (WhichWindow); "Case tempPeek^.windowkind of "MyDocument : $BEGIN &temprect := WhichWindow^.portrect; &tempData := MyDataHandle (GetWRefCon (WhichWindow)); &temphTE := tempData^^.TERecord; &IF tempPeek^.hilited THEN temprect.top := temprect.bottom - 15; &temprect.left := temprect.right - 15; &ClipRect (temprect); &DrawGrowIcon(WhichWindow); &Cliprect (WhichWindow^.portrect); &DrawControls (WhichWindow); &{this only erases the window past the end of text, if any} &WITH temphTE^^ DO &IF nlines - topline < (viewrect.bottom - viewrect.top + lineheight) 'DIV lineheight THEN &BEGIN (rectToErase := viewrect; (rectToErase.top := (nlines - topline) * lineheight; (EraseRect (rectToErase) &END; &TEUpdate(WhichWindow^.visRgn^^.rgnBBox, temphTE) $END; "ClipBoard : "BEGIN $tempscrap := NewHandle (0); $ScrapLength := GetScrap (tempscrap, 'TEXT', off); $EraseRect (WhichWindow^.portrect); $temprect := Whichwindow^.portrect; $temprect.left := temprect.left + 4; $temprect.right := temprect.right-15; $IF ScrapLength > 0 THEN $BEGIN &HLock (tempScrap); &Textbox (tempscrap^, scrapLength, temprect, teJustLeft); &HUnlock (tempScrap) $END; $DisposHandle (tempscrap); $temprect := WhichWindow^.portrect; $temprect.left := temprect.right - 15; $ClipRect (temprect); $DrawGrowIcon (WhichWindow); $ClipRect (whichwindow^.portrect) "END; {$IFC BUG > -1} "FreeMemory: $BEGIN &EraseRect(whichwindow^.portrect); &MoveTo (5, 12); &Write (FreeMem); $END; {$ENDC} "END; {Case} "SetPort (tempPort); "EndUpdate(WhichWindow) END; { of DrawWindow } {$S CONTROL} {------------------------------------------------------------------------------------} PROCEDURE ScrollBits; VAR oldvert: INTEGER; BEGIN {If the visible information has changed, scroll the window here.} "IF debug THEN DebugInProc (proc, 'ScrollBits', @ScrollBits); "oldvert := topline; "topline := GetCtlValue(vScroll); "TEScroll (0, (oldvert - topline)*hTE^^.lineheight, hTE) END; {------------------------------------------------------------------------------------} PROCEDURE TrackScroll(theControl: ControlHandle; partCode: INTEGER); {This routine adjusts the value of the scrollbar.} Var amount, StartValue : INTEGER; $up : BOOLEAN; BEGIN "up := partcode IN [inUpButton, inPageUp]; {TRUE if scrolling page up} "StartValue := GetCtlValue (theControl); {the initial control value} "IF {the scrollbar value is decreased, and it is not already at the minimum} %((up AND (StartValue > GetCtlMin (theControl))) "OR {the scrollbar value is increased, and it is not already at the maximum} %((NOT up) AND (StartValue < GetCtlMax (theControl)))) "AND {to prevent tracking as the page up or down area disappears} %(whichpart = partCode) "THEN "BEGIN $IF up THEN amount := -1 ELSE amount := 1; {set the direction} $IF partCode IN [inPageUp, inPageDown] THEN {change the movement to a full page} $WITH HTE^^.viewrect DO &amount := amount * (bottom - top) DIV hTE^^.lineheight; $SetCtlValue(theControl, StartValue+amount); $ScrollBits "END END; {of TrackScroll} {------------------------------------------------------------------------------------} PROCEDURE MyControls; Var t, code: INTEGER; $AControl: ControlHandle; $dummy: INTEGER; BEGIN {controls} {This routine handles the scrollbar} "IF debug THEN DebugInProc (proc, 'MyControls', @MyControls); "whichPart := FindControl (MyPoint, MyWindow, AControl); IF debug THEN Writeln (debugger, 'whichpart = ', whichpart, lf); IF debug THEN Writeln (debugger, 'ORD( AControl = ', ORD ( AControl), lf); "{adjust scrollbar range} "IF AControl <> NIL THEN "BEGIN $VScroll := AControl; $IF whichPart = inThumb THEN $BEGIN &dummy := TrackControl (VScroll, MyPoint, NIL); &ScrollBits $END {of whichpart} $ELSE dummy := TrackControl (VScroll, MyPoint, @TrackScroll) "END {AControl <> NIL} END; {controls} {$S Initial } {------------------------------------------------------------------------------------} PROCEDURE SetUp; VAR counter, vRefNum : INTEGER; $DScrap : PScrapStuff; $hdl, hAppparms : handle; $off : longint; $apName : Str255; $NameHdl : Handle; $strhdl : StringHandle; $dummyrect : rect; $dummy : BOOLEAN; $FinderFile : INTEGER; $myport : GrafPtr; $message : INTEGER; $document : appFile; $temprgn: rgnhandle; $extdebug: Str255; BEGIN {Initialization for a variety of things is done here. This code is 'discarded' after it is executed by an UnLoadSeg. Another good way of initializing a large number of variables would be to create a custom resource which contains initial values for all globals. Then, if the globals are fields in a handle, a single 'GetResource' would initialize all fields.} "InitFonts; {I need fonts} "FlushEvents(everyEvent,0); {start with a clean slate} "TEInit; {I need TextEdit} "InitDialogs(NIL); {and I need dialogs, even when printing from Finder} "PrintHdl := THPrint (NewHandle (SizeOf(TPrint))); "PrOpen; "PrintDefault (PrintHdl); "getAppParms(apName,vRefNum,hAppParms); "{** one day, get file info for apName, to use folder info as appropriate} "iBeamHdl := GetCursor(IBeamCursor); "HNoPurge (Handle(iBeamHdl));{???} "watchHdl := GetCursor(WatchCursor); "HNoPurge (Handle(watchHdl));{???} "CountAppFiles(message, numfiles); "IF debug THEN Writeln (debugger, 'numfiles=',numfiles,lf); "finderprint := (message = 1); "IF finderprint {User selected 'print' from the Finder} THEN "BEGIN $GetWMgrPort (myPort); $SetPort (myPort); $temprgn := NewRgn; $GetClip (temprgn); $dummyrect := screenbits.bounds; $dummyrect.bottom := dummyrect.top + 16; $ClipRect (dummyrect); $TextBox (pointer(ORD(@apName)+1),ORD(Length(apName)),dummyrect,teJustCenter); $SetClip (temprgn); $DisposeRgn (temprgn); $FOR FinderFile := 1 to numfiles DO $BEGIN &GetAppFiles(FinderFile, document); &WITH document DO &IF ftype = 'TEXT' THEN &BEGIN (dummyrect := screenbits.bounds; (dummyrect.bottom := dummyrect.top + 16; (InsetRect (dummyrect,10,2); (SetPort (myPort); {to allow text measure in TeCalText} (hTE := TENew(dummyrect, dummyrect); (dummy := ReadFile (vRefNum, fName); {assume that page setup is read in as well} (Unloadseg (@ReadFile); (MyPrint(FinderFile, fName); (SetCursor (watchhdl^^); (TEDispose (hTE); {dispose of text edit stuff} (ClrAppFiles (FinderFile) &END $END; $hTE := NIL; $PrClose "END "ELSE "BEGIN $PrClose; $InitMenus; { initialize Menu Manager } $myMenus[appleMenu] := GetMenu(appleMenu); $AddResMenu(myMenus[1],'DRVR'); { desk accessories } $FOR counter := FileMenu to EditMenu DO myMenus[counter] := GetMenu(counter); "{$IFC BUG > -1} $myMenus[DebugMenu] := GetMenu(100); { temporary debug menu } "{$ENDC} "{$IFC BUG = 1} $GetIndStr (extdebug,257,1); $AppendMenu (myMenus[DebugMenu], extdebug); $CheckItem (MyMenus[DebugMenu], 3, debug); "{$ENDC} $FOR counter:=1 TO lastMenu DO InsertMenu(myMenus[counter],0); $DrawMenuBar; $dragRect := screenbits.bounds; $dragrect.top := dragrect.top + 20; {leave room for menu bar} $growRect := dragRect; $InsetRect (dragrect, 4, 4); {leave some of dragged rectangle on screen} $growrect.left := {replace this with the max font width + constant} 80; $growrect.top := 80 {18 + 16*3 + slop?}; $doneFlag := FALSE; $printflag := FALSE; $printing := FALSE; $windownum := 1; $windowpos := 0; $MyFileTypes[0] := 'TEXT'; $DScrap := InfoScrap; $LastCount := DScrap^.scrapCount - 1; $LastPaste := LastCount; $Scrapwind := NIL; $FOR counter := 1 to numfiles DO $BEGIN &GetAppFiles (counter, document); &WITH document DO &IF ftype = 'TEXT' THEN &BEGIN (MakeAWindow (fName, TRUE); {**could async open while this is going on} (IF counter < numfiles THEN DialogueDeactivate; (IF NOT ReadFile (vRefNum, fName) THEN (BEGIN *TEDispose (hTE); *hTE := NIL; *DisposHandle (Handle (WindowData)); *DisposeWindow (MyWindow) (END &END $END; $IF Frontwindow = NIL THEN OpenaWindow; "{$IFC BUG > -1} $Freewind := NIL "{$ENDC} "END END; { of SetUp} {$S } {------------------------------------------------------------------------------------} PROCEDURE CursorAdjust; VAR mousePt: Point; $tempport: grafptr; $temppeek: Windowpeek; BEGIN { Take care of application tasks which should be executed when the machine has "nothing else to do, like changing the cursor from an arrow to an I-Beam when it "is over text that can be edited. } {$IFC BUG >-1} { If the amount of free memory is being displayed in its own window, and if it has "changed, then create an update event so that the correct value will be displayed.} "IF (FreeWind <> NIL) "AND (FreeMem <> OldMem) THEN "BEGIN $OldMem := FreeMem; $GetPort (tempport); $SetPort (FreeWind); $InvalRect (FreeWind^.portrect); $SetPort (tempport) "END; {$ENDC} "GetMouse(mousePt); {where the cursor is, currently (local to the topmost window)} "IF hTE <> NIL {if text edit is currently active, (document window is topmost)} "THEN "BEGIN $TEIdle (hTE); $IF (PtInRect(mousePt, hTE^^.viewrect)) {In the text edit viewrect area,} $THEN SetCursor(iBeamHdl^^) { make the cursor an I-beam.} $ELSE SetCursor(arrow) "END "ELSE "BEGIN ${let desk accessories set their own?} $temppeek := windowPeek(FrontWindow); $IF temppeek = NIL THEN SetCursor (arrow) $ELSE IF temppeek^.windowkind > 1 THEN SetCursor (Arrow) "END END; {------------------------------------------------------------------------------------} FUNCTION MyGrowZone; BEGIN {This function is called by the memory manager whenever more memory is requested than available. The only time you'll see it in this program is when it initally runs (which is normal) and when it is not checking memory availability when it should. Your program should not rely on resolving memory problems here, because it could be called by the ROM, where, at present, insufficient memory cases are not always handled gracefully.} "IF GZCritical THEN "BEGIN $IF debug THEN Writeln (debugger, 'myGrow cbneeded = ', cbneeded, lf); ${Make all data stuctures, including user data, that can be safely released, %purgable. If the user has data in memory that has not yet been saved, and if %you were not expecting this routine to be called, then the call came from ROM %and is important to give the user the chance to save their work. Even if %their data is successfully saved, it is likely that the program will have to %restart or quit to the Finder.} ${could unload segment EditMain and others? Zero scrap?} $SetFontLock (FALSE); {at least let go of the application font} "END; "MyGrowZone := 0 {for now, the memory requests fails unconditionally} END; {------------------------------------------------------------------------------------} PROCEDURE MainEventLoop; Var code: INTEGER; {the type of mousedown event} $dummy: BOOLEAN; $str : str255; $tempport : Grafptr; $DScrap: PScrapstuff; BEGIN {This event loop handles most of the communications between this program and events taking place in the outside world. This procedure is also called as the printer idle procedure so that the program appears to be doing background printing.} "IF printing THEN "BEGIN $getport (tempport); $setport (printport) "END; "REPEAT $CursorAdjust; $SystemTask; {See if a desk accessory has changed the scrap. If so, create an update event to redraw the clipboard.} $DScrap := InfoScrap; $IF (DScrap^.scrapCount <> LastCount) AND (ScrapWind <> NIL) THEN $BEGIN &LastCount := DScrap^.scrapCount; &Getport (tempport); &Setport (scrapwind); &InvalRect (scrapwind^.portrect); &Setport (tempport) $END; $IF printflag THEN $BEGIN &GetWTitle (MyWindow, str); &PrOpen; &Myprint(1, str); {number of files to print, what to call it} &PrClose $END; $IF GetNextEvent(everyEvent,myEvent) THEN $CASE myEvent.what OF $mouseDown: &BEGIN (code := FindWindow(myEvent.where,tempWindow); (CASE code OF *inMenuBar: DoCommand(FALSE); *inSysWindow: SystemClick(myEvent,tempWindow); *inDrag: DragWindow(tempWindow,myEvent.where,dragRect); *inGoAway: IF TrackGoAway(tempWindow,myEvent.where) THEN CloseAWindow; *inGrow: IF Mypeek^.windowkind in [MyDocument,Clipboard] THEN GrowWnd; *inContent: ,BEGIN .IF tempWindow <> FrontWindow .THEN SelectWindow (tempWindow) .ELSE .IF hTE <> NIL THEN .BEGIN 0MyPoint := MyEvent.where; 0GlobalToLocal (MyPoint); 0IF PtInRect (MyPoint, hTE^^.viewrect) 0THEN 0BEGIN 2IF debug THEN Writeln (debugger, 'point in HTE viewrect', lf); 2IF (BitAnd (myEvent.modifiers, ShiftKey) <> 0 ) { Shift key pressed } 2THEN TEClick (MyPoint, TRUE, hTE) 2ELSE TEClick (MyPoint, FALSE, hTE); 0END 0ELSE MyControls .END { hTE <> NIL } ,END { in Content } *END { of code case } (END; { of mouseDown } &keyDown, autoKey: (BEGIN *theChar := CHR(BitAnd(myEvent.message,255)); { Mac characters use 8 bits } *IF BitAnd(myEvent.modifiers,CmdKey) <> 0 { Command key pressed } *THEN DoCommand(TRUE) *ELSE IF hTE <> NIL THEN *BEGIN ,TEKey(theChar,hTE); ,windowdata^^.changed := TRUE; ,ScrollText (TRUE); *END (END; { of keyDown } &activateEvt: MyActivate; &updateEvt: DrawWindow; $END { of event case } $ELSE &IF (Myevent.what = nullEvent) AND doneflag AND (FrontWindow <> NIL) &THEN CloseAWindow; $UnloadSeg (@ScrollText); {segment Utilities} $UnloadSeg (@ReadFile); {segment ReadFile} $UnloadSeg (@WriteFile); {segment WritFile} $UnloadSeg (@AboutMyEditor); {segment AboutMyPgm} $UnloadSeg (@DoCommand); {segment DoCommand} $UnloadSeg (@EditMain); {segment EditMenu} $UnloadSeg (@MyControls); {segment Control} $IF NOT printing THEN UnloadSeg (@MyPrint); "UNTIL (doneFlag AND (FrontWindow = NIL)) OR Printing; "IF doneFlag AND (FrontWindow = NIL) THEN "BEGIN $ClearMenuBar; {prevent the user from doing anything until printing is through} $DrawMenuBar; $SetCursor (watchhdl^^) "END; "IF printing THEN "BEGIN $getport (printport); $setport (tempport) "END END; BEGIN { main program } {Some things need to be set up outside of the initialization segment, to allow the nonrelocatable objects that they create to be located as low in memory as possible.} {$IFC BUG = 1} {This code is only included for external terminal debugging} "debug := FALSE;{if you want debugging on as soon as the program starts, set it here} "Reset (debugger, '.BOUT'); {the serial port not used for downloading from Lisa} {$ENDC} "IF debug THEN "BEGIN $Writeln (debugger, lf, lf); $DebugInProc (proc, 'SetUp', @Setup) "END; {The program only executes the code when it is first run, but it could have gotten here in two ways. The user may have opened the application or one of its documents, or the user may have chosen to print a document. In any case, some common initialization is needed.} "SetGrowZone (@MyGrowZone); {just in case something goes wrong..} {The application needs to grow the heap to the maximum size, but does not want to purge any of the preloaded resources. This also is an example of how to examine low memory locations from Pascal.} "applLimit := LomemPtr($130); "heapEnd := LomemPtr($114); "dummy := NewHandle (applLimit^-heapEnd^-1024); "DisposHandle (dummy); "MoreMasters; MoreMasters; MoreMasters; "InitGraf(@thePort); {I need QuickDraw} "InitWindows; {I need windows} "SetUp; "UnloadSeg (@Setup); "IF NOT finderprint THEN MainEventLoop; "SetCursor (watchHdl^^); END. 3. "6F^5D!$ǐ^N^'^'l; Example/FileAsm ; an example of how to call assembly from Pascal, and Pascal from assembly ; ; MODIFICATION HISTORY ; ; 06-Feb-84 CRC New Today ; 26-Jun-84 CRC Changed to use AutoScroll to use Pascal proc TrackScroll ; NewPtrClear stolen from Rony Sebok's "NewPtr" in OSTraps ; ;----------------------------------------------------------------------------------- ; ; Procedure AutoScroll; ; ; The location of this procedure is passed to TextEdit in the clikLoop field. ; It is called by TextEdit when the user drags a selection range outside of the ; viewrect. This calls the pascal procedures TrackScroll to cause the screen to ; scroll, if possible, and the selection range to be extended. ; ;----------------------------------------------------------------------------------- ; 0.NOLIST 0.INCLUDE TlAsm/GrafTypes.Text 0.INCLUDE TlAsm/QuickMacs.Text 0.INCLUDE TlAsm/SysEqu.Text 0.INCLUDE TlAsm/SysMacs.Text 0.INCLUDE TlAsm/ToolEqu.Text 0.INCLUDE TlAsm/ToolMacs.Text 0.LIST 0.PROC AutoScroll,0 ;offsets for Pascal globals MyWindow .EQU -4 ;offset for current application window VScroll .EQU -20 ;the window's vertical scroll bar whichPart .EQU -22 ;the last button pushed 0.REF TrackScroll ;Get the mouse location to see if scrolling is required 0PEA temppoint 0_GetMouse ;get local mouse point to D0 0MOVE.W temppoint,D0 ;Check if we're in the text rect. TextEdit passes the currently edited record in A3. 0LEA Condition,A0 ;a place to store the condition code 0CMP.W TEViewRect+Top(A3),D0 ;compare with the viewrect top 0BLT.S OutOfRect ;branch if mouse moves above top 0CMP.W TEViewRect+Bottom(A3),D0 ;is mouse below the bottom? 0BLE.S NoMove ;no, don't scroll. ;TextEdit sets the clip region to the viewrect. To allow the scrollbar to be redrawn, ;the clip is set to the entire window. OutOfRect MOVE SR,(A0) ;save whether outside top, bottom 0MOVE.L MyWindow(A5),A0 ;global MyWindowPtr 0PEA PortRect(A0) ;global MyWindowPtr^.portrect 0_ClipRect ;set the application's clip 0MOVE.L VScroll(A5),-(SP) ;push handle for scroll, below ;now scroll up or down 0MOVE Condition,CCR ;get back top or bottom condition 0BLT.S OffTop ;We're off the bottom. Act as if the user is pressing scrollbar's down arrow 0MOVE.W #inDownButton,-(SP) ;scroll down. 0BRA.S OT2 ;go scroll it ;We're off the top. Do a scroll Up. OffTop MOVE.W #inUpButton,-(SP) ;Scroll up. OT2 MOVE.W (SP), whichPart(A5) ;satisfy TrackScroll condition 0JSR TrackScroll ;Pascal routine. 0PEA TEViewRect(A3) 0_ClipRect ;restore TextEdit's clip region ;a non-zero code returned in DO tells TextEdit to stay in the TEClick routine. NoMove MOVEQ #-1,D0 ;return non-zero to stay in TEClick 0RTS Condition temppoint .LONG 0 ;----------------------------------------------------------------------------------- ; ; Function NewPtrClear(byteCount: Size): Ptr; ; ; Returns a pointer to a newly allocated non-relocatable block of memory byteCount ; bytes long. NewPtr will set the area of memory reserved by it to zero if the ; 'clear' bit in the NewPtr trap is set. NewHandle has a 'clear' bit as well. ; ;----------------------------------------------------------------------------------- 0.FUNC NewPtrClear 0.REF SaveRetA1 0Move.L (SP)+,A1 ;get return address 0Move.L (SP)+,D0 ;get the byte count 0_NewPtr ,CLEAR ;ask OS to do request 0Move.L A0,(SP) ;return result ptr on stack 0JMP SaveRetA1 ;save result code and return via A1 0.END 3. "6F^5D!$ǐ^C۔* FileResDef -- Resource input for sample application named File * Written by Macintosh User Education Example/File.Rsrc Type CARY = STR ,0 (32) File, by Cary Clark Version 1.0 July 3, 1984 Type FREF ,128 APPL 0 ,129 TEXT 1 Type BNDL ,128 CARY 0 2 ICN# 2 0 128 1 129 FREF 2 0 128 1 129 Type ICN# ,128 2 00000000 00000000 00000000 00020000 00050000 00088038 00104044 00202082 00401102 00800A82 01000544 02000AA8 04001550 08002AA0 10005540 2000AAA0 40001510 80010A08 40000410 20030820 1003A040 08038080 04000100 02000200 01000400 00800800 00401000 00202000 00104000 00088000 00050000 00020000 00000000 00000000 00000000 00020000 00070000 000F8038 001FC07C 003FE0FE 007FF1FE 00FFFBFE 01FFFFFC 03FFFFF8 07FFFFF0 0FFFFFE0 1FFFFFC0 3FFFFFE0 7FFFFFF0 FFFFFFF8 7FFFFFF0 3FFFFFE0 1FFFFFC0 0FFFFF80 07FFFF00 03FFFE00 01FFFC00 00FFF800 007FF000 003FE000 001FC000 000F8000 00070000 00020000 ,129 2 0FFFF800 08000400 08000600 08000500 08000480 08000438 08000444 08000682 08000102 08000282 08000544 08000AA8 08001550 08002AA0 08005550 0800AA90 08001510 08010A10 08000410 08030810 0803A010 08038010 08000010 08000010 08000010 08000010 08000010 08000010 08000010 08000010 08000010 0FFFFFF0 0FFFF800 0FFFFC00 0FFFFE00 0FFFFF00 0FFFFF80 0FFFFFF8 0FFFFFFC 0FFFFFFE 0FFFFFFE 0FFFFFFE 0FFFFFFC 0FFFFFF8 0FFFFFF0 0FFFFFE0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 0FFFFFF0 Type MENU ",1 (4) "\14 $About File $(- ",2 (4) "File $New $Open $Close $Save $Save As $Revert to Saved $Page Setup $Print $Quit ",3 (4) "Edit $Undo/Z $(- $Cut/X $Copy/C $Paste/V $Clear $Select All/A $(- $Show Clipboard ",100 (4) "Debug $Show FreeMem $Compact Memory * document window Type WIND ",256 (32) x "50 30 158 482 "Visible NoGoAway "2 "0 ",257 (32) Clipboard "262 4 337 446 "Visible GoAway "0 "0 ",258 (32) FreeMem "320 442 339 511 "Visible NoGoAway "0 "0 * vertical scroll bar Type CNTL ",256 (4) x "-1 395 236 411 "invisible "16 "0 "0 0 0 Type DITL ",256 (32) "4 $BtnItem Enabled $65 13 85 83 Yes $BtnItem Enabled $95 300 115 370 Cancel $BtnItem Enabled $95 13 115 83 No $StatText Disabled $8 60 60 370 Do you want to save changes made to '^0'^1? ",257 (32) "3 $BtnItem Enabled $90 267 110 337 OK $StatText Disabled $10 60 70 350 An error occured while ^0 the disk. The file '^1' was not ^2. $StatText Disabled $90 10 110 260 ^3 ",258 (32) "3 $BtnItem Enabled $62 300 82 370 Cancel $StatText Disabled $5 10 60 370 The document '^0' is being spooled to disk and printed. $StatText Disabled $62 10 82 270 ^1 of ^2. ",259 (32) "3 $BtnItem Enabled $90 13 110 83 OK $BtnItem Enabled $90 267 110 337 Cancel $StatText Disabled $10 60 70 350 Are you sure you want to go back to the old version of this file? You will lose any changes that you have made. ",260 (32) "3 $BtnItem Enabled $90 13 110 83 OK $BtnItem Enabled $90 267 110 337 Cancel $StatText Disabled $10 60 70 350 A file by that name is already open. '^0' will be opened instead. Type DLOG * this is the 'press cancel to stop printing' dialog ",257 (32) "40 66 125 446 "Visible 1 NoGoAway 0 "258 Type ALRT * a stop alert - an error occured while reading or writing the disk ",256 (32) "60 81 180 431 "257 "5555 * a caution alert - a file is changed and 'Revert to Saved' is chosen ",257 (32) "60 81 180 431 "259 "CCCC * a note alert - the file selected is already on the desktop ",258 (32) "60 81 180 431 "260 "CCCC * a caution alert - the file is being closed, but has not yet been saved ",259 (32) "60 66 180 446 "256 "4444 Type STR# ",256 (36) Untitled- Save this document as: This example was written to demonstrate the Macintosh User Interface. Show Clipboard Hide Clipboard -6 -7 before quitting reading from writing to loaded saved -13 Print Stop Printing Copy of\20 This disk is full. The disk directory is full. This file The disk is locked. The disk is unreadable. ID =\20 ",257 (36) External Debugger Show FreeMem Hide FreeMem Type CODE "Example/fileL,0 3. "6F^5D!$ǐ^%BBScroll.Rsrc * This is the resource file for Scroll, a simple program to demonstrate * the use of scroll bars. Type SCRL = STR ",256 Scroll by Cary Clark, Macintosh Technical Support V7/5 Apple, 1984 Type MENU ",1(4) "File $Quit ",2(4) "Scroll Bar $Horizontal $Vertical $(- $Text $Graphics * a document window Type WIND ",256(4) A Scrolling Example "40 20 339 480 "Invisible NoGoAway "0 "0 * the vertical scroll bar Type CNTL ",256(4) x "-1 445 285 461 "Visible "16 "0 "0 0 400 * the horizontal scroll bar ",257(4) x "284 -1 300 446 "Invisible "16 "0 "0 0 300 Type Str ,256(4) "Please refer to the Control Manager manual for more information about scroll bars. Type Code ScrollL,0 3. "6F^56D!$ǐ^'f{$X-} {$U-} program showPaint; {Scott Knaster Macintosh Tech Support 5/84 Displays the upper-left corner of a MacPaint document on the screen. Based on Bill Atkinson's document Note: screen sizes are hard-coded for 512 by 342 } {Small and slow version. This version saves memory by doing a CopyBits for each line individually, so it's much slower than the all-at-once method. You can speed it up by making the constant srcBlocks larger, but every srcBlock costs you 512 bytes. Ultra-fast, pig version which reads in the whole picture (needs 24K) then does CopyBits is available from Macintosh Tech Support } #uses &{$U obj/memtypes} memtypes, &{$U obj/quickdraw} quickdraw, &{$U obj/osintf} osintf, &{$U obj/toolintf} toolintf; #const &srcBlocks = 2; {Make this number larger to speed things up. Uses 512 bytes 6for each number increased.} &headerSize = 512; #type &diskBlock = packed array [1..512] of QDbyte; #var &srcBuf : array [1..srcBlocks] of diskBlock; &theBits : packed array [1..72] of byte; &srcPtr, dstPtr : Ptr; &dstBits : bitmap; &error : OSErr; &refNum, scanline, srcSize : integer; &count : longint; &aPort : GrafPort; &debug : text; &showRect, lineRect : Rect; begin #InitGraf (@thePort); #FlushEvents (everyEvent, 0); #InitCursor; #OpenPort (@aPort); #srcSize := srcBlocks * 512; #srcPtr := @srcBuf; #dstBits.rowBytes := 72; #dstBits.baseAddr := @theBits; #SetRect (dstBits.bounds, 0, 0, 576, 1); #dstPtr := pointer (dstBits.baseAddr); #error := FSOpen ('macPic', 0, refNum); #{skip the header} #count := headerSize; #error := FSRead (refNum, count, @srcBuf); #{prime srcBuf} #count := srcSize; #error := FSRead (refNum, count, @srcBuf); #SetRect (lineRect, 0, 0, 512, 1); #SetRect (showRect, 0, 0, 512, 1); #count := count - 512; #{unpack each scanline into dstBits, reading more source as needed} #for scanline := 1 to 342 do &begin )UnpackBits (srcPtr, dstPtr, 72); )CopyBits (dstBits, screenBits, lineRect, showRect, -srcCopy, nil); )dstPtr := pointer (dstBits.baseAddr); )OffsetRect (showRect, 0, 1); )if ord (srcPtr) > (ord (@srcBuf) + srcSize - 512) ,then begin 2srcBuf [1] := srcBuf [srcBlocks]; 2error := FSRead (refNum, count, @srcBuf [2]); 2srcPtr := pointer (ord (srcPtr) + 512 - srcSize); 1end; &end; #error := FSClose (refnum); #repeat until button; end. P$ IBz("N"MainProg z"NVA/Hz zfA/Hz fA/HzfA/HzXfA/HzfA*/HzܨfAB/HzfAZ/Hz`fAr/HzTfA/HzHfA/Hz fA/Hz̨fA/HzfA/HzPfA/HzfN^NuNITICONf000203FF01600002000001C00002000001800003FFFFFF000000201FE01560002000001AC0002000001580002020101B0000020000013500020000016B000201FE01D50002010201AB000000380000300000680000700000D80000D0003FFFFFF1B0000000000000000000000000000000000000000001FFFFFF00000000000000000000000000000000000000000000000000000A00002B00000BFFFFEE00000800000C00000FFFFFF8000000A00002AC0000A08082D40000A0FF82AC0000A00002D800000A00002AC0000A07F02D40000A04102AC0000A07F02D400000A00002AC0000BFFFFED40000800000AC0000BFFFFED400000A00002AC0000A08082D40000A0FF82AC0000A00002D4000004000006C0000FFFFFFD40000800000AC0000BFFFFED40000007FFFFFC00000800000C00001000001C000020000034000040000000B80040000000F00040000000E0007FFFFFFFC00006B000000AB807FC000FFD70040600180AE00403FFF00DC00040000000AB807FFFFFFFD5806AC00000AB8055800000D580040600180AB80403FFF00D58040000000AB8040000000D58000D7FFFFFFB801AC000003580358000006B807FC000FFD580000E00000018001A00000038003600000078006A000000D800000000000000000000000000000000000000007FFFFFFF000784249258E70003049233100000E000E40800001FFFC3F00932524924C82A44524924D01C88524924CF10C4524924C090000524024C00000524924C00600524924C0090E524924C7C0000500004C000005259A4C000005250A4C00000525FA4C0000033E3801C0000180E002C00000FF801CC0000047FFE0C0000010064FE0000031199830000020E6301800002418E00800000013849800000026C4980000004C09300000008612600000000001FC000000000E0600000000300300000000C091800008000000001C0C000000003807FFFFFFFFF0007800001E00008000000001AC87F000000158841000CCC1B087F000CCC160018000000006B3000000000D77FFFFFFFFFABC0000000035600184000013870327FFFFF10F06400000021B0CFFFFFFFC3700004000010000004A54510000004000017FE00F4A515100300002000008400004454510400004000017C00004A5151000000000000000000007FFFFF000000800002800001115144400800000000980FFFFFFFFF300800000001600FFFFFFFFFC00018000000013832AAAAA8A9F0655555515380C2AAAA82A580008000000004307FFFFFFFFA30100000000260FFFFFFFFE2C01200000BF923120000080F2312000008002311FFFFF000230120000080F23120000080023120000080023120000080F23018000000004311FFFFF00023120000080F231200000BF923000600000000601800000000B0600000000130FFFFFFFFFA30000000000000000000000000000000000000001FFFFFFFFCNV0. ACA-H=|HnBgBg?<0?< AC AC Hn?. ?.Hn mHhHnHn?<BN^ _\ONRAWICONNVHA/Hz֨fBg?<?<?<Bg?<?<?<5"S@nHnHz^ {$X-} PROGRAM Grow; "{ Grow -- Scroll bars and a resizable window added to Edit } "{ by Cary Clark, Macintosh Technical Support } "{ SK 6/23 Added if GetNextEvent, SetPort in update event } "{This program is a sample. Don't use it as a skeleton or template; instead, #understand each line and redo it yourself, only better!} "{ Note: you can now find a much better way to do scrolling in $Example/Scroll.text} #USES {$U-} &{$U Obj/Memtypes } Memtypes, &{$U Obj/QuickDraw } QuickDraw, &{$U Obj/OSIntf } OSIntf, &{$U Obj/ToolIntf } ToolIntf; #CONST &lastMenu = 3; { number of menus } &appleMenu = 1; { menu ID for desk accessory menu } &fileMenu = 256; { menu ID for File menu } &editMenu = 257; { menu ID for Edit menu } #VAR &myMenus: ARRAY [1..lastMenu] OF MenuHandle; &growRect,dragRect,pRect,tRect: Rect; &doneFlag,temp: BOOLEAN; &myEvent: EventRecord; &code,refNum,MyControl,t: INTEGER; &wRecord: WindowRecord; &theWindow,whichWindow: WindowPtr; &theMenu,theItem: INTEGER; &theChar: CHAR; &ticks: LongInt; &hTE: TEHandle; &hCurs: CursHandle; &iBeam: Cursor; &hScroll,vScroll,whichControl: ControlHandle; &TheOrigin: point; &savePort: GrafPtr; #PROCEDURE SetUpMenus; #{ Once-only initialization for menus } &VAR )i: INTEGER; &BEGIN )InitMenus; { initialize Menu Manager } )myMenus[1] := GetMenu(appleMenu); )AddResMenu(myMenus[1],'DRVR'); { desk accessories } )myMenus[2] := GetMenu(fileMenu); )myMenus[3] := GetMenu(editMenu); )FOR i := 1 TO lastMenu DO InsertMenu(myMenus[i],0); )DrawMenuBar; &END; { of SetUpMenus } #PROCEDURE CursorAdjust; #{ Makes cursor be I-beam inside the (active) application window's } #{ content region (except for size box and scroll bar areas). } &VAR )mousePt: point; &BEGIN )GetMouse(mousePt); )IF theWindow=FrontWindow THEN ,BEGIN ,IF (PtInRect(mousePt,pRect)) THEN /SetCursor(iBeam) ,ELSE /SetCursor(arrow); ,END; &END; #PROCEDURE DoCommand(mResult: LongInt); &VAR )name: STR255; &BEGIN )theMenu := HiWord(mResult); theItem := LoWord(mResult); )CASE theMenu OF ,appleMenu: /BEGIN /GetItem(myMenus[1],theItem,name); /refNum := OpenDeskAcc(name); /END; ,fileMenu: doneFlag := TRUE; { Quit } ,editMenu: /BEGIN /IF NOT SystemEdit(theItem-1) THEN 2BEGIN 2SetPort(theWindow); 2ClipRect(pRect); /{ Delay so menu title will stay lit a little while if Command key } 2{ equivalent was typed. } 2if myEvent.what <> mouseDown 5then Delay (30, ticks); 2CASE theItem OF 53: TECut(hTE); 54: TECopy(hTE); 55: TEPaste(hTE); 2END; { of item case } 2END; /END; { of editMenu } )END; { of menu case } )HiliteMenu(0); &END; { of DoCommand } #PROCEDURE MoveScrollBars; &BEGIN )WITH theWindow^.portRect DO ,BEGIN ,HideControl(vScroll); ,MoveControl(vScroll,right-15,top-1); ,SizeControl(vScroll,16,bottom-top-13); ,ShowControl(vScroll); ,HideControl(hScroll); ,MoveControl(hScroll,left-1,bottom-15); ,SizeControl(hScroll,right-left-13,16); ,ShowControl(hScroll) ,END &END; #PROCEDURE ResizePRect; &BEGIN )pRect := thePort^.portRect; )pRect.left := pRect.left+4; pRect.right := pRect.right-15; )pRect.bottom := pRect.bottom-15 &END; #PROCEDURE GrowWnd(whichWindow: WindowPtr); #{ Handles growing and sizing the window and manipulating } #{ the update region. } &VAR )longResult: LongInt; )height,width: INTEGER; )tRect: Rect; &BEGIN )longResult := GrowWindow(whichWindow,myEvent.where,growRect); )IF longResult=0 THEN EXIT(GrowWnd); )height := HiWord(longResult); width := LoWord(longResult); ){ Add the old "scroll bar area" to the update region so it will } ){ be redrawn (for when the window is enlarged). } )tRect := whichWindow^.portRect; tRect.left := tRect.right-16; )InvalRect(tRect); )tRect := whichWindow^.portRect; tRect.top := tRect.bottom-16; )InvalRect(tRect); ){ Now draw the newly sized window. } )SizeWindow(whichWindow,width,height,TRUE); )MoveScrollBars; )ResizePRect; ){ Adjust the view rectangle for TextEdit. } )hTE^^.viewRect := pRect; ){ Add the new "scroll bar area" to the update region so it will } ){ be redrawn (for when the window is made smaller). } )tRect := whichWindow^.portRect; tRect.left := tRect.right-16; )InvalRect(tRect); )tRect := whichWindow^.portRect; tRect.top := tRect.bottom-16; )InvalRect(tRect); &END; { of GrowWnd } #PROCEDURE DrawWindow(whichWindow: WindowPtr); #{ Draws the content region of the given window, after erasing whatever } #{ was there before. } &VAR )i: INTEGER; &BEGIN )ClipRect(whichWindow^.portRect); )EraseRect(whichWindow^.portRect); )DrawGrowIcon(whichWindow); )DrawControls(whichWindow); )TEUpdate(pRect,hTE) &END; { of DrawWindow } #PROCEDURE ScrollBits; &VAR )oldOrigin: point; )dh,dv: INTEGER; &BEGIN )WITH theWindow^ DO ,BEGIN ,oldOrigin := TheOrigin; ,TheOrigin.h := 4*GetCtlValue(hScroll); ,TheOrigin.v := 4*GetCtlValue(vScroll); ,dh := oldOrigin.h-TheOrigin.h; ,dv := oldOrigin.v-TheOrigin.v; ,TEScroll(dh,dv,hTE) ,END &END; #PROCEDURE ScrollUp(whichControl: ControlHandle; theCode: INTEGER); &BEGIN )IF theCode=inUpButton THEN ,BEGIN ,SetCtlValue(whichControl,GetCtlValue(whichControl)-1); ,ScrollBits ,END &END; #PROCEDURE ScrollDown(whichControl: ControlHandle; theCode: INTEGER); &BEGIN )IF theCode=inDownButton THEN ,BEGIN ,SetCtlValue(whichControl,GetCtlValue(whichControl)+1); ,ScrollBits ,END &END; #PROCEDURE PageScroll(code,amount: INTEGER); &VAR )myPt: point; &BEGIN )REPEAT ,GetMouse(myPt); ,IF TestControl(whichControl,myPt)=code THEN /BEGIN /SetCtlValue(whichControl,GetCtlValue(whichControl)+amount); /ScrollBits /END )UNTIL NOT StillDown; &END; #BEGIN { main program } &InitGraf(@thePort); &InitFonts; &FlushEvents(everyEvent,0); &InitWindows; &SetUpMenus; &TEInit; &InitDialogs(NIL); &SetCursor(arrow); &SetRect(dragRect,4,24,508,338); &SetRect(growRect,100,60,512,302); &doneFlag := FALSE; &theWindow := GetNewWindow(256,@wRecord,POINTER(-1)); &SetPort(theWindow); &theWindow^.txFont := 2; &ResizePRect; &hTE := TENew(pRect,pRect); &hCurs := GetCursor (iBeamCursor); iBeam := hCurs^^; &vScroll := GetNewControl(256,theWindow); &hScroll := GetNewControl(257,theWindow); &TheOrigin.h := 0; TheOrigin.v := 0; &REPEAT )CursorAdjust; )SystemTask; )TEIdle(hTE); )if GetNextEvent(everyEvent,myEvent) then )CASE myEvent.what OF ,mouseDown: /BEGIN /code := FindWindow(myEvent.where,whichWindow); /CASE code OF 2inMenuBar: DoCommand(MenuSelect(myEvent.where)); 2inSysWindow: SystemClick(myEvent,whichWindow); 2inDrag: DragWindow(whichWindow,myEvent.where,dragRect); 2inGoAway: 5IF TrackGoAway(whichWindow,myEvent.where) THEN 8doneFlag := TRUE; 2inGrow: 5IF whichWindow=FrontWindow THEN 8GrowWnd(whichWindow) 5ELSE 8SelectWindow(whichWindow); 2inContent: 5BEGIN 5IF whichWindow<>FrontWindow THEN 8SelectWindow(whichWindow) 5ELSE 8BEGIN {front} 8GlobalToLocal(myEvent.where); 8IF PtInRect(myEvent.where,pRect) THEN ;IF BitAnd(myEvent.modifiers,512)<>0 { Shift key pressed A} >THEN >TEClick(myEvent.where,TRUE,hTE) ;ELSE >TEClick(myEvent.where,FALSE,hTE) 8ELSE ;BEGIN {controls} ;MyControl := FindControl(myEvent.where,whichWindow, TwhichControl); ;CASE MyControl OF >inUpButton: At := TrackControl(whichControl,myEvent.where, S@ScrollUp); >inDownButton: At := TrackControl(whichControl,myEvent.where, S@ScrollDown); >inPageUP: PageScroll(MyControl,-10); >inPageDown: PageScroll(MyControl,10); >inThumb: ABEGIN At := TrackControl(whichControl,myEvent.where, FNIL); AScrollBits AEND ;END {Case MyControl} ;END {controls} 8END {front} 5END {in Content} /END { of code case } /END; { of mouseDown } ,keyDown,autoKey: /BEGIN /IF theWindow=FrontWindow THEN 2BEGIN 2theChar := CHR(myEvent.message MOD 256); 2IF BitAnd(myEvent.modifiers,256)<>0 { Command key pressed } 5THEN 5DoCommand(MenuKey(theChar)) 2ELSE 5TEKey(theChar,hTE) 2END /END; { of keyDown } ,activateEvt: /BEGIN /DrawGrowIcon(theWindow); /IF ODD(myEvent.modifiers) THEN { window is becoming active } 2BEGIN 2SetPort (theWindow); 2TEActivate(hTE); 2ShowControl(vScroll); 2ShowControl(hScroll) 2END /ELSE 2BEGIN 2TEDeactivate(hTE); 2HideControl(vScroll); 2HideControl(hScroll) 2END /END; { of activateEvt } ,updateEvt: /BEGIN /GetPort (savePort); /SetPort (theWindow); /BeginUpdate(theWindow); /DrawWindow(theWindow); /EndUpdate(theWindow); /SetPort (savePort); /END { of updateEvt } )END { of event case } &UNTIL doneFlag #END. 3. "6F^5D!$ǐ^  ?9* GrowResDef -- Resource input for sample application named Grow * Written by Macintosh Technical Support * 6/23 SK Added menu 1, standard edit menu, removed i-beam cursor example/Grow.Rsrc Type MENU ",1 "\14 ",256 "File $Quit ",257 "Edit $Undo/Z $(- $Cut/X $Copy/C $Paste/V Type WIND ",256 "A Sample "50 40 300 450 "Visible GoAway "0 "0 Type CNTL ",256 "vertical scroll bar "-1 395 236 411 "Visible "16 "0 "0 0 50 ",257 "horizontal scroll bar "235 -1 251 396 "Visible "16 "0 "0 0 50 Type GROW= STR ,0 Grow Version 1.0 - January 8, 1984 Type CODE "Example/growL,0 5ht^XX Td.8~.8'F'. . F'xJh:>:>'F'̘̘$Intrfc/ToolIntf.TextxxNJIntrfc/ToolIntf.TextTextxt̉FJ" . 8. :H H  '@]̑8`H'F)@l%L:@#'J'̘ OSERRS.ERR6:":"9)e noI{$X-} {$U-} {$R-} {To avoid bug in range checking of MacPasLib} {Scott Knaster Macintosh Technical Support 5/10/84} program modal; #uses &{$U Obj/Memtypes } Memtypes, &{$U Obj/QuickDraw } QuickDraw, &{$U Obj/OSIntf } OSIntf, &{$U Obj/ToolIntf } ToolIntf, &{$U Obj/PackIntf } PackIntf; #const &numItems = 16; &numRadGroups = 2; &numChks = 1; &OKBtn = OK; {OK and Cancel constants defined by Dialog Mgr;} &cancelBtn = Cancel; &stopChk = 14; &textItem = 6; {item number for editable text item} &btnOff = 0; &btnOn = 1; &noWrap = -1; #{I have radio buttons handled as sets. Don't do it this way! A much better way is $to put the default setting and the "group" number in the control's refCon field. Then, when a $radio button is turned on, the code will walk through the control list (probably with GetDItem) $, check each control to make sure it's a radio button, and turn it off if its group was hit. } $var { Note that for both radio buttons and check boxes, I don't need to keep a "nowOn" field - the $Control's value field works fine.} &radSet : packed array [1..numRadGroups] of packed record PdefaultOn, nowOn : 0..255; Pbtns : set of 1..numItems; Xend; {record} &chkBoxes : packed array [1..numChks] of packed record Pdefault : btnOff..btnOn; Pbtn : 1..numItems; Nend; &index : integer; &debug : text; &theDialog : DialogPtr;{pointer to dialog record - returned by GetNewDialog} &itemHit : integer; {item where event occurred - returned by ModalDialog} &{the next three things are returned by GetDItem :} &theType : integer; {gives the type of the item requested} &theTextHdl, theOkHdl, itemHdl, radHdl : handle; {gives a handle to the item} &txtBox, OKbox, itemBox, radBox : Rect; {gives the display rectangle of the item} &theText : str255; {text of the edit item - returned by GetIText} &iBeamHdl : CursHandle; {handle to the special cursor} &theDlogPeek : DialogPeek; {also a pointer to a dialog record - this type Bof pointer is required to set up the editable Btext for no word wrap} &wasDown : boolean; {used to obscure cursor after a click in the text} &teHdl : teHandle; &paperDef : integer; #function theFilter (theDialog : DialogPtr; var theEvent : EventRecord; 4var item : integer) : boolean; #{This function is called by ModalDialog for every event that occurs while it's $in control. It's used to perform special filtering (hence the clever name) $of events before letting ModalDialog take over. For example, we use it to $change the cursor to an I-beam when it's on editable text and to obscure $(hide) the I-beam cursor after the user clicks in editable text (a la Lisa). $We must also tell ModalDialog that a press of Return or Enter by the user $should be treated the same as if he had clicked on the OK button $(per user interface standards).} #const %crCode = 13; {ASCII code generated by Return and Enter keys. Note that} %enterCode = 3; {this is good for any keyboard, no matter how it's mapped 9or what language the user speaks (keypad too)} #var &mouseLoc : Point; &finalTicks : longint; #begin &itemHit := 0; {We return these two values. Initialize them.} &theFilter := false; &{Frill: When you click in editable text and start typing, TextEdit calls 'ObscureCursor, which hides the cursor until you move the mouse again. 'This keeps the cursor from getting in your way while you type. Lisa 'editing adds a nice touch: the cursor is obscured as soon as you click, 'before you start typing. This stuff does the same thing. 'It would be nice if we could just wait for a MouseUp event in the text, 'but TextEdit "eats" the MouseUp event when it calls WaitMouseUp instead 'of StillDown; so, we do it this way.} &if wasDown and not StillDown )then begin 1ObscureCursor; {User clicked in editable text} 1wasDown := false; {Reset "mouse down" flag} .end; &case theEvent.what of )nullEvent : begin {Nothing is going on, so fix the cursor} 8GetMouse (mouseLoc); 8if PtInRect (mouseLoc, txtBox) {box is TextEdit's box} ;then SetCursor (iBeamHdl^^) ;else SetCursor (arrow); {make sure it's an arrow} 5end; )mouseDown : begin 0GlobalToLocal (theEvent.where); {because PtInRect wants it that way} 0if PtInRect (theEvent.where, txtBox) {Set mouse down flag} Cthen wasDown := true;{if mouse down in text box} 0LocalToGlobal (theEvent.where); {because Dlog Mgr wants it that way} 5end; )keyDown, autoKey : 2begin 5if (theEvent.message mod 256) in [crCode, enterCode] 5then {user pressed Return or Enter} 8begin ;GetDItem (theDialog, OKbtn, theType, theOkHdl, OKbox); ;HiliteControl (ControlHandle (theOkHdl), JbtnOn); {make it look...} ;Delay (3, finalTicks); {...like the OK button was hit} ;theFilter := true; {dialog is over} ;itemHit := OKBtn; {simulate user hitting OK} 5end 2end &end {case theEvent.what} #end; {function theFilter} begin {main program} #InitGraf (@thePort); {the big five inits} #InitFonts; #InitWindows; #TEInit; #InitDialogs (nil); #reset (debug, '.bout'); #iBeamHdl := GetCursor (iBeamCursor); {load special cursor} #wasDown := false; {just initializing here} #{The next chunk of code is used to set up the radio button and check box $data structures. It should be done during initialization of the program. $Since the settings must exist between incarnations of the dialog box, $these variables must not be local to the procedure that puts up the box.} #radSet [1].btns := [8, 9]; #radSet [1].defaultOn := 8; #radSet [1].nowOn := radSet [1].defaultOn; #radSet [2].btns := [11, 12, 13]; #radSet [2].defaultOn := 12; #radSet [2].nowOn := radSet [2].defaultOn; #chkBoxes [1].btn := stopChk; #chkBoxes [1].default := btnOn; {default 'Stop printing' check box to on} #{The following loop actually does the dialog. It should be called each $time you want the dialog to happen.} &repeat )FlushEvents (everyEvent, 0); {this throws out leftover clicks, keys} )theDialog := GetNewDialog (1000, nil, pointer (-1)); /{this "draws" the dialog box (but it's invisible)} )for index := 1 to numRadGroups do {initialize default radio buttons} ,begin /GetDItem (theDialog, radSet [index].defaultOn, theType, itemHdl, itemBox); /SetCtlValue (ControlHandle (itemHdl), btnOn); ,end; )for index := 1 to numChks do {Initialize default check boxes} ,begin /GetDItem (theDialog, chkBoxes [index].btn, theType, itemHdl, itemBox); /SetCtlValue (ControlHandle (itemHdl), chkBoxes [index].default); 5{set default value of check box} ,end; )GetDItem (theDialog, textItem, theType, theTextHdl, txtBox); ,{this tells us three things: (1), theTextHdl is a handle to the editable -text, which we need to find out the text later; (2), txtBox tells us -where the text is, so we can change the pointer to an I-beam when -it moves over the text; and (3), theType tells us the type of the -item, which in this case we already know is editable text} )theDlogPeek := DialogPeek (theDialog); {get peek-type pointer to dialog...} )theDlogPeek^.textH^^.crOnly := noWrap; {...so we can turn off word wrap} )SetPort (theDialog); {this makes later GlobalToLocal calls work right} )ShowWindow (theDialog); {here I am!} )InitCursor; {we're ready, show an arrow} ,repeat /ModalDialog (@theFilter,itemHit); {calls theFilter for every event} /GetDItem (theDialog, itemHit, theType, itemHdl, itemBox); 5{find out what was hit} 0case theType of 3chkCtrl + ctrlItem : {check box was hit; toggle its state} 6SetCtlValue (ControlHandle (itemHdl), 6BitXor (GetCtlValue (ControlHandle (itemHdl)), 1)); 3radCtrl + ctrlItem : begin {radio button was hit} 6index := 1; 6while not (itemHit in radSet [index].btns) 8do index := index + 1; {find out which set Pof buttons was hit} 6GetDItem (theDialog, radSet [index].nowOn, theType, @radHdl, radBox); {get handle to button now on} 6SetCtlValue (ControlHandle (radHdl), btnOff); {old button off} 6SetCtlValue (ControlHandle (itemHdl), btnOn); {new button on} 6radSet [index].nowOn := itemHit; {update data structure} Hend; {radCtrl case} 0end; {case theType} ,until itemHit in [OKBtn, cancelBtn]; /{dialog ends when user hits a button (or presses Return or Enter, 0which theFilter makes look like a hit on the OK button)} )if itemHit = cancelBtn ,then begin {Revert radio buttons to their 8settings before dialog was 8called.} 5for index := 1 to numRadGroups do 7radSet [index].nowOn := radSet [index].defaultOn; #{Note that I don't have to revert the checkboxes, since their "default" $field has not been changed.} 1end ,else begin {Update default settings} 5for index := 1 to numRadGroups do 7radSet [index].defaultOn := radSet [index].nowOn; 5for index := 1 to numChks do 8begin ;GetDItem (theDialog, chkBoxes [index].btn, theType, EitemHdl, itemBox); ;chkBoxes [index].default := BGetCtlValue (ControlHandle (itemHdl)); 8end 1end; )GetIText (theTextHdl, theText); {this tells us the text that the user entered} ){do something with it - what?} &until theText = 'quit'; {all done if user typed 'quit'} end. 3. "6F^5ND!$ǐ^в* resource definition file for modal.text example/modal.rsrc Type DLOG #,1000 #33 110 333 390 #Invisible 1 NoGoAway 0 #1000 Type DITL #,1000 #16 #BtnItem Enabled #15 196 35 254 OK #BtnItem Enabled #45 196 65 254 Cancel #IconItem Disabled #10 10 42 42 #1000 #StatText Disabled #20 50 40 180 Print the document #StatText Disabled #75 10 95 50 Title: #EditText Enabled #77 60 92 225 #StatText Disabled #102 10 122 100 Paper size: #RadioItem Enabled #126 18 141 140 8 1/2" by 11" #RadioItem Enabled #126 160 141 270 8 1/2" by 14" #StatText Disabled #151 10 171 100 Print Quality: #RadioItem Enabled #175 18 195 75 High #RadioItem Enabled #175 105 195 183 Standard #RadioItem Enabled #175 200 195 260 Draft #ChkItem Enabled #205 10 220 235 Stop printing after each page #UserItem Disabled #235 62 255 210 #StatText Disabled #265 68 285 250 Progress of Printing Type ICON #,1000 #0000 0000 #0000 0000 #03FF FFC0 #0600 0060 #0D11 1130 #1844 4458 #1111 1108 #1000 0008 #1000 0008 #1FFF FFF8 #0000 0000 #1FFF FFF8 #0000 0000 #3BBB BBB8 #6EEE EEEE #0000 0000 #3FFF FFFC #2000 0004 #3FFF FFFC #0000 0000 #7FFF FFFE #7FFF FFFE #0000 0000 #1FFF FFF8 #1000 0008 #1444 4448 #1000 0008 #1911 1118 #0C00 0030 #0600 0060 #03FF FFC0 #0000 0000 Type CODE #example/modall,0 3. "6F^50^)0 , d,:dxtRc.Te"jFȠc.Text>ÀxtTzÚÒ>òYYRR@TԠ  T*\Mv{$U-} {$X-} program scrap; {Scott Knaster, Macintosh Tech Support, 6/4/84 Displays the PICT scrap. Clever part is extracting original frameRect from the picture. Some things to do: add desk accessory support & edit menu; use WindowPic field } #uses &{$U Obj/Memtypes } Memtypes, &{$U Obj/QuickDraw } QuickDraw, &{$U Obj/OSIntf } OSIntf, &{$U Obj/ToolIntf } ToolIntf, &{$U Obj/PackIntf } PackIntf; #var %theWindow : WindowPtr; %theScrap : Handle; %thePict : PicHandle; %rectPtr : ^Rect; %offset, result : longint; %theFrame : Rect; begin #InitGraf (@thePort); {standard initialization stuff} #InitFonts; #InitWindows; #TEInit; #InitDialogs (nil); #theWindow := GetNewWindow (256, nil, pointer (-1)); #SetPort (theWindow); #theScrap := NewHandle (0); #result := GetScrap (theScrap, 'PICT', offset); #InitCursor; #if result < 0 {error code returned} &then begin )MoveTo (5, 50); )DrawString ('Nothing of type PICT in scrap'); +end &else begin {got something} )thePict := PicHandle (theScrap); .{extract the original frame} )theFrame := thePict^^.picFrame; .{Move the frame down and to the right a little} )OffsetRect (theFrame, -theFrame.left + 15, -theFrame.top + 20); )HLock (Handle (thePict)); *{"Always lock a picHandle before doing DrawPicture." - C. Clark, 1984} )DrawPicture (thePict, theFrame); )HUnlock (Handle (thePict)); +end; #MoveTo (130, 230); #TextFace ([bold]); #DrawString ('Press mouse button to exit'); #repeat until button; end. 3. "6F^56D!$ǐ^ Qexample/picscrap.Rsrc Type WIND ",256 Desk Scrap "50 40 300 450 "Visible NoGoAway "0 "0 Type CODE #example/picscrapl,0 58?^2a<.<5Lb{$X-} PROGRAM QDSample; "{ QDSample -- Macintosh adaptation of Lisa QuickDraw example. } "{ by Paul Zemlin, Macintosh Technical Support } #USES {$U-} &{$U Obj/Memtypes } Memtypes, &{$U Obj/QuickDraw } QuickDraw, &{$U Obj/OSIntf } OSIntf, &{$U Obj/ToolIntf } ToolIntf; TYPE IconData = ARRAY[0..95] OF INTEGER; #CONST &lastMenu = 2; { number of menus } &appleMenu = 1; { menu ID for desk accessory menu } &fileMenu = 256; { menu ID for File menu } #VAR &myMenus : ARRAY [1..lastMenu] OF MenuHandle; &dragRect ,prect, growrect : Rect; &doneFlag,temp : BOOLEAN; &myEvent : EventRecord; &code, refNum, MyControl,t : INTEGER; &theMenu, theItem, whichIcon : INTEGER; &scale : INTEGER; &wRecord : WindowRecord; &theWindow, whichWindow : WindowPtr; &icons : ARRAY[0..5] OF IconData; &hScroll, vScroll, whichControl : ControlHandle; &theOrigin : Point; &theUpdateRgn : RgnHandle; #PROCEDURE InitIcons; #{ Manually stuff some icons. Normally we would read them from a file } #BEGIN %{ Lisa } %StuffHex(@icons[0, 0],'000000000000000000000000000000000000001FFFFFFFFC'); %StuffHex(@icons[0,12],'00600000000601800000000B0600000000130FFFFFFFFFA3'); %StuffHex(@icons[0,24],'18000000004311FFFFF00023120000080F231200000BF923'); %StuffHex(@icons[0,36],'120000080F23120000080023120000080023120000080F23'); %StuffHex(@icons[0,48],'1200000BF923120000080F2312000008002311FFFFF00023'); %StuffHex(@icons[0,60],'08000000004307FFFFFFFFA30100000000260FFFFFFFFE2C'); %StuffHex(@icons[0,72],'18000000013832AAAAA8A9F0655555515380C2AAAA82A580'); %StuffHex(@icons[0,84],'800000000980FFFFFFFFF300800000001600FFFFFFFFFC00'); %{ Printer } %StuffHex(@icons[1, 0],'000000000000000000000000000000000000000000000000'); %StuffHex(@icons[1,12],'00000000000000007FFFFF00000080000280000111514440'); %StuffHex(@icons[1,24],'0002000008400004454510400004000017C00004A5151000'); %StuffHex(@icons[1,36],'0004000010000004A54510000004000017FE00F4A5151003'); %StuffHex(@icons[1,48],'0184000013870327FFFFF10F06400000021B0CFFFFFFFC37'); %StuffHex(@icons[1,60],'18000000006B3000000000D77FFFFFFFFFABC00000000356'); %StuffHex(@icons[1,72],'8000000001AC87F000000158841000CCC1B087F000CCC160'); %StuffHex(@icons[1,84],'8000000001C0C000000003807FFFFFFFFF0007800001E000'); %{ Trash Can } %StuffHex(@icons[2, 0],'000001FC000000000E0600000000300300000000C0918000'); %StuffHex(@icons[2,12],'00013849800000026C4980000004C0930000000861260000'); %StuffHex(@icons[2,24],'0010064FE0000031199830000020E6301800002418E00800'); %StuffHex(@icons[2,36],'0033E3801C0000180E002C00000FF801CC0000047FFE0C00'); %StuffHex(@icons[2,48],'000500004C000005259A4C000005250A4C00000525FA4C00'); %StuffHex(@icons[2,60],'000524024C00000524924C00600524924C0090E524924C7C'); %StuffHex(@icons[2,72],'932524924C82A44524924D01C88524924CF10C4524924C09'); %StuffHex(@icons[2,84],'0784249258E70003049233100000E000E40800001FFFC3F0'); %{ tray } %StuffHex(@icons[3, 0],'000000000000000000000000000000000000000000000000'); %StuffHex(@icons[3,12],'0000000000000000000000000000000000000007FFFFFFF0'); %StuffHex(@icons[3,24],'000E00000018001A00000038003600000078006A000000D8'); %StuffHex(@icons[3,36],'00D7FFFFFFB801AC000003580358000006B807FC000FFD58'); %StuffHex(@icons[3,48],'040600180AB80403FFF00D58040000000AB8040000000D58'); %StuffHex(@icons[3,60],'040000000AB807FFFFFFFD5806AC00000AB8055800000D58'); %StuffHex(@icons[3,72],'06B000000AB807FC000FFD70040600180AE00403FFF00DC0'); %StuffHex(@icons[3,84],'040000000B80040000000F00040000000E0007FFFFFFFC00'); %{ File Cabinet } %StuffHex(@icons[4, 0],'0007FFFFFC00000800000C00001000001C00002000003400'); %StuffHex(@icons[4,12],'004000006C0000FFFFFFD40000800000AC0000BFFFFED400'); %StuffHex(@icons[4,24],'00A00002AC0000A07F02D40000A04102AC0000A07F02D400'); %StuffHex(@icons[4,36],'00A00002AC0000A08082D40000A0FF82AC0000A00002D400'); %StuffHex(@icons[4,48],'00A00002AC0000BFFFFED40000800000AC0000BFFFFED400'); %StuffHex(@icons[4,60],'00A00002AC0000A07F02D40000A04102AC0000A07F02D400'); %StuffHex(@icons[4,72],'00A00002AC0000A08082D40000A0FF82AC0000A00002D800'); %StuffHex(@icons[4,84],'00A00002B00000BFFFFEE00000800000C00000FFFFFF8000'); %{ drawer } %StuffHex(@icons[5, 0],'000000000000000000000000000000000000000000000000'); %StuffHex(@icons[5,12],'000000000000000000000000000000000000000000000000'); %StuffHex(@icons[5,24],'000000000000000000000000000000000000000000000000'); %StuffHex(@icons[5,36],'00000000000000000000000000000000000000001FFFFFF0'); %StuffHex(@icons[5,48],'0000380000300000680000700000D80000D0003FFFFFF1B0'); %StuffHex(@icons[5,60],'0020000013500020000016B000201FE01D50002010201AB0'); %StuffHex(@icons[5,72],'00201FE01560002000001AC0002000001580002020101B00'); %StuffHex(@icons[5,84],'00203FF01600002000001C00002000001800003FFFFFF000'); #END; #PROCEDURE DrawIcon(whichIcon,h,v: INTEGER); {DrawAnIcon => DrawIcon} #VAR 'srcBits : BitMap; 'srcRect, dstRect : Rect; #BEGIN %srcBits.baseAddr:=@icons[whichIcon]; %srcBits.rowBytes:=6; %SetRect(srcBits.bounds,0,0,48,32); %srcRect:=srcBits.bounds; %dstRect:=srcRect; %OffsetRect(dstRect,h,v); %CopyBits(srcBits,theWindow^.portBits,srcRect,dstRect,srcOr,Nil); #END; #PROCEDURE DrawStuff; #VAR i: INTEGER; 'tempRect : Rect; 'myPoly : PolyHandle; 'myRgn : RgnHandle; 'myPattern : Pattern; #BEGIN %StuffHex(@myPattern,'8040200002040800'); %{ draw two horizontal lines across the top } %MoveTo(0,18); %LineTo(719,18); %MoveTo(0,20); %LineTo(719,20); %{ draw divider lines } %MoveTo(0,134); %LineTo(719,134); %MoveTo(0,248); %LineTo(719,248); %MoveTo(240,21); %LineTo(240,363); %MoveTo(480,21); %LineTo(480,363); %{ draw title } %TextFont(0); %MoveTo(210,14); %DrawString('Look what you can draw with QuickDraw'); %{--------- draw text samples --------- } %MoveTo(80,34); DrawString('Text'); %TextFace([bold]); %MoveTo(70,55); DrawString('Bold'); %TextFace([italic]); %MoveTo(70,70); DrawString('Italic'); %TextFace([underline]); %MoveTo(70,85); DrawString('Underline'); %TextFace([outline]); %MoveTo(70,100); DrawString('Outline'); %TextFace([shadow]); %MoveTo(70,115); DrawString('Shadow'); %TextFace([]); { restore to normal } %{ --------- draw line samples --------- } %MoveTo(330,34); DrawString('Lines'); %MoveTo(280,25); Line(160,40); %PenSize(3,2); %MoveTo(280,35); Line(160,40); %PenSize(6,4); %MoveTo(280,46); Line(160,40); %PenSize(12,8); %PenPat(gray); %MoveTo(280,61); Line(160,40); %PenSize(15,10); %PenPat(myPattern); %MoveTo(280,80); Line(160,40); %PenNormal; %{ --------- draw rectangle samples --------- } %MoveTo(560,34); DrawString('Rectangles'); %SetRect(tempRect,510,40,570,70); %FrameRect(tempRect); %OffsetRect(tempRect,25,15); %PenSize(3,2); %EraseRect(tempRect); %FrameRect(tempRect); %OffsetRect(tempRect,25,15); %PaintRect(tempRect); %OffsetRect(tempRect,25,15); %PenNormal; %FillRect(tempRect,gray); %FrameRect(tempRect); %OffsetRect(tempRect,25,15); %FillRect(tempRect,myPattern); %FrameRect(tempRect); %{ --------- draw roundRect samples --------- } %MoveTo(70,148); DrawString('RoundRects'); %SetRect(tempRect,30,150,90,180); %FrameRoundRect(tempRect,30,20); %OffsetRect(tempRect,25,15); %PenSize(3,2); %EraseRoundRect(tempRect,30,20); %FrameRoundRect(tempRect,30,20); %OffsetRect(tempRect,25,15); %PaintRoundRect(tempRect,30,20); %OffsetRect(tempRect,25,15); %PenNormal; %FillRoundRect(tempRect,30,20,gray); %FrameRoundRect(tempRect,30,20); %OffsetRect(tempRect,25,15); %FillRoundRect(tempRect,30,20,myPattern); %FrameRoundRect(tempRect,30,20); %{ --------- draw bitmap samples --------- } %MoveTo(320,148); DrawString('BitMaps'); %DrawIcon(0,266,156); %DrawIcon(1,336,156); %DrawIcon(2,406,156); %DrawIcon(3,266,196); %DrawIcon(4,336,196); %DrawIcon(5,406,196); %{ --------- draw ARC samples --------- } %MoveTo(570,148); DrawString('Arcs'); %SetRect(tempRect,520,153,655,243); %FillArc(tempRect,135,65,dkGray); %FillArc(tempRect,200,130,myPattern); %FillArc(tempRect,330,75,gray); %FrameArc(tempRect,135,270); %OffsetRect(tempRect,20,0); %PaintArc(tempRect,45,90); %{ --------- draw polygon samples --------- } %MoveTo(80,262); DrawString('Polygons'); %myPoly:=OpenPoly; 'MoveTo(30,290); 'LineTo(30,280); 'LineTo(50,265); 'LineTo(90,265); 'LineTo(80,280); 'LineTo(95,290); 'LineTo(30,290); %ClosePoly; { end of definition } %FramePoly(myPoly); %OffsetPoly(myPoly,25,15); %PenSize(3,2); %ErasePoly(myPoly); %FramePoly(myPoly); %OffsetPoly(myPoly,25,15); %PaintPoly(myPoly); %OffsetPoly(myPoly,25,15); %PenNormal; %FillPoly(myPoly,gray); %FramePoly(myPoly); %OffsetPoly(myPoly,25,15); %FillPoly(myPoly,myPattern); %FramePoly(myPoly); %KillPoly(myPoly); %{ --------- demonstrate regions --------- } %MoveTo(320,262); DrawString('Regions'); %myRgn:=NewRgn; %OpenRgn; 'ShowPen; 'SetRect(tempRect,260,270,460,350); 'FrameRoundRect(tempRect,24,16); 'MoveTo(275,335); { define triangular hole } 'LineTo(325,285); 'LineTo(375,335); 'LineTo(275,335); 'SetRect(tempRect,365,277,445,325); { oval hole } 'FrameOval(tempRect); 'HidePen; %CloseRgn(myRgn); { end of definition } %DisposeRgn(myRgn); %{ --------- draw oval samples --------- } %MoveTo(580,262); DrawString('Ovals'); %SetRect(tempRect,510,264,570,294); %FrameOval(tempRect); %OffsetRect(tempRect,25,15); %PenSize(3,2); %EraseOval(tempRect); %FrameOval(tempRect); %OffsetRect(tempRect,25,15); %PaintOval(tempRect); %OffsetRect(tempRect,25,15); %PenNormal; %FillOval(tempRect,gray); %FrameOval(tempRect); %OffsetRect(tempRect,25,15); %FillOval(tempRect,myPattern); %FrameOval(tempRect); #END; { DrawStuff } #PROCEDURE MoveScrollBars; &BEGIN )WITH theWindow^.portRect DO ,BEGIN ,HideControl(vScroll); ,MoveControl(vScroll,right-15,top-1); ,SizeControl(vScroll,16,bottom-top-13); ,ShowControl(vScroll); ,HideControl(hScroll); ,MoveControl(hScroll,left-1,bottom-15); ,SizeControl(hScroll,right-left-13,16); ,ShowControl(hScroll) ,END &END; #PROCEDURE ResizePRect; #{ pRect is the window's content region, minus the scroll bars } &BEGIN )pRect := thePort^.portRect; )pRect.right := pRect.right-15; )pRect.bottom := pRect.bottom-15 &END; #PROCEDURE GrowWnd (whichWindow: WindowPtr); #{ Handles growing and sizing the window and manipulating } #{ the update region. } &VAR )longResult: LongInt; )height,width: INTEGER; )tRect: Rect; &BEGIN )longResult := GrowWindow(whichWindow,myEvent.where,growRect); )IF longResult=0 THEN EXIT(GrowWnd); )height := HiWord(longResult); width := LoWord(longResult); ){ Add the old "scroll bar area" to the update region so it will } ){ be redrawn (for when the window is enlarged). } )tRect := whichWindow^.portRect; )tRect.left := tRect.right - 16; )InvalRect(tRect); )tRect := whichWindow^.portRect; )tRect.top := tRect.bottom - 16; )InvalRect(tRect); ){ Now draw the newly sized window. } )SizeWindow(whichWindow,width,height,TRUE); )MoveScrollBars; )ResizePRect; ){ Add the new "scroll bar area" to the update region so it will } ){ be redrawn (for when the window is made smaller). } )tRect := whichWindow^.portRect; tRect.left := tRect.right-16; )InvalRect(tRect); )tRect := whichWindow^.portRect; tRect.top := tRect.bottom-16; )InvalRect(tRect); &END; { of GrowWnd } #PROCEDURE DrawWindow(whichWindow: WindowPtr); #{ Draws the content region of theWindow } &VAR )tRect : Rect; &BEGIN )ClipRect (theWindow^.portRect); )DrawGrowIcon(theWindow); )IF theWindow = FrontWindow THEN DrawControls(theWindow); ){ Now set up a clip area which excludes the scroll bars } )tRect := theWindow^.portRect; )tRect.bottom := tRect.bottom - 16; )tRect.right := tRect.right - 16; ){Now compensate for any scrolling which has been done } )OffsetRect (tRect, theOrigin.h, theOrigin.v); )ClipRect (tRect); ){ Change the origin to compensate for any scrolling which has been done } )SetOrigin (theOrigin.h, theOrigin.v); )DrawStuff; )SetOrigin (0, 0); )ClipRect (theWindow^.portRect); { Reset the clip area } 'END; { of DrawWindow } #PROCEDURE ScrollBits; &VAR )oldOrigin : point; )dh,dv : INTEGER; )tRect : Rect; &BEGIN ,oldOrigin := theOrigin; ,theOrigin.h := 4 * GetCtlValue(hScroll); ,theOrigin.v := 4 * GetCtlValue(vScroll); ,dh := oldOrigin.h - theOrigin.h; ,dv := oldOrigin.v - theOrigin.v; ,theUpdateRgn := NewRgn; ,ScrollRect (pRect, dh, dv, theUpdateRgn); ,{ Have scrolled in junk...need to redraw } ,SetOrigin (theOrigin.h, theOrigin.v); ,OffsetRect (theUpdateRgn^^.rgnBBox, theOrigin.h, theOrigin.v); ,ClipRect (theUpdateRgn^^.rgnBBox); ,DrawStuff; ,DisposeRgn (theUpdateRgn); ,SetOrigin (0, 0); ,ClipRect (theWindow^.portRect); &END; #PROCEDURE ScrollUp(whichControl: ControlHandle; theCode: INTEGER); &BEGIN )IF theCode=inUpButton THEN ,BEGIN ,SetCtlValue(whichControl,GetCtlValue(whichControl)-1); ,ScrollBits ,END &END; #PROCEDURE ScrollDown(whichControl: ControlHandle; theCode: INTEGER); &BEGIN )IF theCode=inDownButton THEN ,BEGIN ,SetCtlValue(whichControl,GetCtlValue(whichControl)+1); ,ScrollBits ,END &END; #PROCEDURE PageScroll(code,amount: INTEGER); &VAR )myPt: point; &BEGIN )REPEAT ,GetMouse(myPt); ,IF TestControl(whichControl,myPt)=code THEN /BEGIN /SetCtlValue(whichControl,GetCtlValue(whichControl)+amount); /ScrollBits /END )UNTIL NOT StillDown; &END; #PROCEDURE SetUpMenus; #{ Once-only initialization for menus } &VAR )i: INTEGER; &BEGIN )InitMenus; { initialize Menu Manager } )myMenus[1] := GetMenu(appleMenu); )AddResMenu(myMenus[1],'DRVR'); { desk accessories } )myMenus[2] := GetMenu(fileMenu); )FOR i := 1 TO lastMenu DO InsertMenu(myMenus[i],0); )DrawMenuBar; &END; { of SetUpMenus } #PROCEDURE DoCommand(mResult: LongInt); &VAR )name: STR255; &BEGIN )theMenu := HiWord(mResult); theItem := LoWord(mResult); )CASE theMenu OF ,appleMenu: /BEGIN /GetItem(myMenus[1],theItem,name); /refNum := OpenDeskAcc(name); /END; ,fileMenu: doneFlag := TRUE; { Quit } )END; { of menu case } )HiliteMenu(0); &END; { of DoCommand } #BEGIN { main program } &InitGraf(@thePort); &InitFonts; &FlushEvents(everyEvent,0); &InitWindows; &SetUpMenus; &InitDialogs(NIL); &SetCursor(arrow); &SetRect(dragRect,4,24,508,338); &SetRect(growRect,100,60,512,302); &doneFlag := FALSE; &InitCursor; &InitIcons; &theWindow := GetNewWindow(256,@wRecord,POINTER(-1)); &SetPort(theWindow); &theWindow^.txFont := 2; &ResizePRect; &vScroll := GetNewControl(256,theWindow); &hScroll := GetNewControl(257,theWindow); &theOrigin.h := 0; theOrigin.v := 0; &REPEAT )SystemTask; )temp := GetNextEvent(everyEvent,myEvent); )CASE myEvent.what OF ,mouseDown: /BEGIN /code := FindWindow(myEvent.where,whichWindow); /CASE code OF 2inMenuBar: DoCommand(MenuSelect(myEvent.where)); 2inSysWindow: SystemClick(myEvent,whichWindow); 2inDrag: DragWindow(whichWindow,myEvent.where,dragRect); 2inGoAway: 5IF TrackGoAway(whichWindow,myEvent.where) THEN 8doneFlag := TRUE; 2inGrow: 5IF whichWindow=FrontWindow THEN 8GrowWnd(whichWindow) 5ELSE 8SelectWindow(whichWindow); 2inContent: 5BEGIN 5IF whichWindow<>FrontWindow THEN 8SelectWindow(whichWindow) 5ELSE 8BEGIN {front} 8GlobalToLocal(myEvent.where); 8IF NOT PtInRect(myEvent.where,pRect) THEN ;BEGIN {controls} ;MyControl := FindControl(myEvent.where,whichWindow, TwhichControl); ;CASE MyControl OF >inUpButton: At := TrackControl(whichControl,myEvent.where, S@ScrollUp); >inDownButton: At := TrackControl(whichControl,myEvent.where, S@ScrollDown); >inPageUP: PageScroll(MyControl,-10); >inPageDown: PageScroll(MyControl,10); >inThumb: ABEGIN At := TrackControl(whichControl,myEvent.where, FNIL); AScrollBits AEND ;END {Case MyControl} ;END {controls} 8END {front} 5END {in Content} /END; { of code case } /END; { of mouseDown } ,activateEvt: /BEGIN /SetPort (theWindow); /DrawGrowIcon(theWindow); /IF ODD(myEvent.modifiers) THEN { window is becoming active } 2BEGIN 2ShowControl(vScroll); 2ShowControl(hScroll); 2END /ELSE 2BEGIN 2HideControl(vScroll); 2HideControl(hScroll) 2END /END; { of activateEvt } ,updateEvt: /BEGIN /BeginUpdate(theWindow); /EraseRect (theWindow^.portRect); /DrawWindow(theWindow); /EndUpdate(theWindow); /END { of updateEvt } )END { of event case } &UNTIL doneFlag #END. 3. "6F^5D!$ǐ^K* QDsampleR -- Resource input for sample application named QDSample * Written by Macintosh Technical Support Example/QDSample.Rsrc Type MENU ",1 "\14 ",256 "File $Quit Type WIND ",256 "QuickDraw Example "50 40 300 450 "Visible GoAway "0 "0 Type CNTL ",256 "vertical scroll bar "-1 395 236 411 "Visible "16 "0 "0 0 50 ",257 "horizontal scroll bar "235 -1 251 396 "Visible "16 "0 "0 0 50 Type CODE "Example/QDSampleL,0 3. "6F^5D!$ǐ^Y,,{$X-} {$R-} PROGRAM Scroll; {------------------------------------------------------------------------------------ %This is a simple program to demonstrate how to use scroll bars. %You can scroll text or graphics or both. %You can scroll horizontally or vertically. %By Cary Clark, Macintosh Technical Support Apple Computer Inc., 1984 ------------------------------------------------------------------------------------} USES &{$U-} &{$U Obj/MemTypes } MemTypes, &{$U Obj/QuickDraw } QuickDraw, &{$U Obj/OSIntf } OSIntf, &{$U Obj/ToolIntf } ToolIntf; CONST &Horizontal = 1; {These are the choices in the menu 'Scroll Bar'} &Vertical = 2; &TextItem = 4; &Graphics = 5; &FileMenu = 1; {Resource numbers and position in the Menu bar} &ScrollMenu = 2; &NumOfRects = 30; {quantity of rectangles and strings to scroll around} &NumOfStrings = 55; TYPE &MyRectData = Array [1..NumOfRects] of Rect; {Graphics structure; } &MyRectPtr = ^MyRectData; { an array of rectangles} &MyRectHdl = ^MyRectPtr; VAR &hTE: TEHandle; {TextEdit handle} &hScroll, {Horizontal scroll bar} &vScroll: ControlHandle; {Vertical scroll bar} &MyWindow: WindowPtr; {Document window} &hdlScrollMenu: MenuHandle; {Handle to the menu items} &MyRect: MyRectHdl; {Handle to array of rectangles} &originalPart: INTEGER; {1st part of the scroll bar hit} &PageCorner, {Location of the upper left hand page corner} &EventPoint: Point; {Where an event took place} &MyViewRect: Rect; {display rectangle containing scrollable data} &doneFlag, {Set TRUE when the user selects 'Quit'} &showText, {Set TRUE when text can be scrolled} &showGraphics : BOOLEAN; {Set TRUE when graphics can be scrolled} {------------------------------------------------------------------------------------} PROCEDURE SetUpData; {This procedure initializes two data structures; a TextEdit record and an array of rectangles. Initially, only text and the vertical scrollbar will be displayed.} Var MyString : StringHandle; {Temporary container for a string in the resource fork} $counter : INTEGER; {Counters must be local to the procedure} $destRect : rect; {Rectangle containing the larger-than-the-screen page} BEGIN {The TextEdit record is initialized by reading in a string from the application's resource fork and then inserting it a number of times into the TextEdit record.} "MyString := GetString (256); {Get some text to play around with} {Set the view as the portrect less the vertical scrollbar area. The TextEdit destRect will be set to the current window width plus an arbitrary value.} "MyViewRect := MyWindow^.portrect; "destRect := MyViewRect; "destRect.right := destRect.right + 300; "PageCorner.h := -destRect.left; "PageCorner.v := -destRect.top; "MyViewRect.right := MyViewRect.right - 16; {16 = width of scrollbar} "hTE := TENew (destRect, MyViewRect); "HLock (Pointer (MyString)); {Can't move if we are going to point to the text} "For counter := 1 to NumOfStrings DO {Create a TextEdit record full of the string} $TEInsert (Pointer(Ord4(MyString^)+1),{move past the string's length byte} .Length(MyString^^), hTE); "HUnLock (Pointer (MyString));{Free to move again} {Now, create a structure of rectangles.} "MyRect := Pointer( NewHandle (Sizeof (MyRectData))); {240 bytes } "For counter := 1 to NumOfRects DO $SetRect (MyRect^^[counter], counter*23, counter*20, counter*23+50, counter*20+50); "showtext := TRUE; "showgraphics := FALSE; "ShowWindow (MyWindow); {Display the window and the text it contains} "VScroll := GetNewControl (256, MyWindow); {vertical scrollbar} "HScroll := GetNewControl (257, MyWindow); {horizontal scrollbar, not shown} "CheckItem (hdlScrollMenu, vertical, TRUE); "CheckItem (hdlScrollMenu, textItem, TRUE) END; {of SetUpData} {------------------------------------------------------------------------------------} PROCEDURE GrafUpdate(whatpart : rect); {This is roughly the equivalent of what TEUpdate does with text. The upper left hand corner of the page is moved up and to the left to simulate a view further down and to the right. To more accurately resemble a Toolbox routine like TEUpdate, this procedure should also preserve the current clip region and origin.} var count : INTEGER; $dummyRect : rect; BEGIN "SetOrigin (PageCorner.h, PageCorner.v); {negative moves the origin left, up} "OffsetRect (whatpart, PageCorner.h, PageCorner.v); {also move the update rectangle} "ClipRect (whatpart); {only redraw the portion that the user requests} "FOR count := 1 to NumOfRects DO {Redraw the object if it intersects the update rectangle} $IF SectRect (MyRect^^[count], whatpart, dummyRect) $THEN FrameRect(MyRect^^[count]); "SetOrigin (0,0); {reset the origin back to the upper left hand corner} "ClipRect (MyWindow^.PortRect); {reset the clip region to the entire window} END; {of GrafUpdate} {------------------------------------------------------------------------------------} PROCEDURE ScrollBits; {This routine scrolls horizontally and vertically both graphics and text. If you are only scrolling text, only the TEScroll is required. If you are only scrolling graphics, then only the ScrollRect and GrafUpDate is needed.} VAR vChange, hChange, vScrollValue, hScrollValue: INTEGER; $AnUpdateRgn: RgnHandle; BEGIN "vScrollValue := GetCtlValue (vScroll); {these values will be used a lot so they are} "hScrollValue := GetCtlValue (hScroll); {read into local (temporary) variables} {find the vertical and horizontal change} "vChange := PageCorner.v - vScrollValue; {the vertical difference} "hChange := PageCorner.h - hScrollValue; {the horizontal difference} {record the values for next time} "PageCorner.v := vScrollValue; "PageCorner.h := hScrollValue; {for pure text, only a TEScroll is required} "IF showText AND NOT showGraphics THEN TEScroll (hChange, vChange, hTE); {For graphics, a ScrollRect will move the visible bits on the screen. The region returned by ScrollRect indicates what part of the window needs to be updated.} "IF showGraphics THEN "BEGIN $AnUpdateRgn := NewRgn; $ScrollRect (MyViewRect, hChange, vChange, AnUpdateRgn); {This draws the new text. The clipping is necessary because normally TextEdit redraws the entire character height and perhaps only a partial character scroll was done. Since TextEdit erases before it draws, the text, if any, is drawn before the graphics.} $IF showText THEN WITH hTE^^.destrect DO $BEGIN &left := -hScrollValue; &top := -vScrollValue; &ClipRect (AnUpdateRgn^^.rgnbbox); &TEUpdate (AnUpdateRgn^^.rgnbbox, hTE); &ClipRect (MyWindow^.portrect) $END; {of showText} $GrafUpdate (AnUpdateRgn^^.rgnbbox); {This fills in the newly exposed region} $DisposeRgn (AnUpdateRgn) "END {of showGraphics} END; {of ScrollBits} {------------------------------------------------------------------------------------} PROCEDURE TrackScroll(theControl: ControlHandle; partCode: INTEGER); {This routine adjusts the value of the scrollbar. A reasonable change would be to adjust the minimum scroll amount to equal the text's lineheight.} Var amount, StartValue : INTEGER; $up : BOOLEAN; BEGIN "up := partcode IN [inUpButton, inPageUp]; {TRUE if scrolling page up} "StartValue := GetCtlValue (theControl); {the initial control value} "IF {the scrollbar value is decreased, and it is not already at the minimum} %((up AND (StartValue > GetCtlMin (theControl))) "OR {the scrollbar value is increased, and it is not already at the maximum} %((NOT up) AND (StartValue < GetCtlMax (theControl)))) "AND {to prevent tracking as the page up or down area disappears} %(originalPart = partCode) "THEN "BEGIN $IF up THEN amount := -1 ELSE amount := 1; {set the direction} $IF partCode IN [inPageUp, inPageDown] THEN $BEGIN &{change the movement to a full page} &WITH MyViewRect DO &IF theControl = VScroll &THEN amount := amount * (bottom - top) &ELSE amount := amount * (right - left) $END; {of partCode} $SetCtlValue(theControl, StartValue+amount); $ScrollBits "END END; {of TrackScroll} {------------------------------------------------------------------------------------} PROCEDURE MyControls; {respond to a mouse down event in one of the controls} Var dummy: INTEGER; $theControl: ControlHandle; BEGIN "originalPart := FindControl (EventPoint, MyWindow, theControl); {returns control and part} "IF originalPart = inThumb THEN "BEGIN ${Thumb is tracked until it is released; then the bits are scrolled} $dummy := TrackControl (theControl, EventPoint, NIL); $ScrollBits "END {of whichpart} "{for the arrows and the page changes, scroll while the mouse is held down} "ELSE dummy := TrackControl (theControl, EventPoint, @TrackScroll) END; {of Mycontrols} {------------------------------------------------------------------------------------} PROCEDURE MainEventLoop; {respond to menu selections, the scrollbars, and update events} VAR myEvent: EventRecord; {All of the information about the event} $menuStuff: RECORD CASE INTEGER OF &1 : (menuResult : LONGINT); {Information returned by MenuSelect} &2 : (theMenu, {Which menu was selected} +theItem : INTEGER) {Which item within the menu} $END; {of menuStuff} $checked : BOOLEAN; {Is the menu item checked} $MarkChar : Char; {The checkmark character} $tempWindow: WindowPtr; $tempRect : Rect; BEGIN "REPEAT $checked := GetNextEvent(everyEvent,myEvent); {checked here is ignored} $CASE myEvent.what OF $mouseDown: &BEGIN {the user pressed or is holding the mouse button down} (CASE FindWindow(myEvent.where,tempWindow) OF *inMenuBar: WITH menuStuff DO *BEGIN {the mouseDown was in the menu bar} ,menuResult := MenuSelect (myEvent.where); ,CASE theMenu OF .FileMenu: doneFlag := TRUE; { Quit } .ScrollMenu: .BEGIN {The items in the menu are used to keep track of the user has chosen thus far. These lines toggle the checkmark in the menu and leave the result in the variable checked.} 0GetItemMark (hdlScrollMenu, theItem, markChar); 0checked := markChar <> Chr(checkmark); 0CheckItem (hdlScrollMenu, theItem, checked); {Any selection will cause some part of the screen to be redrawn. The selection that the user makes causes some part of the screen to become invalid.} 0IF (theItem = textItem) OR (theItem = graphicsItem) 0THEN InvalRect(MyViewRect); 0CASE theItem OF 2horizontal: 2BEGIN 4InvalRect (HScroll^^.contrlrect); 4IF checked THEN 4BEGIN 6ShowControl(HScroll); 6MyViewRect.bottom := HScroll^^.contrlrect.top 4END {checked} 4ELSE 4BEGIN {not checked} 6HideControl(HScroll); 6MyViewRect.bottom := HScroll^^.contrlrect.bottom 4END {not checked} 2END; {horizontal} 2vertical: 2BEGIN 4InvalRect (VScroll^^.contrlrect); 4IF checked THEN 4BEGIN 6ShowControl(VScroll); 6MyViewRect.right := VScroll^^.contrlrect.left 4END {checked} 4ELSE 4BEGIN {not checked} 6HideControl(VScroll); 6MyViewRect.right := VScroll^^.contrlrect.right 4END {not checked} 2END; {vertical} 2textItem: WITH hTE^^.destrect DO {since we have dereferenced the destrect, no calls in the scope of this WITH should cause a memory compaction} 2BEGIN 4showText := checked; 4IF checked then 4BEGIN 6top := -GetCtlValue(vScroll); 6left := -GetCtlValue(hScroll); 4END {of checked} 2END; {of textItem} 2GraphicsItem: showGraphics := checked; 0END; {of CASE} .If showText THEN hTE^^.viewrect := MyViewRect .END {of inMenuBar} ,END; {of FindWindow CASE} ,HiliteMenu(0) *END; {of mouseDown} (inContent: {The rectangles making up the controls are the part of the window outside the 'view'} *BEGIN ,EventPoint := MyEvent.where; ,GlobalToLocal (EventPoint); ,IF NOT PtInRect (EventPoint, MyViewrect) THEN MyControls *END {in Content} (END {of CASE} &END; {of mouseDown} $updateEvent: {In response to InvalRects, the appropriate text or graphics is erased and redrawn. The BeginUpdate causes the VisRgn to be replaced by the intersection of the VisRgn and the UpdateRgn.} &BEGIN (BeginUpdate (MyWindow); (EraseRect (MyViewRect); {start with a clean slate} (IF showText THEN TEUpdate (MyWindow^.VisRgn^^.Rgnbbox, hTE); {Call GrafUpdate with the intersection, if any, of the VisRgn and the view} (IF showGraphics AND SectRect (MyWindow^.VisRgn^^.Rgnbbox, MyViewRect, *tempRect) THEN GrafUpdate (tempRect); (EndUpdate (MyWindow) &END {of updateEvent} $END {of event CASE} "UNTIL doneflag END; {------------------------------------------------------------------------------------} BEGIN "InitGraf (@ThePort); {initialize QuickDraw} "InitWindows; {initialize Window Manager; clear desktop and menubar} "InitFonts; {initialize Font Manager} "FlushEvents (everyEvent, 0); {throw away any stray events} "TEInit; {initialize TextEdit} "InitMenus; {initialize Menu Manager} "hdlScrollMenu := GetMenu(FileMenu); {(hdlScrollMenu is ignored)} "InsertMenu (hdlScrollMenu,0); "hdlScrollMenu := GetMenu(ScrollMenu); "InsertMenu (hdlScrollMenu,0); "DrawMenuBar; "DoneFlag := FALSE; {user 'Quit' flag} "MyWindow := GetNewWindow (256, NIL, Pointer (-1)); {get window to work within} "SetPort (MyWindow); {point to window} "TextFont (applFont); {select default application font} "SetUpData; {initialize user data and controls} "InitCursor; {change the watch into an arrow} "MainEventLoop {handle events until we are through} END. $IF EXISTS(CONCAT(%8, %0, '.TEXT')) THEN $$IF NOT(EXISTS(CONCAT(%8, %0, '.OBJ'))) THEN ($SET %9 TO 'T' $$ELSEIF NEWER(CONCAT(%8, %0, '.TEXT'), CONCAT(%8, %0, '.OBJ')) THEN ($SET %9 TO 'T' $$ENDIF $ENDIF $ $IF %9 = 'T' THEN $WRITELN CONCAT('Compile: ', %8, %0, '.TEXT') P{ascal}%8%0 reuse G{enerate}$M+ reuse %8%0 $ENDIF $ $ $SET %6 TO '' $SET %9 TO 'F' $IF EXISTS(CONCAT(%8, %0, '.TEXT')) THEN $$SET %6 TO CONCAT(%8, %0, '.OBJ') $$IF EXISTS(CONCAT(%8, %0, 'L.OBJ')) THEN ($IF NEWER(CONCAT(%8, %0, '.TEXT'), CONCAT(%8, %0, 'L.OBJ')) THEN ,$SET %9 TO 'T' ($ENDIF $$ELSE ($SET %9 TO 'T' $$ENDIF $ENDIF $ $IF %9 = 'F' THEN $$IF EXISTS(CONCAT(%8, %1, '.TEXT')) THEN ($IF %6 = '' THEN ,$SET %6 TO CONCAT(%8, %1, '.OBJ') ($ENDIF ($IF EXISTS(CONCAT(%8, %0, 'L.OBJ')) THEN ,$IF NEWER(CONCAT(%8, %1, '.TEXT'), CONCAT(%8, %0, 'L.OBJ')) THEN 0$SET %9 TO 'T' ,$ENDIF ($ELSE ,$SET %9 TO 'T' ($ENDIF $$ENDIF $ENDIF $ $ $IF %9 = 'T' THEN L{ink}%6 %7obj/quickDraw %7obj/tooltraps %7obj/ostraps %7obj/prlink %7obj/packtraps %7obj/macpaslib %7obj/sane %7obj/saneasm %7obj/elems %7obj/elemsasm $$IF EXISTS(CONCAT(%8, %1, '.TEXT')) THEN ($IF CONCAT(%8, %1, '.OBJ') <> %6 THEN %8%1.obj ($ENDIF $$ENDIF %8%0L.OBJ $ENDIF $ $ R{un}%7RMaker %8%2 $ $ R{un}%7MacCom R{emove example/}Y FYL%8%0.RSRC %0.RSRC APPL{set type to APPL} {set creator to ????} N{o bundle bit}E{ject}QF{iler}D{elete}reuse.I Y{es}Q{uit} $ENDEXEC INITICON INITICONINITICON NVA/Hz zfA/Hz fA/HzfA/HzXfA/HzfA*/HzܨfAB/HzfAZ/Hz`fAr/HzTfA/HzHfA/Hz fA/Hz̨fA/HzfA/HzPfA/HzfN^NuNITICONf000203FF01600002000001C00002000001800003FFFFFF000000201FE01560002000001AC0002000001580002020101B0000020000013500020000016B000201FE01D50002010201AB000000380000300000680000700000D80000D0003FFFFFF1B0000000000000000000000000000000000000000001FFFFFF00000000000000000000000000000000000000000000000000000A00002B00000BFFFFEE00000800000C00000FFFFFF8000000A00002AC0000A08082D40000A0FF82AC0000A00002D800000A00002AC0000A07F02D40000A04102AC0000A07F02D400000A00002AC0000BFFFFED40000800000AC0000BFFFFED400000A00002AC0000A08082D40000A0FF82AC0000A00002D4000004000006C0000FFFFFFD40000800000AC0000BFFFFED40000007FFFFFC00000800000C00001000001C000020000034000040000000B80040000000F00040000000E0007FFFFFFFC00006B000000AB807FC000FFD70040600180AE00403FFF00DC00040000000AB807FFFFFFFD5806AC00000AB8055800000D580040600180AB80403FFF00D58040000000AB8040000000D58000D7FFFFFFB801AC000003580358000006B807FC000FFD580000E00000018001A00000038003600000078006A000000D800000000000000000000000000000000000000007FFFFFFF000784249258E70003049233100000E000E40800001FFFC3F00932524924C82A44524924D01C88524924CF10C4524924C090000524024C00000524924C00600524924C0090E524924C7C0000500004C000005259A4C000005250A4C00000525FA4C0000033E3801C0000180E002C00000FF801CC0000047FFE0C0000010064FE0000031199830000020E6301800002418E00800000013849800000026C4980000004C09300000008612600000000001FC000000000E0600000000300300000000C091800008000000001C0C000000003807FFFFFFFFF0007800001E00008000000001AC87F000000158841000CCC1B087F000CCC160018000000006B3000000000D77FFFFFFFFFABC0000000035600184000013870327FFFFF10F06400000021B0CFFFFFFFC3700004000010000004A54510000004000017FE00F4A515100300002000008400004454510400004000017C00004A5151000000000000000000007FFFFF000000800002800001115144400800000000980FFFFFFFFF300800000001600FFFFFFFFFC00018000000013832AAAAA8A9F0655555515380C2AAAA82A580008000000004307FFFFFFFFA30100000000260FFFFFFFFE2C01200000BF923120000080F2312000008002311FFFFF000230120000080F23120000080023120000080023120000080F23018000000004311FFFFF00023120000080F231200000BF923000600000000601800000000B0600000000130FFFFFFFFFA30000000000000000000000000000000000000001FFFFFFFFC DRAWICON DRAWICONDRAWICONNV0. ACA-H=|HnBgBg?<0?< AC AC Hn?. ?.Hn mHhHnHn?<BN^ _\ONRAWICONDRAWSTUF DRAWSTUFDRAWSTUF DRAWICONDRAWICONvf(QUICKDRA @NVHA/Hz֨fBg?<?<?<Bg?<?<?<Bg?<?<?<Bg?<?<?<?<?<?<?<k?<?<?<?<kBg?<?<Hz,?<P?<"Hz?:?<F?<7Hz?:?<F?<FHzب?:Ш?<F?<UHz?:?<F?<dHz?:?<F?<sHzv?:n?<J?<"HzX?<?<?<?<(?<?<?<?<#?<?<(?<?<?<?<.?<?<(?< ?<Hm䨝?<?<=?<?<(?<?< Hn樝?<?<P?<?<(?<0?<"HzHn?<?<(?<:?<FHnHn?<?<?<?<HnHnHn?<?<HnHn?<?<HnHm䨥HnHn?<?<HnHn樥Hn?<F?<HzHn?<?<?<Z?<Hn?<?<Hn?<?<?<?<Hn?<?<Hn?<?<Hn?<?<Hn?<?<Hn?<?<Hn?<?<Hm䨴Hn?<?<Hn?<?<Hn?<?<Hn樴Hn?<?<?<@?<Hz Bg?< ?<N?<?<P?<N?<?<?<N?<?< ?<N?<?<P?<N?<?<?<N?<:?<3. "6F^5D!$ǐ^T* example/showpaintR -- Resource file example/showPaint.Rsrc Type CODE #example/showpaintl,0 56N1N^!wn .А S-@ALCR 0 <-@Bn-|AB1/.HnL/.BHnHn?.<N j nJPn|%-n=|=nBn`-nH nHBXRni 0.no/.?.?<NlVddSTXTX2-CI"jLxx2-CISTAR^ÆdSTART.TEXTTRàØZN^øO`O`XX0T{$R-} {$X-} PROGRAM SoundDemo; "{ Program to play with the new proto sound } "{ written by Andy Hertzfeld Oct 3, 1982 } "{ modified for 4 voice ROM sound -- Nov 2, 1982 } "{ for ROM 4T -- Jun 18, 1983 } "{ made to run under ToolBox, OSInterfc -- Jan 8, 1983 } "{ changes for new interfaces -- Jun 26, 1984 } "{ Historical note: since this program was written a long, long time ago, %please note that the programming style is a little strange in places. } #USES {$U-} &{$U Obj/Memtypes } Memtypes, &{$U Obj/QuickDraw } QuickDraw, &{$U Obj/OSIntf } OSIntf, &{$U Obj/ToolIntf } ToolIntf, &{$U Obj/Sane } SANE, &{$U Obj/Elems } Elems; #VAR &tempRect: Rect; &mousePt,myPt: Point; &myEvent: EventRecord; &theFolder: WindowPtr; &doneFlag: Boolean; &theMenu,theItem: INTEGER; &code: INTEGER; &whichWindow: WindowPtr; &whichControl: ControlHandle; &folRect: Rect; &mBox: Rect; &dial1,dial2,dial3,dial4: ControlHandle; &dialV: ControlHandle; &fullRect: Rect; &UserVol: Integer; &soundTblPtr: FTSynthPtr; &MySoundRec: FTSoundRec; {fixed size, so no reason to allocate on heap} &MySynthRec: FTSynthRec; {fixed size, so no reason to allocate on heap} &wave1,wave2,wave3,wave4, sinWave: Wave; &t,I: INTEGER; &waveWindow,topWindow: WindowPtr; &whichWave: INTEGER; &myMenu,menu2,menu3,deskMenu: MenuHandle; &mResult: LongInt; &title1,title2,title3,title4: Str255; &offSwitch: Boolean; &myString: Str255; &refNum: INTEGER; #PROCEDURE SetUpMenus; #{once only initialization for menus} &VAR )I: INTEGER; )menuFile: Text; )drvrType: ResType; &BEGIN )InitMenus; {initialize Unit Menus} )drvrType := 'DRVR'; )myMenu := GetMenu(256); )menu2 := GetMenu(257); )menu3 := GetMenu(258); )deskMenu := GetMenu(1); )AddResMenu(deskMenu,drvrType); )InsertMenu(deskMenu,0); )InsertMenu(myMenu,0); )InsertMenu(menu2,0); )InsertMenu(menu3,0); )DrawMenuBar; &END; #PROCEDURE MakeTheFolder; #{ set up and draw one folder } &VAR )tempRect: Rect; )folName: Str255; )tempPt: Point; &BEGIN )theFolder := GetNewWindow(1,NIL,NIL); )waveWindow := GetNewWindow(2,NIL,theFolder); )topWindow := theFolder; &END; #PROCEDURE MakeTheDials; &VAR )tempRect: Rect; &BEGIN )SetRect(mBox,120,30,280,46); )dial1 := NewControl(theFolder,mBox,' ',TRUE,0,0,8191,ScrollBarProc,1); )SetRect(mBox,120,60,280,76); )dial2 := NewControl(theFolder,mBox,' ',TRUE,0,0,8191,ScrollBarProc,2); )SetRect(mBox,120,90,280,106); )dial3 := NewControl(theFolder,mBox,' ',TRUE,0,0,8191,ScrollBarProc,3); )SetRect(mBox,120,120,280,136); )dial4 := NewControl(theFolder,mBox,' ',TRUE,0,0,8191,ScrollBarProc,4); )SetRect(mBox,76,160,256,192); )dialV := NewControl(theFolder,mBox,' ',TRUE,7,0,7,ScrollBarProc,5); &END; #PROCEDURE LabelControls; &BEGIN )MoveTo(30,42); )DrawString('Channel A'); )MoveTo(30,72); )DrawString('Channel B'); )MoveTo(30,102); )DrawString('Channel C'); )MoveTo(30,132); )DrawString('Channel D'); )MoveTo(140,208); )DrawString('Volume'); &END; #PROCEDURE Triangle(VAR theWave: Wave); #{ make a simple triangle wave } &VAR )I: INTEGER; &BEGIN )FOR I := 0 TO 127 DO ,BEGIN ,theWave[I] := 2*I; ,theWave[255-I] := 2*I; ,END; &END; #FUNCTION sineval (period: INTEGER): INTEGER; #CONST Increment = 3.14159*2/256; {2 pi = waveform period; 256 samples} #VAR newval, holder: extended; #BEGIN &I2X (period, newval); &S2X (Single(Increment), holder); &MulX (holder, newval); &SinX (newval); &I2X (128, holder); &MulX (holder, newval); &AddX (holder, newval); &X2I (newval, period); &sineval := period; #END; #PROCEDURE buildSinWave; #VAR Index : Integer; &BEGIN )SetRnd (Downward); )For Index := 0 to 255 DO ,BEGIN /SinWave[Index] := sineval (Index); ,END; &END; #PROCEDURE mysine(VAR sine: Wave); #BEGIN &Sine := sinWave; #END; #PROCEDURE Square(VAR theWave: Wave); #{ make a simple square wave } &VAR )I: INTEGER; &BEGIN )FOR I := 0 TO 127 DO ,BEGIN ,theWave[I] := ord (255); { ord() is needed because of compiler bug, Gfixed in version 3.0 } ,theWave[255-I] := 0; ,END; &END; #PROCEDURE CopyWave(VAR src,dst: Wave); &VAR )I: INTEGER; &BEGIN )FOR I := 0 TO 255 DO dst[I] := src[I]; &END; #PROCEDURE InitSTab; &VAR )l: LongInt; &BEGIN )WITH soundTblPtr^.sndRec^ DO ,BEGIN ,duration := 8192; ,l := 256; ,sound1Rate := l*GetCtlValue(dial1); ,sound1Phase := 0; ,sound2Rate := l*GetCtlValue(dial2); ,sound2Phase := 0; ,sound3Rate := l*GetCtlValue(dial3); ,sound3Phase := 0; ,sound4Rate := l*GetCtlValue(dial4); ,sound4Phase := 0; ,sound1Wave := @wave1; ,sound2Wave := @wave2; ,sound3Wave := @wave3; ,sound4Wave := @wave4; ,END &END; #PROCEDURE SetPitch(voiceIndex: INTEGER; pitch: INTEGER); &VAR )l: LongInt; &BEGIN )l := 256; )WITH soundTblPtr^.sndRec^ DO ,BEGIN ,CASE voiceIndex OF /1: sound1Rate := l*pitch; /2: sound2Rate := l*pitch; /3: sound3Rate := l*pitch; /4: sound4Rate := l*pitch ,END ,END &END; #PROCEDURE BumpDial(whichControl: ControlHandle; amount: INTEGER); &VAR )v: INTEGER; &BEGIN )v := GetCtlValue(whichControl)+amount; )SetCtlValue(whichControl,v); )If whichControl = dial1 THEN ,SetPitch(1,v) )ELSE If whichControl = dial2 THEN ,SetPitch(2,v) )ELSE If whichControl = dial3 THEN ,SetPitch(3,v) )ELSE If whichControl = dial4 THEN ,SetPitch(4,v) )ELSE ,BEGIN /If v < 0 then v := 0 /Else If v > 7 then v := 7; /SetsoundVol(v) ,END &END; #PROCEDURE ScrollUp(whichControl: ControlHandle; theCode: INTEGER); &BEGIN )IF theCode=inUpButton THEN BumpDial(whichControl,-1); &END; #PROCEDURE ScrollDown(whichControl: ControlHandle; theCode: INTEGER); &BEGIN )IF theCode=inDownButton THEN BumpDial(whichControl,1); &END; #PROCEDURE PageUp(whichControl: ControlHandle; theCode: INTEGER); &BEGIN )IF theCode=inPageUp THEN ,IF whichControl<>dialV THEN /BumpDial(whichControl,-200) ,ELSE /BumpDial(whichControl,-1) &END; #PROCEDURE PageDown(whichControl: ControlHandle; theCode: INTEGER); &BEGIN )IF theCode=inPageDown THEN ,IF whichControl<>dialV THEN /BumpDial(whichControl,200) ,ELSE /BumpDial(whichControl,1); &END; #PROCEDURE DrawTheWave(theWave: Wave); &VAR )I,J: INTEGER; &BEGIN )EraseRect(thePort^.portRect); )FOR I := 0 TO 255 DO ,BEGIN ,J := 255-theWave[I]; ,SetRect(tempRect,I,J,I+1,J+1); ,PaintRect(tempRect); ,END; &END; #PROCEDURE DrawWaveFolder; &BEGIN )SetPort(waveWindow); )CASE whichWave OF )1: ,DrawTheWave(wave1); )2: ,DrawTheWave(wave2); )3: ,DrawTheWave(wave3); )4: DrawTheWave(wave4) )END {case} &END; #PROCEDURE SetNewPt(VAR theWave: Wave; myPt: Point); &VAR )h,v,J: INTEGER; &BEGIN )h := myPt.h; v := myPt.v; )IF (h<0) OR (h>255) THEN EXIT(SetNewPt); )IF (v<0) OR (v>255) THEN EXIT(SetNewPt); )IF v=theWave[h] THEN EXIT(SetNewPt); )J := 255-theWave[h]; )SetRect(tempRect,h,J,h+1,J+1); )EraseRect(tempRect); )tempRect.top := v; tempRect.bottom := tempRect.top+1; )PaintRect(tempRect); )theWave[h] := 255-v; &END; #PROCEDURE EditTheWave(VAR theWave: Wave); &VAR )lastX,lastY: INTEGER; )I: INTEGER; )thePt: Point; &BEGIN )GetMouse(myPt); )lastX := myPt.h; lastY := myPt.v; )WHILE StillDown DO ,BEGIN ,GetMouse(myPt); ,IF myPt.h=lastX THEN /SetNewPt(theWave,myPt) ,ELSE IF myPt.hmyPt.h; /END; ,lastX := myPt.h; lastY := myPt.v; ,END; &END; #PROCEDURE EditWaveForm; &BEGIN )SetPort(waveWindow); )CASE whichWave OF )1: ,EditTheWave(wave1); )2: ,EditTheWave(wave2); )3: ,EditTheWave(wave3); )4: EditTheWave(wave4) )END {case} &END; #PROCEDURE ChangeTheWave(which: INTEGER; VAR theWave: Wave); &BEGIN )CASE which OF )1: ,Triangle(theWave); )2: ,Square(theWave); )3: ,mysine(theWave); )4: ,CopyWave(wave1,theWave); )5: ,CopyWave(wave2,theWave); )6: ,CopyWave(wave3,theWave); )7: CopyWave(wave4,theWave) )END; {case} )DrawWaveFolder; &END; #PROCEDURE ChangeWave(which: INTEGER); &BEGIN )CASE whichWave OF )1: ,ChangeTheWave(which,wave1); )2: ,ChangeTheWave(which,wave2); )3: ,ChangeTheWave(which,wave3); )4: ChangeTheWave(which,wave4) )END {case} &END; #PROCEDURE InitWave; &BEGIN )Triangle(wave1); )Square(wave2); )mysine(wave3); )Triangle(wave4); &END; #BEGIN &InitGraf(@thePort); &InitFonts; &FlushEvents(everyEvent,0); &InitWindows; &SetUpMenus; &SetRect(fullRect,0,20,512,342); &title1 := 'Channel A WaveForm'; &title2 := 'Channel B WaveForm'; &title3 := 'Channel C WaveForm'; &title4 := 'Channel D WaveForm'; &buildSinWave; &MakeTheFolder; &SetPort(theFolder); &MakeTheDials; &LabelControls; &GetSoundVol (UserVol); {save and restore--hope user doesn't use control panel} &doneFlag := FALSE; &SoundTblPtr := @MySynthRec; &SoundTblPtr^.mode := ftMode; &SoundTblPtr^.sndRec := @MySoundRec; &InitWave; &DrawWaveFolder; &SetsoundVol(0); {minimize pop} &InitSTab; &StartSound(Pointer(soundTblPtr),SizeOf (FTSynthRec),NIL); &SetsoundVol(7); &offSwitch := FALSE; &whichWave := 1; &CheckItem(myMenu,1,TRUE); &InitCursor; &REPEAT )SystemTask; )soundTblPtr^.sndRec^.duration := 8192; )IF GetNextEvent(everyEvent,myEvent) THEN ,CASE myEvent.what OF /mouseDown: 2BEGIN 2code := FindWindow(myEvent.where,whichWindow); 2myPt := myEvent.where; 2WITH whichWindow^.portBits.bounds DO 5BEGIN 5myPt.h := myPt.h+left; 5myPt.v := myPt.v+top; 5END; 2Case code of 2inMenuBar: 5BEGIN 5theMenu := 0; theItem := 0; {???} 5mResult := MenuSelect(myEvent.where); 5theMenu := HiWord(mResult); theItem := LoWord(mResult); 5IF (theItem>0) THEN 8CASE theMenu OF 8256: ;BEGIN ;CheckItem(myMenu,whichWave,FALSE); ;CheckItem(myMenu,theItem,TRUE); ;IF whichWave<>theItem THEN >BEGIN >CASE theItem OF >1: ASetWTitle(waveWindow,title1); >2: ASetWTitle(waveWindow,title2); >3: ASetWTitle(waveWindow,title3); >4: SetWTitle(waveWindow,title4) >END; {case} >whichWave := theItem; >DrawWaveFolder; >END ;END; 8257: ;ChangeWave(theItem); 8258: ;IF offSwitch THEN >BEGIN >StartSound(Pointer(soundTblPtr), ISizeOf (FTSynthRec),NIL); >offSwitch := FALSE; >SetItem(menu3,1,'Sound Off'); >END ;ELSE >BEGIN >GetSoundVol (I); >SetSoundVol (0); {minimize pop} >StopSound; >SetSoundVol (I); {restore volume} >offSwitch := TRUE; >SetItem(menu3,1,'Sound On'); >END; 81: ;BEGIN ;GetItem(deskMenu,theItem,myString); ;refNum := OpenDeskAcc(myString) ;END 8END; {case} 5HiLiteMenu(0); 5END; { onMenuBar } 2inDesk: 5BEGIN 5END; 2inDrag: 5DragWindow(whichWindow,myEvent.where,fullRect); 2inGoAway: 5BEGIN 5IF TrackGoAway(whichWindow,myEvent.where) THEN 8doneFlag := TRUE; 5END; 2inSysWindow: 5SystemClick(myEvent,whichWindow); 2inContent: 5BEGIN 5IF topWindow<>whichWindow THEN 8BEGIN 8SelectWindow(whichWindow); 8topWindow := whichWindow; 8END 5ELSE IF whichWindow=waveWindow THEN 8EditWaveForm 5ELSE 8BEGIN 8code := FindControl(myPt,whichWindow,whichControl); 8CASE code OF 8inUpButton: ;t := TrackControl(whichControl,myPt,@ScrollUp); 8inDownButton: ;t := TrackControl(whichControl,myPt,@ScrollDown); 8inPageUp: ;t := TrackControl(whichControl,myPt,@PageUp); 8inPageDown: ;t := TrackControl(whichControl,myPt,@PageDown); 8inThumb: ;BEGIN ;code := TrackControl(whichControl,myPt,NIL); ;BumpDial(whichControl,0); ;END 8END {case} 8END 5END 2END {of case code} /END; { of button down } /updateEvt: 2BEGIN 2whichWindow := WindowPtr(myEvent.message); 2SetPort(whichWindow); 2BeginUpdate(whichWindow); 2IF whichWindow=waveWindow THEN 5DrawWaveFolder 2ELSE 5BEGIN 5DrawControls(whichWindow); 5LabelControls; 5END; 2EndUpdate(whichWindow); 2END; {of update event} /OTHERWISE 2BEGIN 2END; ,END; { of event case } &UNTIL doneFlag; &SetSoundVol (0); &StopSound; &SetSoundVol (UserVol); #END. HzHn?<?<?<?<Hn?<?<AHmԨHn?<?<HnHn?<J?<KHmHn?<?<Hn?<BgHn?<-?<Z?<P?<HzB(_?<?<"?<?<?<2?< ?<Z?< ?<P?<?<_?<"?<?<"/ / ?<?<?<?</ / / ?<?</ / ?<?<Ψ/ Hm/ / ?<?</ Hn/ / ?<@?<Hz:B&_ڨHn?<?<?<?<^Hn?<?<?<?<O?<E?<?<w?<O?<?<OHn?<m?<?<?<EHn/ / ?<D?<HzHn?<?<?<:?<&HnHn?<?<?<?<HnHnHn?<?<HnHn?<?<HnHm䨻HnHn?<?<HnHn樻HnLN^NuRAWSTUFOvalsRegionsPolygonsArcsBitMaps RoundRects RectanglesLinesShadowOutline UnderlineItalicBoldText%Look what you can draw with QuickDraw8040200002040800MOVESCRO MOVESCROMOVESCRONV/ mI/-X/-0,|?0S@?Y/-?<0,T| ?\/-W/-X/-0,S@?0,|?Y/-0,l| ??<\/-W(_N^NuOVESCRORESIZEPR RESIZEPRRESIZEPRQUICKDRABNV mCA""0-|;@0-|;@N^NuESIZEPR:GROWWND GROWWND GROWWND RESIZEPRRESIZEPRMOVESCROMOVESCRO~NVH(nB/ /-Hm+.Jf`Bg/j<Bg/k:AC 0.|=@Hn(AC 0.|=@Hn(/ ??<NNAC 0.|=@Hn(AC 0.|=@Hn(LN^.NuROWWND ԀDRAWWIND DRAWWINDDRAWWINDDRAWSTUFDRAWSTUFnNV mHh{/-B$ -f/-i mCA""0.|=@0.|=@Hn?-?-Hn{?-?-xNBgBgx mHh{N^.NuRAWWINDSCROLLBI SCROLLBISCROLLBIDRAWSTUFDRAWSTUFNV-mBg/-`0@;@Bg/-`0@;@0.m=@0.m=@B+_Hm?.?./-?-?-x m PHh?-?- m PHh{N/-BgBgx mHh{N^NuCROLLBISCROLLUP SCROLLUPSCROLLUPSCROLLBISCROLLBI">NV nf/. Bg/. `0S@?cNN^ _\ONCROLLUP6SCROLLDO SCROLLDOSCROLLDOSCROLLBISCROLLBI">NV nf/. Bg/. `0R@?cNN^ _\ONCROLLDO6PAGESCRO PAGESCROPAGESCROSCROLLBISCROLLBI6\NVHnrBg/-/.f0n f/-Bg/-`0._?cNBgs gN^.NuAGESCROTSETUPMEN SETUPMENSETUPMENhNV/0B?<+_/-/:BMB?<+_~`0S@A @/5Bg5RG Go7.N^NuETUPMENDRVR`DOCOMMAN DOCOMMANDOCOMMAN%_SRCHK %_SRCHK HvNVBg/.j;_Bg/.k;_0-S@g@g*`./-?-HnFBgA?<N/;_`|Bg8N^.NuOCOMMANnQDSAMPLE zQDSAMPLEQDSAMPLE%_END %_END %_TERM %_TERM DRAWWINDDRAWWINDSCROLLBISCROLLBITPAGESCROPAGESCRO<.SCROLLDOSCROLLDOSCROLLUPSCROLLUPGROWWND GROWWND DOCOMMANDOCOMMAN0RESIZEPRRESIZEPRINITICONINITICONpSETUPMENSETUPMEN0FLUSHEVEFLUSHEVE*INITGRAFINITGRAF%_INIT %_INIT %_BEGIN %_BEGIN QUICKDRA8NNV,_NUNA/N?B/-ة=N`"Hm/-`/-/-Hm%`Bg/-/-ةg|`B$ -f /-N`/-`B$ -g /-`HmبqBg/-Hm設 gBg/-/-Hml;_0-@gS@g(S@g 7 then v := 7; /SetsoundVol(v) ,END &END; #PROCEDURE ScrollUp(whichControl: ControlHandle; theCode: INTEGER); &BEGIN )IF theCode=inUpButton THEN BumpDial(whichControl,-1); &END; #PROCEDURE ScrollDown(whichControl: ControlHandle; theCode: INTEGER); &BEGIN W^g5P:H r^-{ Copyright 1983, 1984 by Apple Computer 8Mike Boich 8Martin P. Haeberli } {$I NewSerial/TrmSwtch } { Compile switches and constants } Unit Ascii; Interface Const "CtlNul = 0; "CtlSOH = 1; "CtlSTX = 2; "CtlETX = 3; "CtlEOT = 4; "CtlENQ = 5; "CtlACK = 6; "CtlBel = 7; "CtlBS = 8; "CtlHT = 9; "CtlLF = 10; "CtlVT = 11; "CtlFF = 12; "CtlCR = 13; "CtlSO = 14; "CtlSI = 15; "CtlDLE = 16; "CtlDC1 = 17; "CtlDC2 = 18; "CtlDC3 = 19; "CtlDC4 = 20; "CtlNAK = 21; "CtlSyn = 22; "CtlETB = 23; "CtlCan = 24; "CtlEM = 25; "CtlSub = 26; "CtlEsc = 27; "CtlFS = 28; "CtlGS = 29; "CtlRS = 30; "CtlUS = 31; "AscSpace = 32; "AscExclamation = 33; "AscDQuote = 34; "AscSharp = 35; "AscDollar = 36; "AscPercent = 37; "AscAmpersand = 38; "AscSQuote = 39; "AscLParen = 40; "AscRParen = 41; "AscAsterisk = 42; "AscPlus = 43; "AscComma = 44; "AscMinus = 45; "AscPeriod = 46; "AscSlash = 47; "Asc0 = 48; "Asc1 = 49; "Asc2 = 50; "Asc3 = 51; "Asc4 = 52; "Asc5 = 53; "Asc6 = 54; "Asc7 = 55; "Asc8 = 56; "Asc9 = 57; "AscColon = 58; "AscSemicolon = 59; "AscLessThan = 60; "AscEquals = 61; "AscGrtrThan = 62; "AscQuestion = 63; "AscAt = 64; "AscCapA = 65; "AscCapB = 66; "AscCapC = 67; "AscCapD = 68; "AscCapE = 69; "AscCapF = 70; "AscCapG = 71; "AscCapH = 72; "AscCapI = 73; "AscCapJ = 74; "AscCapK = 75; "AscCapL = 76; "AscCapM = 77; "AscCapN = 78; "AscCapO = 79; "AscCapP = 80; "AscCapQ = 81; "AscCapR = 82; "AscCapS = 83; "AscCapT = 84; "AscCapU = 85; "AscCapV = 86; "AscCapW = 87; "AscCapX = 88; "AscCapY = 89; "AscCapZ = 90; "AscLSquare = 91; "AscBackSlash = 92; "AscRSquare = 93; "AscCircumflex = 94; "AscUnderline = 95; "AscGrave = 96; "AscLowA = 97; "AscLowB = 98; "AscLowC = 99; "AscLowD = 100; "AscLowE = 101; "AscLowF = 102; "AscLowG = 103; "AscLowH = 104; "AscLowI = 105; "AscLowJ = 106; "AscLowK = 107; "AscLowL = 108; "AscLowM = 109; "AscLowN = 110; "AscLowO = 111; "AscLowP = 112; "AscLowQ = 113; "AscLowR = 114; "AscLowS = 115; "AscLowT = 116; "AscLowU = 117; "AscLowV = 118; "AscLowW = 119; "AscLowX = 120; "AscLowY = 121; "AscLowZ = 122; "AscLCurly = 123; "AscVBar = 124; "AscRCurly = 125; "AscTilde = 126; "AscDel = 127; "AscNull = 255; Implementation End. 5 P:H r^NB[[rV; File: Async.Text ;_______________________________________________________________________ ; ; MacIntosh Operating System: SCC Async Driver ; ; written by Larry Kenyon 05-Aug-82 ; ; Copyright (c) 1982, 1983 by Apple Computer ; ; This is a ROM-based driver for the SCC serial ports; it supports full duplex ; asynchronous mode RS-232/RS-422 communication on both SCC ports. ; ; This driver uses four device control blocks: two per port, one input and ; one output. The input and output "drivers" are closely associated: ; control and status routines are the same for input and output ; drivers; the open, close and prime routines differ. The reason for using two ; device control blocks for one port is simply to support the general full-duplex ; communication capability of the SCC. ; ; Both ports must be opened for full duplex operation. ; ; Note that any accesses to the SCC have to be done in an interrupt-disabled ; environment. ; ; Currently, hardware (CTS) and XON/XOFF output flow control are supported; ; XON/XOFF input flow control is also supported. The driver defaults at ; initialization to hardware handshake only; XON/XOFF handshaking must be ; enabled by a control call. ; ; Break always terminates current input requests, but not output requests. ; Parity errors, overruns, and framing errors optionally terminate input requests. ; An IODrvrEvent is optionally posted at break and/or hardware handshake status ; changes (use of this option is discouraged due to the long time interrupts ; are disabled when posting such an event). ; ; MODIFICATION HISTORY: ; ; 20 Sep 82 LAK fixed output a-port bug (no SCC address adjust) and input ; glitch. ; 25 Sep 82 LAK fixed software, hardware handshakes; hardware handshake now ; defaults on. ; 29 Sep 82 LAK output prime routine now checks for TBE before sending first ; character to the SCC. ; 07 Nov 82 LAK BPL->BNE in SCC init routine; removed SCCAWr5,SCCBWr5 setup ; (not needed for 512 machine); open now preserves interrupt ; state. ; 31 Oct 82 AJH changed headers for new driver model ; 01 Nov 82 AJH made OPEN/CLOSE lock/unlock the driver's storage ; 15 Dec 82 AJH changed the header format again ; 20 Jan 83 LAK changed for new i/O parameter formats. ; 09 Mar 83 LAK fixed problem with lowering interrupt level. ; 07 Apr 83 LAK integrated with disk polling of port A. Uses clock ram ; data to set default options. ; 21 Apr 83 LAK changed control, status call numbers from 1-n to 8-n; config ; control call now takes compressed data like stored in clk ; parameter ram; changed driver names to .AIn,.AOut,.BIn,.BOut ; 26 Apr 83 LAK status call 2 now is used to return bytes available. ; 28 Apr 83 LAK added some delays when accessing SCC (to maintain 2usec ; between each access) ; 07 Jun 83 LAK added set and clear break control codes. ; 10 Jun 83 LAK fixed SCIntHnd to read RR1 before reading data; no longer ; resets error condition (not needed in the mode we use). ; 09 Aug 83 LAK driver now allocates its own memory at open time and ; disposes it at close time. ; 14 Aug 83 LAK now calls IODone, Fetch, and Stash via vectors; SCC ; initialization is done according to Zilog spec. ; CTS and break change status optionally posted as ; events. ; 17 Aug 83 LAK added XON/XOFF input flow control. ; 23 Aug 83 LAK fixed a switcheroo in status call. ; 26 Aug 83 LAK added lastSetup var: if control call tries resetting baud ; rate, etc., to same value, it's just ignored (avoids ; resetting the SCC and glitching the line). Also zero ; D0 for immediate returns from prime routines (be clean). ; 28 Aug 83 LAK status call 2 now zeroes high word of byte count. ; 04 Sep 83 LAK special condition receiver now issues error reset command ; in case it has too (documentation may be wrong and it can't ; hurt . . .). ; 10 Sep 83 LAK fixed bug in outgoing XOn/XOff code (Move.B to A0 changed ; to D0). ;------------------------------post ship fixes . . . ; ; 19 Oct 83 LAK fixed two bugs in XOn/XOff input flow control. ; 08 Dec 83 LAK reset ext/sts ints, not CRC checker in init, close routines. ; 25 Jan 84 LAK,MPH Improve reset code in close routines to keep mouse happy. ; 03 Feb 84 VxV Fix SCIntHnd to inhibit abort input if user desires. ;_______________________________________________________________________ ,.NoList ,.INCLUDE tlasm/SysEqu.Text ; general system equates ,.INCLUDE tlasm/SysErr.Text ,.INCLUDE tlasm/SysMacs.Text ,.List ,.PROC Async,0 ,.DEF AsyncAIn,AsyncAOut,AsyncBIn,AsyncBOut PortAVars .EQU SerialVars ; serial port A variables and buffer AInDCE .EQU PortAVars+4 ; Device Control Entry ptr for input PortBVars .EQU AInDCE+4 ; serial port B variables and buffer BInDCE .EQU PortBVars+4 ; Device Control Entry ptr for input ; next come variable offsets within the user's local variable buffer OutDCE .EQU 0 ;(4) long DCE pointer for output driver SCCOffset .EQU 4 ;(2) word of SCC offset . . . InBufPtr .EQU 6 ;(4) pointer to local input buffer BufSize .EQU 10 ;(2) size of local input buffer BufLow .EQU 12 ;(2) low buf byte count to send XOn BufHigh .EQU 14 ;(2) bytes from end of buffer to send XOff SWHS .EQU 16 ;(1) software handshake enable HWHS .EQU 17 ;(1) hardware handshake enable XONChar .EQU 18 ;(1) input char which stops output (SWHS) XOFFChar .EQU 19 ;(1) input char which continues output Options .EQU 20 ;(1) bit 4 = abort on parity error H; bit 5 = abort on overrun H; bit 6 = abort on framing error PostOptions .EQU 21 ;(1) bit 7=1 enables posting break changes H; bit 5=1 enables posting handshake changes InSWHS .EQU 22 ;(1) input XOn/XOff flow control enable SendXOnff .EQU 23 ;(1) flag to xmit logic to send XOn/XOff AsyncErr .EQU 24 ;(1) error indications (cumulative) SoftOR .EQU 0 ; bit 0 = soft overrun H; bit 4 = parity error H; bit 5 = overrun error H; bit 6 = framing error FlowOff .EQU 25 ;(1) 80 = input flow shut off ReadCmd .EQU 26 ;(1) FF = read command pending WriteCmd .EQU 27 ;(1) FF = write command pending CTSFlag .EQU 28 ;(1) FF = CTS asserted XOFFlag .EQU 29 ;(1) FF = XOFF pending Free1 .EQU 30 ;(1) Free2 .EQU 31 ;(1) SCCReset .EQU 32 ;(1) WR9 value for reset StopBits .EQU 33 ;(1) stop bits/parity option (WR4 value) WR1AVal .EQU 34 ;(1) first WR1 value to write WR3AVal .EQU 35 ;(1) first WR3 value to write WR5AVal .EQU 36 ;(1) first WR5 value to write BaudLoCnst .EQU 37 ;(2) 2 byte baud rate constant (WR12-13) BaudHiCnst .EQU 38 RcvrBits .EQU 39 ;(1) 1 byte receiver bits/char (WR3 value) XmitBits .EQU 40 ;(1) 1 byte xmitter bits/char (WR5 value) WReqPin .EQU 41 ;(1) w/req pin state (WR1 value) lastSetup .EQU 42 ;(2) last SCC init values . . . BufIndex .EQU 44 ;(2) index into local buffer (insert) BufOutdex .EQU 46 ;(2) index into local buffer (remove) LocalBuf .EQU 48 ;(64) local buffer for input chars LclBufSize .EQU 64 ; default input buffer size = 64 bytes LclVarSize .EQU LocalBuf+LclBufSize ; output driver storage size AsyncAIn ,.WORD $4D00 ; read, control, status, lock ,.WORD 0,0 ; not an ornament ,.WORD 0 ; no menu ,.WORD AInOpen-AsyncAIn ; Initialization routine ,.WORD AInPrime-AsyncAIn ; input Prime routine ,.WORD AControl-AsyncAIn ; shared Control routine ,.WORD AStatus-AsyncAIn ; shared Status routine ,.WORD AInClose-AsyncAIn ; Close routine ,.BYTE 4 ; channel A input driver ,.ASCII '.AIn ' AsyncAOut ,.WORD $4E00 ; wr, ctl, sts, lock ,.WORD 0,0 ; not an ornament ,.WORD 0 ; no menu ,.WORD AOutOpen-AsyncAOut ; Initialization routine ,.WORD AOutPrime-AsyncAOut ; output Prime routine ,.WORD AControl-AsyncAOut ; shared Control routine ,.WORD AStatus-AsyncAOut ; shared Status routine ,.WORD AOutClose-AsyncAOut ; Close routine ,.BYTE 5 ; channel A output driver ,.ASCII '.AOut' AsyncBIn ,.WORD $4D00 ; read, control, status, lock ,.WORD 0,0 ; not an ornament ,.WORD 0 ; no menu ,.WORD BInOpen-AsyncBIn ; Initialization routine ,.WORD BInPrime-AsyncBIn ; input Prime routine ,.WORD BControl-AsyncBIn ; shared Control routine ,.WORD BStatus-AsyncBIn ; shared Status routine ,.WORD BInClose-AsyncBIn ; Close routine ,.BYTE 4 ; channel B input driver ,.ASCII '.BIn ' AsyncBOut ,.WORD $4E00 ; wr, ctl, sts, lock ,.WORD 0,0 ; not an ornament ,.WORD 0 ; no menu ,.WORD BOutOpen-AsyncBOut ; Initialization routine ,.WORD BOutPrime-AsyncBOut ; output Prime routine ,.WORD BControl-AsyncBOut ; shared Control routine ,.WORD BStatus-AsyncBOut ; shared Status routine ,.WORD BOutClose-AsyncBOut ; Close routine ,.BYTE 5 ; channel B output driver ,.ASCII '.BOut' ;________________________________________________________________________ ; ; Routine: Open routines ; ; Arguments: A1 (input) -- DCE pointer for this driver ; ; Function: These are the Open routines for the SCC async-mode drivers; ; local variables are initialized, buffer storage allocated, ; interrupt vectors installed, and the SCC initialized. For ; input drivers only the Device Control Entry pointer is noted: ; SCC initialization is done for output drivers only. ; ; An 'Open' of the RefNum associated with an output port will install ; interrupt receivers and enable interrupts for both input and ; output; two 'Open's need to be done for a port to configure input ; and output DCEs; the Open for the input driver can be done ; before or after the Open for the output driver. ; ; Channel A is treated special: the wait/req pin (chan A and B pins ; are tied together) is programmed so that it is an output which ; goes low whenever channel A has input data available. This ; output can be read via the 6522 and is used by the disk driver ; to poll for data during disk routines. If any data is accumulated, ; it is passed to the special "poll-process" routine of this ; driver. ;________________________________________________________________________ AInOpen MOVE.L A1,AInDCE ; note the DCE pointer ,RTS ; and exit BInOpen MOVE.L A1,BInDCE ; note the DCE pointer ,RTS ; and exit AOutOpen MOVEQ #8,D0 ; get secondary dispatch table offset ,LEA PortAVars,A2 ; local variables address ,LEA TAIntHnd,A3 ; get addresses of our interrupt ,LEA ExtAIntHnd,A4 ; routines ,LEA RAIntHnd,A5 ,LEA SCAIntHnd,A6 ,MOVEQ #2,D1 ; SCC read/write offsets ,MOVEQ #-9,D2 ; WR1 value ($F7) - w/req = char in ,MOVEQ #-128,D3 ; reset channel A ($80) ,MOVE.W SPPortA,D4 ,BSR.S OpenInstall ,PEA PollDtaIn ,MOVE.L (SP)+,PollProc ; this proc handles disk poll data ,RTS BOutOpen MOVEQ #0,D0 ; get secondary dispatch table offset ,LEA PortBVars,A2 ; local variables address ,LEA TBIntHnd,A3 ; get addresses of our interrupt ,LEA ExtBIntHnd,A4 ; routines ,LEA RBIntHnd,A5 ,LEA SCBIntHnd,A6 ,MOVEQ #0,D1 ; SCC read/write offset ,MOVEQ #$17,D2 ; WR1 value - w/req pin = float ,MOVEQ #64,D3 ; reset channel B ($40) ,MOVE.W SPPortB,D4 ; D0 = ExtIntDT offset A0 = open parameter block ptr (not used) ; D1 = SCC read/write offset A1 = DCE address ; D2 = WR1 value A2 = local variables pointer location ; D3 = channel reset data A3 = transmitter interrupt handler ; D4 = clk param init values A4 = External/Status interrupt handler ; A5 = receiver interrupt handler ; A6 = special-receiver condition rupt handler OpenInstall LEA ExtStsDT,A0 ; install secondary and primary ,MOVE.L A4,0(A0,D0) ; interrupt handlers ,LEA Lvl2DT,A0 ; get dispatch table address ,ADD D0,D0 ; offset is 2x smaller table offset ,MOVE.L A3,0(A0,D0) ,MOVEM.L A5-A6,8(A0,D0) ,MOVEQ #LclVarSize,D0 ,_NewHandle ,SYS,CLEAR ; get local storage on system heap H; clear errors, error options H; read, write, XOFF and CTS flags H; index, outdex, inSWHS H; HWHS, SWHS, XONChar, XOFFChar ,BSET #Lock,(A0) ; lock it down ,MOVE.L A0,DCtlStorage(A1) ; save handle in our storage pointer ,MOVE.L (A0),(A2) ; save pointer in lo-mem ,MOVE.L (A0),A2 ; and get the pointer ,MOVE.L A2,A3 ; locals pointer ,MOVE.L A1,(A3)+ ; output DCE pointer ,MOVE.W D1,(A3)+ ; SCC channel address offset ,BSR InstllLBuf ; install our local buffer ,ST HWHS(A2) ; HWHS defaults on ,ST Options(A2) ; abort input on errors also defaults on ,MOVE.B D3,SCCReset(A2) ; channel reset data ,MOVE.B D2,WReqPin(A2) ; WR1 value for SCC initialization ToInitSCC ,MOVE.W D4,lastSetup(A2) ; remember this config ,LEA StopBits(A2),A3 ,LEA InitDefs,A4 ; process clock data ,MOVEQ #7,D0 ; expand into 8 bytes variable data @1 MOVE.B (A4)+,D1 ; rotate left count ,MOVE.W D4,D3 ; clock pram data ,ROL.W D1,D3 ; get appropriate bits into low byte ,AND.B (A4)+,D3 ; only keep relevant bits ,OR.B (A4)+,D3 ; add in constant bits ,MOVE.B D3,(A3)+ ; store processed data ,DBRA D0,@1 ; do all 8 bytes ,MOVEQ #$64,D1 ; get WR1A mask ,AND.B (A3),D1 ; form value ,MOVE.B D1,WR1AVal(A2) ; and store ,BSR.S InitSCC ; initialize SCC channel ,MOVEQ #0,D0 ; no errors ,RTS ;___________________________________________________________; ; ; ; D4 = [V][V][W][W][X][X][Y][Y] [Z][Z][Z][Z][Z][Z][Z][Z] ; ; ; ; VV = 1,2,3, for 1,1.5,2 stop bits (00 for AppleBus) ; ; WW = 0,1,2,3 for no,odd,no,even parity ; ; XX = 0,1,2,3, for 5,7,6,8 data bits ; ; YY = high byte of baud rate constant, low 2 bits ; ; ZZZZZZZZ = low byte of baud rate constant ; ;___________________________________________________________; InitDefs .BYTE 4,$0F,$40 ; (WR4) rotate left 4, leave 4 low bits, add $40 ,.BYTE 0,$00,$00 ; (WR4) (dummy entry - WR1AVal will go here) ,.BYTE 12,$C0,$00 ; (WR3) WR3 - first write ,.BYTE 11,$60,$02 ; (WR5) WR5 - first write ,.BYTE 0,$FF,$00 ; (WR12) baud constant, low byte ,.BYTE 8,$03,$00 ; (WR13) baud constant, hi byte ,.BYTE 12,$C0,$01 ; (WR3) WR3 - final value ,.BYTE 11,$60,$0A ; (WR5) WR5 - final value ;________________________________________________________________________ ; ; Routine: SCC Initialize Routine ; ; Arguments: A2 (input) -- pointer to local variables for this port ; ; Function: This routine initializes one port of the SCC for asynchronous ; communication; the baud rate, data bits, stop bits, and parity ; options are set according to local variable values. The channel ; is reset before options are configured. The baud-rate generator ; output is used for both transmitter and receiver clocks, and ; interrupts are enabled: only DCD and Break external ; interrupts are enabled; all transmitter and receiver interrupts ; are enabled. Parity errors are configured to generate special ; condition vectors. ; ; Other: Registers A0-A3 are used. ; ; Modification History: ; 10-Apr-83 LAK WR9 and WR1 are initialized from variable data (WR9 init is ; no longer treated specially; WR1 variable init allows ; w/req pin to behave differently for channels A and B). ;________________________________________________________________________ ;___________________________________________________________________; ; ; ; initialization data for SCC: RS-232 async communication: ; ; FORMAT: data,register# - for immediate data ; ; register#,$FF - for variable data ; ;___________________________________________________________________; InitData .BYTE 9,$FF ; reset SCC channel ,.BYTE 4,$FF ; x16 clk, stop bits, parity options ,.BYTE 1,$FF ; WR1 reg, first write ,.BYTE $00,2 ; zero interrupt vector ,.BYTE 3,$FF ; bits/char option rcvr ,.BYTE 5,$FF ; bits/char option xmitter ,.BYTE $02,9 ; status in low bits ,.BYTE $50,11 ; br gen clk to rcvr, xmitter ,.BYTE 12,$FF ; set baud rate low byte ,.BYTE 13,$FF ; set baud rate high byte ,.BYTE 3,$FF ; enable rcvr ,.BYTE 5,$FF ; enable xmitter ,.BYTE $01,14 ; enb baud rate generator from RTxC pin ,.BYTE $A8,15 ; Break, DCD, CTS external interrupts ,.BYTE $10,0 ; reset ext/status twice ,.BYTE $10,0 ,.BYTE 1,$FF ; w/req pin configuration ,.BYTE $0A,9 ; enable interrupts, status in low bits InitLth .EQU *-InitData ; InitSCC LEA InitData,A3 ; get pointer to init data ,MOVEQ #InitLth,D1 ; and init length InitSCC1 MOVE SR,-(SP) ; save interrupt state ,MOVEM.L A0-A2,-(SP) ,MOVE.W SCCOffset(A2),D2 ; get SCC offset ,MOVEM.L SCCRd,A0-A1 ; and get SCC addresses ,ADD.W D2,A0 ; add in offset ,ADD.W D2,A1 ,ORI #$0300,SR ; disable all but debug interrupts ,MOVE.B (A0),D2 ; read to make sure SCC is sync'ed up ,LEA SCCReset(A2),A2 ; point to data we will need NextReg MOVE.W (A3)+,D0 ; get next init data, reg ,TST.B D0 ,BPL.S @1 ; bit 7=1 means get variable init data ,MOVE.B (A2)+,D0 ; get variable data ,ROR.W #8,D0 ; adjust to [data][ptr] format @1 MOVE.B D0,(A1) ; write register pointer ,ROR.W #8,D0 ,MOVE.L (SP),(SP) ; delay ,MOVE.B D0,(A1) ; write register ,SUBQ.W #2,D1 ,BGT.S NextReg ,MOVE.B (A0),D2 ; read SCC register 1 ,LSL.B #2,D2 ; use this data to set CTS flag ,MOVEM.L (SP)+,A0-A2 ,SMI CTSFlag(A2) ; ,RTE ; restore interrupt state and return ;________________________________________________________________________ ; ; Routine: Close routines ; ; Arguments: A1 (input) -- DCE pointer for this driver ; ; Function: These are the Close routines for the SCC async-mode drivers; ; the SCC channel is reset and configured for only external/status ; DCD interrupts and interrupt vectors are replaced with ; the default RTE vector. Input drivers simply RTS. ; ; The master interrupt enable register should not have to be ; written with $0A again since only the channel is reset (not ; the entire SCC). ; ; Modification History: ; 10-Apr-83 LAK AOutClose zeroes PollProc vector (change for disk polling). ;________________________________________________________________________ ResetData .BYTE 9,$FF ; reset SCC channel ,.BYTE $08,15 ; only DCD (mouse) ext/sts interrupts ,.BYTE $10,0 ; reset ext/status twice ,.BYTE $10,0 ,.BYTE $01,1 ; only external/status interrupts ,.BYTE $0A,9 ; enable interrupts, status in low bits ResetLth .EQU *-ResetData AOutClose CLR.L PollProc ; no more poll-data process routine ,LEA Lvl2DT+16,A4 ; get dispatch table address ,LEA ExtStsDT+8,A5 ; and secondary dispatch table ,MOVE.L PortAVars,A2 ; local variables address ,BRA.S ABClose BOutClose LEA Lvl2DT,A4 ; get dispatch table address ,LEA ExtStsDT,A5 ; and secondary dispatch table ,MOVE.L PortBVars,A2 ; local variables address ABClose ; should have a wait here for last character to clear the buffer ,; except that close is not really used in the normal course of ,; operation . . . ,LEA ResetData,A3 ,MOVEQ #ResetLth,D1 ,BSR.S InitSCC1 ,LEA BInClose,A3 ,MOVE.L A3,(A4) ; and reinstall default interrupt ,MOVE.L A3,(A5) ; receivers (just RTS) ,ADDQ.L #8,A4 ,MOVE.L A3,(A4)+ ,MOVE.L A3,(A4) ,MOVE.L DCtlStorage(A1),A0 ; get storage handle ,_DisposHandle ; get rid of it ,CLR.L DCtlStorage(A1) ; without a trace ,CLR.L (A2) AInClose BInClose RTS ;________________________________________________________________________ ; ; Routine: Status routines ; ; Arguments: A0 (input) -- pointer to Status parameter block: ; (0) Header ; (12) Completion routine ; (16) IOResult code ; (24) RefNum ; (26) Opcode ; (28) Parameters ; A1 (input) -- DCE pointer for this driver ; ; Function: For operation code 8, 3 words of status information are ; returned: ; (28) cumulative errors: ; bit 0 = soft overrun (local buffer overflow) ; bit 4 = parity error ; bit 5 = hard overrun error ; bit 6 = framing error ; (29) 80 = input flow shut off ; (30) read command pending flag ; (31) write command pending flag ; (32) XOFF flag ; (33) CTS flag ; ; For operation code 2, 1 longword of status information is ; returned: ; (28) buffered bytes available ; ; Other opcodes are not implemented. ; ; Modification History: ; 10 Apr 83 LAK Switched CTS and XOFF flag locations. ; 21 Apr 83 LAK Changed opcode number 1 to number 8; reports error for ; other opcodes. ; 26 Apr 83 LAK Opcode 2 is now used to return available buffer bytes. ;________________________________________________________________________ AStatus MOVE.L PortAVars,A2 ; local variables address ,BRA.S Status BStatus MOVE.L PortBVars,A2 ; local variables address Status LEA CSCode(A0),A0 ; get pointer to return parameters ,MOVEQ #StatusErr,D0 ; assume unimplemented code error ,MOVEQ #2,D1 ,SUB.W (A0)+,D1 ; opcode 2? ,BNE.S @1 ; br if not ; opcode 2 is a standard system code used to return a longword count of ; available bytes in the driver buffer (if any) ,BSR GetBufRegs ,BSR GetBufCnt ,CLR.W (A0)+ ; high word is zero . . . ,MOVE.W D0,(A0) ; load bytes-in-buffer parameter ,BRA.S @2 ; exit with 0 result code @1 ADDQ.W #6,D1 ; opcode 8? ,BNE.S StsExit ; exit with error if not ,MOVE.W AsyncErr(A2),(A0)+ ; get errors, flow off flag ,CLR.B AsyncErr(A2) ; and reset indicators ,MOVE.L ReadCmd(A2),(A0)+ ; read, write, CTS, XOFF flags @2 MOVEQ #0,D0 ; set zero error code StsExit toIODone MOVE.L JIODone,-(SP) ; go to IODone (A1 must point ,RTS ; to the DCE and D0 = IOResult) ;________________________________________________________________________ ; ; Routine: Control routines ; ; Arguments: A0 (input) -- pointer to Control parameter block: ; (0) Header ; (12) Completion routine ; (16) IOResult code ; (24) RefNum ; (26) Opcode ; (28) Parameters ; A1 (input) -- DCE pointer for this driver ; ; Function: These are the Control routines for the SCC async-mode drivers. ; ; Operation code 1 is the standard KillIO call: pending read ; and write requests are reset and any buffered bytes discarded. ; ; For operation code 8, the appropriate SCC channel is reset and ; reinitialized according to the new defaults. If a parameter ; is zero, the current corresponding value will not be changed: ; ; (26) [$0008] ; (28) [V][V][W][W][X][X][Y][Y] [Z][Z][Z][Z][Z][Z][Z][Z] ; ; VV = 1,2,3, for 1,1.5,2 stop bits ; WW = 0,1,2,3 for no,odd,no,even parity ; XX = 0,1,2,3, for 5,7,6,8 data bits ; YY = high byte of baud rate constant, low 2 bits ; ZZZZZZZZ = low byte of baud rate constant ; ; Opcode 9 is used to install a new buffer for input buffering (this control ; command may be given to either the input or output driver): ; a pointer to the buffer and the buffer length are passed. The ; async driver uses this buffer to store input characters when ; no input user request is pending: ; ; (26) [$0009] ; (28) [pointer to buffer] ; (32) [buffer length] - 2 bytes ; ; Opcode 10 is used to specify handshake options and other ; miscellaneous controls: ; ; (26) [$000A] ; (28) enable XON/XOFF output flow control if non-zero ; (29) enable CTS output handshake if non-zero ; (30) XON char for software handshake ; (31) XOFF char for software handshake ; (32) errors which cause abort of input requests (1 for abort): ; bit 4 = abort on parity error ; bit 5 = abort on overrun error ; bit 6 = abort on framing error ; (33) status changes which cause events to be posted ; bit 7 = post event on break status change ; bit 5 = post event on CTS change ; (34) enable XON/XOFF input flow control if non-zero ; ; Opcode 11 is used to reinitialize the SCC to clear break ; mode: ; ; (26) [$000B] ; ; Opcode 12 is used to set break mode in the SCC channel: ; ; (26) [$000C] ; ; Modification History: ; 10 Apr 83 LAK Fixed bug in setting abort options. No longer have to preserve ; A4 (done by IOCore). ; 21 Apr 83 LAK Control calls 1-3 -> 8-10; added KillIO control call 1; ; control call 9 now uses same format as for the clock chip. ; 17 Aug 83 LAK Opcode A now also controls optional event posting and ; input XOn/XOff flow control. ; 03 Feb 84 MPH Defined new opcodes to set speed only, flash tristate, ; and other magic. ;________________________________________________________________________ AControl MOVE.L PortAVars,A2 ; local variables address ,BRA.S Control BControl MOVE.L PortBVars,A2 ; local variables address Control LEA CSCode(A0),A0 ; get parameters ,MOVE.W (A0)+,D1 ; get opcode ,SUBQ.W #1,D1 ; opcode 1? ,BNE.S CtlConfig ; branch if not ,CLR.W ReadCmd(A2) ; clear ReadCmd and WriteCmd flags ,CLR.L BufIndex(A2) ; get rid of any buffered bytes ,RTS ; special direct return CtlConfig SUBQ.W #7,D1 ; opcode 8? ,BNE.S CtlBuffer ; branch if not ,MOVE.W (A0)+,D4 ; get word of configuration data ,CMP.W lastSetup(A2),D4 ; same setup? ,BEQ.S CtlGood ; then just exit ,BSR ToInitSCC ; go initialize CtlGood MOVEQ #0,D0 ; IOResult=0 for success CtlExit BRA.S toIODone ; and go to IODone (A1 must point H; to the DCE and D0 = IOResult) CtlBuffer SUBQ.W #1,D1 ; opcode 9? ,BNE.S NewOptions ; br if not ,PEA CtlGood ; end up here ,CLR.L BufIndex(A2) ; clear in and out indices ,MOVE.L (A0)+,A4 ,MOVE.W (A0),D1 ; if zero, revert to our own buffer ,BNE.S InstllABuf ; otherwise, ring in a new one . . . InstllLBuf LEA LocalBuf(A2),A4 ; use our meager local buffer for now ,MOVEQ #LclBufSize,D1 ; InstllABuf LEA InBufPtr(A2),A3 ,MOVE.L A4,(A3)+ ; ,MOVE.W D1,(A3)+ ,LSR.W #2,D1 ; set new bufmin and bufmax values ,MOVE.W D1,(A3)+ ; BufLow ,MOVE.W D1,(A3)+ ; BufHigh ,RTS NewOptions SUBQ.W #1,D1 ; opcode 10? ,BNE.S CtlBreak ; br if not ,ADD #SWHS,A2 ; point to options ,MOVE.L (A0)+,(A2)+ ; set new SWHS, HWHS, XON/XOFF chars ,MOVE.W (A0)+,(A2)+ ; errors which cause aborts (Options), and H; status changes on which to post events ,MOVE.B (A0)+,(A2) ; set new InSWHS ,BRA.S CtlGood ; exit ok CtlBreak MOVE.B Xmitbits(A2),D0 ; current WR5 configuration (break cleared) ,SUBQ.W #1,D1 ; opcode 11? ,BEQ.S @1 ; br if so ,SUBQ.W #1,D1 ; opcode 12? ,BNE.S CtrlMore ; br if not ,BSET #4,D0 ; Set break @1 BSR WrSetUp ,MOVE.B #5,(A3) ; address register 5 ,MOVE.L (SP),(SP) ; delay ,MOVE.B D0,(A3) ; set it ,BRA.S CtlGood ; exit ok CtrlMore ,SUBQ.W #1,D1 ; opcode 13? -- Set Speed Only. ,BNE.S @1 ; br if not. ,MOVE.W (A0)+,D4 ; get word of configuration data ,Clr.W lastSetup(A2) ; once we set speed explicitly, H; force all config commands to do setting. ,Move.B D4,BaudLoCnst(A2) ; ,ROR.W #8,D4 ,Move.B D4,BaudHiCnst(A2) ; ,BSR InitSCC ,BrA.S CtlGood @1 ,SUBQ.W #1,D1 ; opcode 14? ,BNE.S @2 ; br if not. ,BClr #1,D0 ,BrA.S CtlSet @2 ,SUBQ.W #1,D1 ; opcode 15? ,BNE.S CtlFlash ; br if not. ,BSet #1,D0 CtlSet ,BSR WrSetUp ,MOVE.B #5,(A3) ; address register 5 ,MOVE.L (SP),(SP) ; delay ,MOVE.B D0,(A3) ; set it ,MOVE.B D0,Xmitbits(A2) ; save new WR5 configuration ,BrA.S CtlGood ; exit ok CtlFlash ,SUBQ.W #1,D1 ; opcode 16? ,BNE.S CtrlErr ,BSet #1,D0 ; Make sure output enabled. ,BSR WrSetUp ,MOVE.B #5,(A3) ; address register 5 ,MOVE.L (SP),(SP) ; delay ,MOVE.B D0,(A3) ; set it ,BClr #1,D0 ; set output to tristate. ,Move SR,-(SP) ; save status register. ,ORI #$0300,SR ,MOVE.B #5,(A3) ; address register 5 ,MOVE.L (SP),(SP) ; delay ,MOVE.B D0,(A3) ; set it ,BSet #1,D0 ; Make sure output enabled. ,MOVE.B #5,(A3) ; address register 5 ,MOVE.L (SP),(SP) ; delay ,MOVE.B D0,(A3) ; set it ,Move (SP)+,SR ; restore status register. ,MOVE.B XmitBits(A2),D0 ; save new WR5 configuration ,MOVE.B #5,(A3) ; address register 5 ,MOVE.L (SP),(SP) ; delay ,MOVE.B D0,(A3) ; set it ,BrA.S CtlGood ; Success; return OK result. CtrlErr MOVEQ #ControlErr,D0 toIODne BRA.S CtlExit ; go IODone ;________________________________________________________________________ ; ; Routine: Output Prime routines ; ; Arguments: A1 (input) -- DCE pointer for this driver ; ; Function: The first character is loaded into the SCC. ; ; Other: ;________________________________________________________________________ AOutPrime MOVE.L PortAVars,A2 ; local variables address ,BRA.S OutPrime BOutPrime MOVE.L PortBVars,A2 OutPrime MOVE SR,-(SP) ; save interrupt state ,ORI #$0300,SR ; disable interrupts ,ST WriteCmd(A2) ; note the output command ,BSR.S CheckHandshake ; do we have handshake go-ahead? ,BNE.S goodRTE ; if not, exit until we do FetchNext BSR.S WrSetUp ,BEQ.S goodRTE ; exit if transmit buffer is still full ,MOVE.B SendXOnff(A2),D0 ; send XON or XOFF? ,CLR.B SendXOnff(A2) ; clear any flags ,AND.W #$00FF,D0 ; send one? (clear high bits if so) ,BNE.S @1 ; br if so ,MOVE.L JFetch,A0 ,JSR (A0) ; otherwise, get it from user buffer @1 MOVE.B D0,SCCData(A3) ; start it out ,TST.W D0 ; only one? ,BMI.S resetWrCmd ; if so, we've had a good finish goodRTE MOVEQ #0,D0 ; 0 for clean async immediate result ,RTE ; (redundant for xmit interrupt) resetWrCmd CLR.B WriteCmd(A2) ; no more pending output ,MOVE (SP)+,SR ; restore interrupt state GoodFinish MOVEQ #0,D0 ; IOResult=0 for success ,BRA.S toIODne ; and go to IODone (A1 must point H; to the DCE and D0 = IOResult) WrSetUp MOVE.L SCCRd,A3 ; get SCC read address ,ADD SCCOffset(A2),A3 ,BTST #TXBE,(A3) ; check for TBE ,ADD.L #SCCWrite,A3 ; form SCC base write address @1 RTS ;________________________________________________________________________ ; ; Routine: TXIntHnd ; ; Arguments: A0 (input) -- port A/B control read address ; A1 (input) -- port A/B control write address ; ; Function: This routine handles SCC transmitter interrupts for ; both ports; data is sent when available, IODone called ; if necessary, ; ; Other: Includes handshake check routine which is also used by ; Output Prime routine. ;________________________________________________________________________ CheckHandshake ,TST.B SWHS(A2) ; XON/XOFF handshake? ,BEQ.S @1 ; if not, check for hardware handshake ,TST.B XOFFlag(A2) ; do we have a pending XOFF? ,BNE.S @2 ; if so, we're not ok to xmit @1 TST.B HWHS(A2) ; hardware handshake? ,BEQ.S @3 ; if not, we're ok ,TST.B CTSFlag(A2) ; read current hardware handshake ,BEQ.S @3 ; if asserted, we're ok @2 MOVEQ #1,D0 ; not ok flag ,RTS @3 MOVEQ #0,D0 ; ok flag ,RTS TBIntHnd MOVE.L PortBVars,A2 ; get appropriate variables (port B) ,BRA.S TXIntHnd ; go to shared code TAIntHnd MOVE.L PortAVars,A2 ; get appropriate variables (port A) TXIntHnd TST.B SendXOnff(A2) ; need to send a handshake byte? ,BNE.S SendNextChar ; br if so . . . ,TST.B WriteCmd(A2) ; output request finished? ,BEQ.S ResetTXInt ; then just reset this one ,BSR.S CheckHandshake ; handshake ok? ,BNE.S ResetTXInt ; if not, exit and wait until it is SendNextChar ,MOVE.L OutDCE(A2),A1 ; get DCE pointer for Fetch ,MOVE.W SR,-(SP) ; fake out prime routine ,BRA.S FetchNext ResetTXInt MOVE.B #$28,(A1) ; reset interrupt for last byte out ,RTS ; and return from interrupt ContOut CLR.B XOFFlag(A2) ; come here if we got an XON ContOut1 TST.B WriteCmd(A2) ; come here for XON or CTS high ,BNE.S SendNextChar ; if no output request, just exit OutputRTS RTS ; otherwise, wait for the interrupt ;________________________________________________________________________ ; ; Routine: Input Prime routines ; ; Arguments: A1 (input) -- DCE pointer for this driver ; ; Function: Get characters from local buffer, if any (satisfy request ; possibly). Note the input request. ; ; Modifications: ; 09 Mar 83 LAK Save previous interrupt state: don't force it low since ; we may be called here by IODone during disk poll data ; unload. ; 17 Aug 83 LAK Send XOn if input flow control is enabled and conditions ; are right. ;________________________________________________________________________ AInPrime MOVE.L PortAVars,A2 ; local variables address ,BRA.S InPrime BInPrime MOVE.L PortBVars,A2 InPrime BSR.S GetBufRegs ; load D1, D2, D3, and A3 FeedBufLoop ,MOVE SR,-(SP) ,ORI #$0300,SR ; disable SCC interrupts ,CMP BufIndex(A2),D2 ; indices equal means we're through ,BEQ.S @3 ,MOVE.B 0(A3,D2.W),D0 ; get the next byte ,ADDQ #1,D2 ; bump outdex ,CMP D3,D2 ; wrap it if we're at buffer limit ,BNE.S @1 ,MOVEQ #0,D2 @1 MOVE D2,BufOutdex(A2) ; update out index ,BSR.S toStash ; stash into user's buffer ,MOVE (SP)+,SR ; let interrupts in at this point ,TST.W D0 ; done with request? ,BPL.S FeedBufLoop ; go again if we're not done ,BSR.S CkFlowOn ,BRA.S GoodFinish ; and pay a visit to IODone @3 ST ReadCmd(A2) ; note the input command ,BRA.S CkFlow1 ; (should probably check break status H; here before noting command . . .) CkFlowOn MOVE SR,-(SP) ,ORI #$0300,SR ; disable SCC interrupts CkFlow1 TST.B InSWHS(A2) ; handshaking enabled? ,BEQ.S @1 ; exit if not ,BSR.S GetBufRegs ,BSR.S GetBufCnt ; get current count in D0 ,CMP.W BufLow(A2),D0 ; below minimum for flow control ,BHI.S @1 ; exit if not ,BCLR #7,FlowOff(A2) ; have we sent an XOFF? ,BEQ.S @1 ; br if not ,MOVE.B XOnChar(A2),D0 ,BSR.S FlowCharOut @1 MOVEQ #0,D0 ; 0 for clean async immediate result ,RTE toStash MOVE.L JStash,-(SP) ; push the vector ,RTS ; short routine called with interrupts disabled to send an input flow ; control char if transmit buffer is empty FlowCharOut ,LEA SendXOnff(A2),A0 ; handy pointer ,TST.B (A0) ; out char already pending? ,BEQ.S @2 ; br if not @0 CLR.B (A0) ; otherwise, two opposites cancel @1 RTS @2 MOVE.B D0,(A0) ; set char to send ,BSR WrSetUp ; set up A3, see if xmit buffer is empty ,BEQ.S @1 ; exit if transmit buffer is full ,MOVE.B D0,SCCData(A3) ; start it out ,BRA.S @0 GetBufRegs MOVE.L InBufPtr(A2),A3 ,MOVE.W BufSize(A2),D3 ,MOVEM.W BufIndex(A2),D1-D2 ; get BufIndex and BufOutdex ,RTS GetBufCnt MOVE.W D1,D0 ; BufIndex ,SUB.W D2,D0 ; minus BufOutdex ,BHS.S @1 ; br if positive value ,ADD.W D3,D0 ; add BufSize to make it positive @1 RTS ;_______________________________________________________________________ ; ; Routine: PollDtaIn ; Arguments: A5.L (input) -- AVBufA pointer ; A6.L (input) -- SCC Port A Data pointer ; PollStack -- start of stack data ; This routine should be jsr'ed to, with polled input data ; on the stack (high-order bytes between current SP+4 and ; PollStack address). ; Function: Processes input data from disk driver polling. ; ; Modification History: ; 10-Apr-83 LAK New Today. ;_______________________________________________________________________ PollDtaIn MOVE.L PollStack,A4 ; start of data ,MOVE.L (SP)+,DskRtnAdr ; save return address StorData TST.B (A5) ; SCC data available? ,BMI.S @1 ,MOVE.B (A6),-(SP) ; push it on the stack ,BRA.S StorData ; get it emptied out . . . @1 CMP.L SP,A4 ; processed all data? ,BEQ.S @2 ; exit if so ,SUBQ #2,A4 ; skip over garbage byte ,MOVE.B (A4),D0 ; get next byte ,LEA PortAVars,A3 ; get appropriate variables (port A) ,LEA SCCRBase+ACtl,A0 ; and SCC pointers for RxBF routine ,LEA SCCWBase+ACtl,A1 ,BSR.S PollStash ; store it, using our RxBF routines ,BRA.S StorData @2 MOVE.L PollStack,SP ; clean up stack ,MOVE.L DskRtnAdr,-(SP) ; replace return address ,RTS ; (lower processor priority?) ;________________________________________________________________________ ; ; Routine: RXIntHnd ; ; Arguments: A0 (input) -- port A/B control read address ; A1 (input) -- port A/B control write address ; ; Function: This routine handles SCC receiver interrupts for ; both ports; the data is read and stashed, IODone called ; if necessary. ;________________________________________________________________________ RBIntHnd LEA PortBVars,A3 ; get appropriate variables (port B) ,BRA.S RXIntHnd ; go to shared code RAIntHnd LEA PortAVars,A3 ; get appropriate variables (port A) RXIntHnd MOVE.B SCCData(A0),D0 ; get the data byte PollStash MOVE.L (A3)+,A2 ; get pointer to local variables ,MOVE.L (A3),A3 ; and DCE pointer ,TST.B SWHS(A2) ; software handshake enabled? ,BEQ.S StashIt ; branch if not ,MOVEQ #127,D1 ; mask out high bit ,AND.B D0,D1 ,CMP.B XONChar(A2),D1 ; was this an XON? ,BEQ.S ContOut ; then start output up again ,CMP.B XOFFChar(A2),D1 ; how about an XOFF? ,BNE.S StashIt ; if not, then stash the character ,ST XOFFlag(A2) ; if so, then note it ,BRA.S InputRTS ; and exit ; stash byte in the user's buffer if a request is pending, otherwise use our own StashIt TST.B ReadCmd(A2) ; read request pending? ,BEQ.S PutInOurBuf ; if there isn't one, stash it in ours PutInUserBuf ,MOVE.L A3,A1 ; get DCE pointer ,BSR.S toStash ; use utility routine to save code ,BPL.S InputRTS ; if request isn't finished, just RTS ,CLR.B ReadCmd(A2) ; no longer a read request pending ,BRA.S GoodFinish ; otherwise, we have a good finish PutInOurBuf ,BSR.S GetBufRegs ,MOVE.B D0,0(A3,D1.W) ; stash the byte ,ADDQ.W #1,D1 ; update BufIndex ,CMP.W D3,D1 ,BNE.S @1 ; br if not at the end ,MOVEQ #0,D1 ; otherwise, reset to 0 @1 CMP.W D2,D1 ; hit the output index? ,BNE.S @2 ; br if not ,BSET #SoftOR,AsyncErr(A2); note the soft overrun ,RTS ; and exit without updating index @2 MOVE.W D1,BufIndex(A2) ; update index ,TST.B InSWHS(A2) ; XON/XOFF input flow control? ,BEQ.S InputRTS ; br if not ,BSR.S GetBufCnt ; get current buffer count in D0 ,SUB.W D0,D3 ; bytes to top ,CMP.W BufHigh(A2),D3 ; past the max limit? ,BCC.S InputRTS ; exit if not ,BSET #7,FlowOff(A2) ; already sent one? ,BNE.S InputRTS ; exit if so ,MOVE.B XOffChar(A2),D0 ,BSR FlowCharOut InputRTS RTS ;________________________________________________________________________ ; ; Routine: SCIntHnd ; ; Arguments: A0 (input) -- port A/B control read address ; A1 (input) -- port A/B control write address ; ; Function: This routine handles SCC special condition interrupts: ; these occur when an input character is received that has ; a parity error, framing error, or causes an overrun. ; If the option is set to abort on the error, the character ; is discarded and the input request (if any) aborted; otherwise, ; the error is noted and the character buffered as usual. ; ;________________________________________________________________________ SCBIntHnd LEA PortBVars,A3 ; get appropriate variables (port B) 0BRA.S SCIntHnd ; go to shared code SCAIntHnd LEA PortAVars,A3 ; get appropriate variables (port A) SCIntHnd MOVE.B #1,(A1) ; point to error reg 0MOVE.L (A3)+,A2 ; get local variables pointer 0MOVE.L (A3),A3 ; and DCE pointer (delay, too) 0MOVE.B (A0),D1 ; read the error condition 0MOVEQ #$70,D3 ; form $70 mask 0AND.B D3,D1 ; isolate error bits 0OR.B D1,AsyncErr(A2) ; accumulate errors (delay, too) 0MOVE.B SCCData(A0),D0 ; get the data byte 0MOVE.B Options(A2),D2 ; get abort options 0MOVE.B #$30,(A1) ; reset the error flag 0AND.B D1,D2 ; check abort options 0BEQ.S StashIt ; go stash it if not . . . 0TST.B ReadCmd(A2) ; if we have no pending read command 0BEQ.S InputRTS ; then just discard the character 0MOVEQ #RcvrErr,D0 ; otherwise, note the error RdReqDone MOVE.L A3,A1 ; DCE pointer 0CLR.B ReadCmd(A2) ; no longer a read request pending 0BRA toIODone ; and go to IODone (A1 must point L; to the DCE and D0 = IOResult) ;________________________________________________________________________ ; ; Routine: ExtIntHnd ; ; Arguments: A0 (input) -- port A/B control read address ; A1 (input) -- port A/B control write address ; D0 (input) -- SCC read reg 0 value ; D1 (input) -- SCC read reg 0 changed bits ; ; Function: This routine handles SCC external/status interrupts for ; both ports; mouse (DCD) interrupts are passed along to the ; mouse interrupt handler in CrsrCore. Only Break/Abort and CTS ; external interrupts are enabled (besides DCD). ; ; Note that CTS low in read reg 0 currently means that the ; hardware handshake line is asserted which means 'ok to transmit'. ;________________________________________________________________________ ExtBIntHnd LEA PortBVars,A3 ; get appropriate variables - port B 0BRA.S ExtIntHnd ; go to shared code ExtAIntHnd LEA PortAVars,A3 ; get appropriate variables - port A ExtIntHnd MOVE.L (A3)+,A2 ; get pointer to local variables 0MOVE.L (A3),A3 ; and DCE ptr in case of break abort 0MOVE.B D1,D2 ; changed bits 0AND.B postOptions(A2),D2 ; post this change? 0BEQ.S @0 ; br if not 0MOVEM.L D0/A0,-(SP) ; preserve these registers 0MOVE.W #IODrvrEvt,A0 0ASL.W #8,D0 ; make room for 'changed' values 0MOVE.B D1,D0 0SWAP D0 ; make room for driver refnum 0MOVE.W DCtlRefnum(A3),D0 0_PostEvent ; and post the event 0MOVEM.L (SP)+,D0/A0 @0 TST.B D1 ; see if it's a change in break status 0BMI.S @1 ; branch if it was a break interrupt 0LSL.B #2,D0 ; must be CTS change 0SMI CTSFlag(A2) ; set flags according to CTS 0BPL ContOut1 ; if freshly asserted, continue output 0RTS ; if not, exit for now @1 TST.B D0 ; check break level 0BMI.S @2 ; if it's asserted, terminate any input 0MOVE.B SCCData(A0),D0 ; otherwise (end of break), discard null 0RTS ; and return @2 MOVEQ #BreakRecd,D0 ; note the break 0TST.B ReadCmd(A2) ; read request pending? 0BNE.S RdReqDone ; if there is one, jump to IODone ExtIntRTS RTS ; otherwise, just return 0.END 3. "6F^5D!$ǐ^&&sM; Copyright 1983 by Apple Computer ; Mike Boich ; Martin P. Haeberli 0.Include TlAsm/SysEqu.Text 0.Include TlAsm/SysMacs.Text ;--------------------------------------------------------------------------- ; ; Procedure PushInteger(int: Integer); ; Pushes an integer on the parameter stack. Used to pass parameters to ; procedures called via CallProc *.PROC PushInteger,1 *RTS ; Return leaves argument on stack ;--------------------------------------------------------------------------- ; ; Procedure PushString(str: String); ; Pushes a string on the parameter stack. Used to pass parameters to ; procedures called via CallProc *.PROC PushString,1 *RTS ; Return leaves argument on stack ;--------------------------------------------------------------------------- ; ; Procedure PushPointer(p: Ptr); ; Pushes a pointer on the parameter stack. Used to pass parameters to ; procedures called via CallProc *.PROC PushPointer,1 *RTS ; Return leaves argument on stack ;--------------------------------------------------------------------------- ; ; PROCEDURE CallProc(a: ProcPtr); ; {calls a parameterless procedure} ; used to implement table driven dispatch from Pascal *.PROC CallProc,1 *MOVE.L (SP)+,A0 ; rtn addr *MOVE.L (SP)+,A1 ; actionProc *MOVE.L A0,-(SP) ; save rtn addr *JMP (A1) ; jmp to actionProc, which RTS's to Pascal ;--------------------------------------------------------------------------- ; PROCEDURE SetUpZone; EXTERNAL; (.PROC SetUpZone,0 (MOVE.L SP,A0 (SUB.W #$1000,A0 ; try 4K below current stack (_SetApplLimit (RTS ;--------------------------------------------------------------------------- ; PROCEDURE DebugTrap; EXTERNAL; (.PROC DebugTrap,0 (.Word $FADE (RTS *.END W^g5P:H r8^%.G.G_{ Copyright 1983 by Apple Computer 8Mike Boich 8Martin P. Haeberli } Unit PipeDefs; Interface Uses {$U obj:QuickDraw } QuickDraw, %{$U obj:OSIntf } OSIntf, %{$U obj:ToolIntf } ToolIntf; { Const "pipEscape = 255; } Type (Cardinal = 0..32767; (Index = Cardinal; (Pipe = ^PipRec; (PipRec = Record @s: Cardinal; { maximum amount of stuff } @sAvail: Cardinal; { virtual amount of stuff } @sActAv: Cardinal; { actual amount of stuff } @mark: Integer; @iNext: Index; @buf: Packed Array [Index] Of Char; :End; Function PipeOpen(s: Cardinal): Pipe; Procedure PipeClose(pip: Pipe); Function PipeSize(pip: Pipe): Cardinal; { Amount of space in pipe } Function PipeAvail(pip: Pipe): Cardinal; { Amount waiting in pipe } Function PipeGuarantee(pip: Pipe): Cardinal; { Amount of guaranteed free in pipe } Function PipeLeft(pip: Pipe): Cardinal; { Amount of space left in pipe } Function PipeGet(pip: Pipe): Integer; { Get a character from pipe } Function PipeGetMark(pip: Pipe): Integer; { Get a mark from pipe } Procedure PipePut(pip: Pipe; ch: Char); { Put a character in pipe } Procedure PipePutMark(pip: Pipe; ch: Char); { Put a mark in pipe } Procedure PipeRead(pip: Pipe; buf: Ptr; Var cnt: Cardinal); Procedure PipeWrite(pip: Pipe; buf: Ptr; Var cnt: Cardinal); Implementation End. 3. "6F^5PH rt^((%b{ Copyright 1983 by Apple Computer 8Mike Boich 8Martin P. Haeberli } Unit PipeImpl; Interface Uses {$U obj:QuickDraw } QuickDraw, %{$U obj:OSIntf } OSIntf, %{$U obj:ToolIntf } ToolIntf, %{$U PipeDefs } PipeDefs; { Const %x = 0; } { Type "TermRec = Record 1height: Integer; /End; "TermPtr = ^TermRec; } Implementation Const "lPipeRec = 10; "pipEscape = 64; { Normally 255 } Type "CharVec = Packed Array [Index] Of Char; "PCV = ^CharVec; { Var "frob: Integer; } {$SPipe} { PipeOpen(s: Cardinal): Pipe; } Function PipeOpen; Var "pip: Pipe; Begin "pip := Pointer(Ord(NewPtr(lPipeRec + s))); "If pip = Nil Then $While True Do; "pip^.s := s; "pip^.sAvail := 0; "pip^.sActAv := 0; "pip^.iNext := 0; "pip^.mark := -1; "PipeOpen := pip; End; { PipeClose(pip: Pipe); } Procedure PipeClose; Begin "If pip^.sAvail <> 0 Then $While True Do; "DisposPtr(Pointer(Ord(pip))); End; { PipeSize(pip: Pipe): Cardinal; } Function PipeSize; Begin "PipeSize := pip^.s; End; { PipeAvail(pip: Pipe): Cardinal; } Function PipeAvail; Begin "PipeAvail := pip^.sAvail; End; { PipeGuarantee(pip: Pipe): Cardinal; } { Amount of guaranteed free in pipe } Function PipeGuarantee; Begin "PipeGuarantee := (pip^.s - pip^.sActAv) div 2; End; { PipeLeft(pip: Pipe): Cardinal; } { Amount of space left in pipe } Function PipeLeft; Begin "PipeLeft := pip^.s - pip^.sActAv; End; Function PipeGetCh(pip: Pipe): Integer; Begin "PipeGetCh := -1; "With pip^ Do $Begin &If sActAv > 0 Then (Begin *PipeGetCh := Ord(buf[iNext]); *iNext := (iNext + 1) Mod s; *sActAv := sActAv - 1; (End; $End; End; { PipeGet(pip: Pipe): Integer; } Function PipeGet; Var "ichGet: Integer; Begin "PipeGet := -1; "With pip^ Do $Begin &If (mark = -1) And (sAvail > 0) Then (Begin *ichGet := PipeGetCh(pip); *If ichGet = pipEscape Then ,Begin .ichGet := PipeGetCh(pip); .If ichGet = pipEscape Then 0Begin 2PipeGet := ichGet; 2sAvail := sAvail - 1 0End .Else 0mark := ichGet; ,End *Else ,Begin .PipeGet := ichGet; .sAvail := sAvail - 1; ,End; (End; $End; End; { PipeGetMark(pip: Pipe): Integer; } { Get a mark from pipe } Function PipeGetMark; Begin "PipeGetMark := -1; "With pip^ Do $Begin &If sAvail > 0 Then (Begin *PipeGetMark := mark; *sAvail := sAvail - 1; *mark := -1; (End; $End; End; Procedure PipePutCh(pip: Pipe; ch: Char); Var "iPut: Index; Begin "With pip^ Do $Begin &If sActAv = s Then (While True Do; &iPut := (iNext + sActAv) Mod s; &buf[iPut] := ch; &sActAv := sActAv + 1; $End; End; { PipePut(pip: Pipe; ch: Char); } Procedure PipePut; Var "iPut: Index; "sLeft: Cardinal; Begin "With pip^ Do $Begin &sLeft := s - sActAv; &If ch = Chr(pipEscape) Then (Begin *If sLeft <= 1 Then { pipe is full } ,While True Do; *PipePutCh(pip, Chr(pipEscape)); *PipePutCh(pip, ch); (End &Else (Begin *If sLeft <= 0 Then { pipe is full } ,While True Do; *PipePutCh(pip, ch); (End; &sAvail := sAvail + 1; $End; End; { PipePutMark(pip: Pipe; ch: Char); } { Put a mark in pipe } Procedure PipePutMark; Var "iPut: Index; "sLeft: Cardinal; Begin "With pip^ Do $Begin &sLeft := s - sActAv; &If sLeft <= 1 Then { pipe is full } (While True Do; &PipePutCh(pip, Chr(pipEscape)); &PipePutCh(pip, ch); &sAvail := sAvail + 1; $End; End; { PipeRead(pip: Pipe; buf: Ptr; Var cnt: Cardinal); } Procedure PipeRead; Var "pbuf: PCV; "ichT: Integer; "i: Cardinal; Begin "pbuf := Pointer(Ord(buf)); "i := 0; "Repeat $ichT := PipeGet(pip); $If ichT >= 0 Then &Begin (pbuf^[i] := Chr(ichT); (i := i + 1; &End; "Until (i = cnt) Or (ichT < 0); "cnt := i; End; { PipeWrite(pip: Pipe; buf: Ptr; Var cnt: Cardinal); } Procedure PipeWrite; Var "pbuf: PCV; "i: Cardinal; "sGuar: Cardinal; Begin "pbuf := Pointer(Ord(buf)); { cnt := Min(cnt, (pip^.s - pip^.sAvail)); } "sGuar := PipeGuarantee(pip); "If sGuar < cnt Then $cnt := sGuar; "i := 0; "While i < cnt Do $Begin &PipePut(pip, pbuf^[i]); &i := i + 1; $End; End; End. W^g5P:H r8^!!.s{ Copyright 1983, 1984 by Apple Computer 8Mike Boich 8Martin P. Haeberli } {$I NewSerial/TrmSwtch } { Compile switches and constants } Unit Pipes; Interface Uses {$U obj/QuickDraw } QuickDraw, %{$U obj/OSIntf } OSIntf, %{$U obj/ToolIntf } ToolIntf, %{$U NewSerial/TermUtil } TermUtil; { Const "pipEscape = 255; } Type (Cardinal = 0..32000; (Index = Cardinal; (PPipe = ^Pipe; (Pipe = Record @s: Cardinal; { maximum amount of stuff } @sAvail: Cardinal; { virtual amount of stuff } @sActAv: Cardinal; { actual amount of stuff } @mark: Integer; @iNext: Index; @buf: Packed Array [Index] Of Char; :End; Function PipeOpen(s: Cardinal): PPipe; Procedure PipeClose(pip: PPipe); Function PipeSize(pip: PPipe): Cardinal; { Amount of space in pipe } Function PipeAvail(pip: PPipe): Cardinal; { Amount free in pipe } Function PipeGuarantee(pip: PPipe): Cardinal; { Amount of guaranteed free in pipe } Function PipeLeft(pip: PPipe): Cardinal; { Amount of stuff waiting in pipe } Function PipeGet(pip: PPipe): Integer; { Get a character from pipe } Function PipeGetMark(pip: PPipe): Integer; { Get a mark from pipe } Procedure PipePut(pip: PPipe; ch: Char); { Put a character in pipe } Procedure PipePutMark(pip: PPipe; ch: Char); { Put a mark in pipe } Procedure PipeRead(pip: PPipe; buf: Ptr; Var cnt: Cardinal); Procedure PipeWrite(pip: PPipe; buf: Ptr; Var cnt: Cardinal); Implementation Const "lPipeRec = 10; "pipEscape = 64; { Normally 255 } Type "CharVec = Packed Array [Index] Of Char; "PCV = ^CharVec; { Var "frob: Integer; } {$S Init } { PipeOpen(s: Cardinal): PPipe; } Function PipeOpen; Var "pip: PPipe; Begin "pip := Pointer(Ord(NewPtr(lPipeRec + s))); "If pip = Nil Then $While True Do; "pip^.s := s; "pip^.sAvail := 0; "pip^.sActAv := 0; "pip^.iNext := 0; "pip^.mark := -1; "PipeOpen := pip; End; {$S Init } { PipeClose(pip: PPipe); } Procedure PipeClose; Begin "{ "If pip^.sAvail <> 0 Then $While True Do; "} "DisposPtr(Pointer(Ord(pip))); End; {$S } { PipeSize(pip: PPipe): Cardinal; } Function PipeSize; Begin "PipeSize := pip^.s; End; {$S } { PipeAvail(pip: PPipe): Cardinal; } Function PipeAvail; Begin "PipeAvail := pip^.sAvail; End; {$S } { PipeGuarantee(pip: PPipe): Cardinal; } { Amount of guaranteed free in pipe } Function PipeGuarantee; Begin "PipeGuarantee := (pip^.s - pip^.sActAv) div 2; End; {$S } { PipeLeft(pip: PPipe): Cardinal; } { Amount of space left in pipe } Function PipeLeft; Begin "PipeLeft := pip^.s - pip^.sActAv; End; {$S } Function PipeGetCh(pip: PPipe): Integer; Begin "PipeGetCh := -1; "With pip^ Do $Begin &If sActAv > 0 Then (Begin *PipeGetCh := Ord(buf[iNext]); *iNext := (iNext + 1) Mod s; *sActAv := sActAv - 1; (End; $End; End; {$S } { PipeGet(pip: PPipe): Integer; } Function PipeGet; Var "ichGet: Integer; Begin "PipeGet := -1; "With pip^ Do $Begin &If (mark = -1) And (sAvail > 0) Then (Begin *ichGet := PipeGetCh(pip); *If ichGet = pipEscape Then ,Begin .ichGet := PipeGetCh(pip); .If ichGet = pipEscape Then 0Begin 2PipeGet := ichGet; 2sAvail := sAvail - 1 0End .Else 0mark := ichGet; ,End *Else ,Begin .PipeGet := ichGet; .sAvail := sAvail - 1; ,End; (End; $End; End; {$S } { PipeGetMark(pip: PPipe): Integer; } { Get a mark from pipe } Function PipeGetMark; Begin "PipeGetMark := -1; "With pip^ Do $Begin &If sAvail > 0 Then (Begin *PipeGetMark := mark; *sAvail := sAvail - 1; *mark := -1; (End; $End; End; {$S } Procedure PipePutCh(pip: PPipe; ch: Char); Var "iPut: Index; Begin "With pip^ Do $Begin &If sActAv = s Then (While True Do; &iPut := (iNext + sActAv) Mod s; &buf[iPut] := ch; &sActAv := sActAv + 1; $End; End; {$S } { PipePut(pip: PPipe; ch: Char); } Procedure PipePut; Var "iPut: Index; "sLeft: Cardinal; Begin "With pip^ Do $Begin &sLeft := s - sActAv; &If ch = Chr(pipEscape) Then (Begin *If sLeft <= 1 Then { pipe is full } ,While True Do; *PipePutCh(pip, Chr(pipEscape)); *PipePutCh(pip, ch); (End &Else (Begin *If sLeft <= 0 Then { pipe is full } ,While True Do; *PipePutCh(pip, ch); (End; &sAvail := sAvail + 1; $End; End; {$S } { PipePutMark(pip: PPipe; ch: Char); } { Put a mark in pipe } Procedure PipePutMark; Var "iPut: Index; "sLeft: Cardinal; Begin "With pip^ Do $Begin &sLeft := s - sActAv; &If sLeft <= 1 Then { pipe is full } (While True Do; &PipePutCh(pip, Chr(pipEscape)); &PipePutCh(pip, ch); &sAvail := sAvail + 1; $End; End; {$S } { PipeRead(pip: PPipe; buf: Ptr; Var cnt: Cardinal); } Procedure PipeRead; Var "pbuf: PCV; "ichT: Integer; "i: Cardinal; Begin "pbuf := Pointer(Ord(buf)); "i := 0; "Repeat $ichT := PipeGet(pip); $If ichT >= 0 Then &Begin (pbuf^[i] := Chr(ichT); (i := i + 1; &End; "Until (i = cnt) Or (ichT < 0); "cnt := i; End; {$S } { PipeWrite(pip: PPipe; buf: Ptr; Var cnt: Cardinal); } Procedure PipeWrite; Var "pbuf: PCV; "i: Cardinal; "{ "sGuar: Cardinal; "} Begin "pbuf := Pointer(Ord(buf)); "cnt := Min(cnt, PipeGuarantee(pip)); "{ "sGuar := PipeGuarantee(pip); "If sGuar < cnt Then $cnt := sGuar; "} "i := 0; "While i < cnt Do $Begin &PipePut(pip, pbuf^[i]); &i := i + 1; $End; End; End. W^g5P:H r^dss!b1{ Copyright 1983 by Apple Computer 8Mike Boich 8Martin P. Haeberli } Unit SerDefs; Interface Uses {$U obj:QuickDraw } QuickDraw, %{$U obj:OSIntf } OSIntf, %{$U obj:ToolIntf } ToolIntf, %{$U PipeDefs } PipeDefs, %{$U TaskDefs } TaskDefs; Const "serBufSize = 2048; { so we can swallow a screenfull no sweat} Type (SPortSel = (SPortA, SPortB); (SSpeed = (SSp50, SSp75, SSp110, SSp134andHalf, ;SSp150, SSp200, SSp300, SSp600, ;SSp1200, SSp1800, SSp2000, SSp2400, ;SSp3600, SSp4800, SSp9600, SSp19200); (SParity = (SParNone, SParOdd, SPar, SParEven); (SWidth = (SWid5, SWid7, SWid6, SWid8); (SStop = (SStp, SStp1, SStp1andHalf, SStp2); (Ser = ^SerRec; (SerRec = Record @port: SPortSel; @pipRcv: Pipe; @pipSnd: Pipe; @spd: SSpeed; @par: SParity; @wid: SWidth; @stp: SSTop; @xon: Char; @xoff: Char; @fXOn: Boolean; @fCTS: Boolean; @fInFlx: Boolean; { Input flow control? } @fEvBrk: Boolean; @fEvCTS: Boolean; @cumErr: Integer; @buf: Ptr; @error: ProcPtr; @sTask: Task; @snding: Boolean; @sdone: Boolean; @rTask: Task; @rcving: Boolean; @rdone: Boolean; :End; Procedure InitSer; Function NewSer: Ser; Procedure OpenSer(s: Ser; port: SPortSel; pipRcv, pipSnd: Pipe); Procedure CloseSer(s: Ser); Procedure EndSer; Procedure SetSerSpeed(s: Ser; spd: SSpeed); Function GetSerSpeed(s: Ser): SSpeed; Procedure SetSerParity(s: Ser; par: SParity); Function GetSerParity(s: Ser): SParity; Procedure SetSerWidth(s: Ser; wid: SWidth); Function GetSerWidth(s: Ser): SWidth; Procedure SetSerStop(s: Ser; stp: SStop); Function GetSerStop(s: Ser): SStop; Procedure SetSerBEvent(s: Ser; fEvBrk: Boolean); Function GetSerBEvent(s: Ser): Boolean; Procedure SetSerCEvent(s: Ser; fEvCTS: Boolean); Function GetSerCEvent(s: Ser): Boolean; Procedure SetSerCTS(s: Ser; on: Boolean); Function GetSerCTS(s: Ser): Boolean; Function ExaSerCTS(s: Ser): Boolean; Procedure SetSerCN(s: Ser; xon: Char); Function GetSerCN(s: Ser): Char; Procedure SetSerCF(s: Ser; xoff: Char); Function GetSerCF(s: Ser): Char; Procedure SetSerXON(s: Ser; on: Boolean); Function GetSerXON(s: Ser): Boolean; Function ExaSerXOFF(s: Ser): Boolean; Procedure SetSerInXON(s: Ser; on: Boolean); Function GetSerInXON(s: Ser): Boolean; Function ExaSerInXOFF(s: Ser): Boolean; Procedure SndSerXN(s: Ser); Procedure SndSerXF(s: Ser); Function ExaSerErrs(s: Ser): Integer; Procedure SetSerErr(s: Ser; errProc: ProcPtr); Function GetSerErr(s: Ser): ProcPtr; Implementation { no code here, it's all in SerImpl } End. 3. "6F^5PH r ^u?5{ Copyright 1983 by Apple Computer 8Mike Boich 8Martin P. Haeberli } Unit SerImpl; { Authorized Modification history: $Changed CTS handshake to default off MB 9/23/83 $added setHandshake call to openSer MB 9/25/83 $changed WHILE TRUE DOs to FlashMenuBar(0)s MB 9/25/83 $Integrated MB changes: MH 10/14/83 $Added support for loadable ASync Driver MH 11/28/83 $Replaced FlashMenuBar calls with calls to SerialError PMH 11/28/83 } Interface Uses {$U obj:QuickDraw } QuickDraw, %{$U obj:OSIntf } OSIntf, %{$U obj:ToolIntf } ToolIntf, %{$U AscDefs } AscDefs, %{$U PipeDefs } PipeDefs, %{$U TaskDefs } TaskDefs, %{$U SerDefs } SerDefs; { Const %x = 0; } { Type "TermRec = Record 1height: Integer; /End; "TermPtr = ^TermRec; } Implementation Const "OffsetDelta = 24; "pUTableBase = 284; "pLvl2DT = 434; "pUnitNtryCnt = 466; "pExtStsDT = 702; "sTaskSize = 1536; "rTaskSize = 1024; Type "SDirSel = (SDirRcv, SDirSnd); "{ "GetWaiRec = Record 2cs: CSParm; 2unu: Integer; 2count: Integer; 0End; "} "DCtl = Record 2DCtlDriver: Ptr; 2DCtlFlags: Integer; 2DCtlQueue: Integer; 2DCtlQHead: Ptr; 2DCtlQTail: Ptr; 2DCtlPosition: LongInt; 2DCtlStorage: Handle; 2DCtlRefNum: Integer; 2DCtlCurTicks: LongInt; 2DCtlWindow: Ptr; 2DCtlDelay: Integer; 2DCtlEMask: Integer; 2DCtlMenu: Integer; 0End; "PDCtl = ^DCtl; "HDCtl = ^PDCtl; "UTable = Array [1..32] Of HDCtl; "DT = Array [0..7] Of Ptr; Var "ASHandle: Handle; "ASLoaded: Boolean; "ASInstalled: Array [SPortSel] Of Boolean; "OldDriver: Array [SPortSel, SDirSel] Of Ptr; "OldDT: Array [0..7] Of Ptr; "UTableBase: ^UTable; "Lvl2DT: ^DT; "UnitNtryCnt: ^Integer; "ExtStsDt: ^DT; Procedure PushInteger(int: Integer); External; Procedure PushString(str: Str255); External; Procedure CallProc(proc: ProcPtr); External; {$SSImpl} Function Min(a, b: LongInt): LongInt; Begin "If a < b Then $Min := a "Else $Min := b; End; Procedure SetPointers; Var "p: ^Ptr; Begin "p := Pointer(Ord(pUTableBase)); "UTableBase := Pointer(Ord(p^)); "Lvl2DT := Pointer(Ord(pLvl2DT)); "UnitNtryCnt := Pointer(Ord(pUnitNtryCnt)); "ExtStsDt := Pointer(Ord(pExtStsDt)); End; Procedure SerialError(s: Ser; proc: Str255; code: Integer); Begin "If s^.error <> Nil Then $Begin &PushString(proc); &PushInteger(code); &CallProc(s^.error); $End; End; Function NumFromSpd(spd: SSpeed): Integer; Var "num: Integer; Begin "Case spd Of { Assume master clock at 3.670702 MHz, divided by 32 } $SSp50: &num := 2292; $SSp75: &num := 1527; $SSp110: &num := 1041; $SSp134andHalf: &num := 851; $SSp150: &num := 763; $SSp200: &num := 572; $SSp300: &num := 380; $SSp600: &num := 189; $SSp1200: &num := 94; $SSp1800: &num := 62; $SSp2000: &num := 55; $SSp2400: &num := 46; $SSp3600: &num := 30; $SSp4800: &num := 22; $SSp9600: &num := 10; $SSp19200: &num := 4; "End; "NumFromSpd := num; End; Function NumFromPortDir(sp: SPortSel; sd: SDirSel): Integer; Var "ref: Integer; Begin "Case sp Of $SPortA: &ref := -6; $SPortB: &ref := -8 "End; "If sd = SDirSnd Then $ref := ref - 1; "NumFromPortDir := ref; End; {one-time initialization of parameter block} Procedure InitParm(p: ParmBlkPtr; refnum: Integer; buf: Ptr); Begin "With p^ Do $Begin &ioCompletion := Nil; &ioNamePtr := Nil; &ioVRefNum := 0; &ioRefNum := refnum; &ioBuffer := buf; &ioPosMode := 0; &ioPosOffset := 0; $End; End; {repeated setup of parameter block} Procedure SetupParm(p: ParmBlkPtr; count: Integer); Begin "With p^ Do $Begin &ioLink := Nil; &ioType := 0; &ioTrap := 0; &ioCmdAddr := Nil; &ioResult := 0; &ioReqCount := count; &ioActCount := 0; $End; End; {$SSInit} Procedure SetSerConfig(s: Ser); Var "scr: ParamBlockRec; "err: OSErr; "config: Integer; Begin "config := 0; "config := BitAnd(Ord(s^.stp), 3); "config := BitShift(config, 2); "config := BitOr(config, BitAnd(Ord(s^.par), 3)); "config := BitShift(config, 2); "config := BitOr(config, BitAnd(Ord(s^.wid), 3)); "config := BitShift(config, 10); "config := BitOr(config, BitAnd(NumFromSpd(s^.spd), 1023)); "InitParm(@scr, NumFromPortDir(s^.port, SDirSnd), Nil); "SetupParm(@scr, 0); "With scr Do $Begin &CSCode := 8; &CSParam.asncConfig := config; $End; "err := PBControl(@scr, False); "If err <> 0 Then $SerialError(s, 'SetSerConfig', err); End; Function ByteFromBoolean(f: Boolean): Byte; Begin "ByteFromBoolean := 0; "If f Then $ByteFromBoolean := 255; End; Procedure SetHandshake(s: Ser); Var "hsr: ParamBlockRec; "err: OSErr; "con: Integer; "eventFlags: Integer; Begin "eventFlags := 0; "If s^.fEvCTS Then $eventFlags := 32; { 2**5 } "If s^.fEvBrk Then $eventFlags := 128 + eventFlags; { 2**7 + eventFlags } "InitParm(@hsr, NumFromPortDir(s^.port, SDirSnd), Nil); "SetupParm(@hsr, 0); "With hsr Do $Begin &CSCode := 10; &CSParam.flgs.fXOn := ByteFromBoolean(s^.fXOn); &CSParam.flgs.fCTS := ByteFromBoolean(s^.fCTS); &CSParam.flgs.fInX := ByteFromBoolean(s^.fInFlx); &CSParam.flgs.xon := s^.xon; &CSParam.flgs.xoff := s^.xoff; &CSParam.flgs.errs := 0; &CSParam.flgs.evts := eventFlags; $End; "err := PBControl(@hsr, False); "If err <> 0 Then $SerialError(s, 'SetHandshake', err); End; Procedure GetStatus(s: Ser; Var status: ASStaRec); Var "gsr: ParamBlockRec; "err: OSErr; "con: Integer; Begin "InitParm(@gsr, NumFromPortDir(s^.port, SDirSnd), Nil); "SetupParm(@gsr, 0); "gsr.CSCode := 8; "err := PBStatus(@gsr, False); "If err <> 0 Then $SerialError(s, 'GetStatus', err); "status := gsr.CSParam.asncSta; "s^.cumErr := BitOr(s^.cumErr, 6BitShift(BitAnd(gsr.CSParam.asncSta.cumerrs, 255), 8)); End; Procedure NameFromPortDir(sp: SPortSel; sd: SDirSel; Var name: Str255); Var "prefix: String[2]; "suffix: String[3]; Begin "Case sp Of $SPortA: &prefix := '.A'; $SPortB: &prefix := '.B' "End; "Case sd Of $SDirRcv: &suffix := 'In'; $SDirSnd: &suffix := 'Out' "End; "name := Concat(prefix, suffix); End; Procedure SetBuffer(s: Ser; refnum: Integer; buf: Ptr; len: Integer); Var "sbr: ParamBlockRec; "err: OSErr; Begin "InitParm(@sbr, refnum, Nil); "SetupParm(@sbr, 0); "With sbr Do $Begin &CSCode := 9; &CSParam.asncBPtr := buf; &CSParam.asncBLen := len; $End; "err := PBControl(@sbr, False); "If err <> 0 Then $SerialError(s, 'SetBuffer', err); End; {$SSImpl} Function SerWaiting(refnum: Integer): LongInt; Var "gwr: ParamBlockRec; "err: OSErr; Begin "InitParm(@gwr, refnum, Nil); "SetupParm(@gwr, 0); "gwr.CSCode := 2; "err := PBStatus(@gwr, False); "If err <> 0 Then $While True Do; "SerWaiting := gwr.CSParam.asyncNBytes; End; Procedure SerRead( 8s: Ser; 8p: ParmBlkPtr; 8refnum: Integer; 8buf: Ptr; 8count: Integer 8); Var "err: OSErr; Begin "InitParm(p, refnum, buf); "SetupParm(p, count); "err := PBRead(p, False); "If err <> 0 Then $SerialError(s, 'SerRead', 0); "If p^.ioReqCount <> p^.ioActCount Then $SerialError(s, 'SerRead.Count', 0); End; Function DrvrFromPortDir(sp: SPortSel; sd: SDirSel): Ptr; Var "driver: LongInt; "index: Integer; Begin "index := (2 * Ord(sp)) + Ord(sd); "driver := Ord(ASHandle^); "driver := driver + (index * OffsetDelta); "driver := BitAnd(driver, 16777215); "DrvrFromPortDir := Pointer(driver); End; {$SSInit} Procedure SerInst(sp: SPortSel; sd: SDirSel); Var "refnum: Integer; "PDCtlSer: PDCtl; Begin "refnum := NumFromPortDir(sp, sd); "refnum := Abs(refnum); "OldDriver[sp, sd] := UTableBase^[refnum]^^.DCtlDriver; "UTableBase^[refnum]^^.DCtlDriver := DrvrFromPortDir(sp, sd); End; Procedure SerInstall(sp: SPortSel); Var "base: Integer; Begin "SetPointers; "If ASLoaded And (Not ASInstalled[sp]) Then $Begin &base := (1 - Ord(sp)) * 4; &OldDT[base] := Lvl2DT^[base]; &OldDT[base+1] := ExtStsDT^[base div 2]; &OldDT[base+2] := Lvl2DT^[base+2]; &OldDT[base+3] := Lvl2DT^[base+3]; &SerInst(sp, SDirRcv); &SerInst(sp, SDirSnd); &ASInstalled[sp] := True; $End; End; Procedure SerUnIn(sp: SPortSel; sd: SDirSel); Var "refnum: Integer; Begin "refnum := NumFromPortDir(sp, sd); "refnum := Abs(refnum); "UTableBase^[refnum]^^.DCtlDriver := OldDriver[sp, sd]; End; Procedure SerUnInstall(sp: SPortSel); Var "base: Integer; Begin "SetPointers; "If ASInstalled[sp] Then $Begin &SerUnIn(sp, SDirRcv); &SerUnIn(sp, SDirSnd); &base := (1 - Ord(sp)) * 4; &Lvl2DT^[base] := OldDT[base]; &ExtStsDT^[base div 2] := OldDT[base+1]; &Lvl2DT^[base+2] := OldDT[base+2]; &Lvl2DT^[base+3] := OldDT[base+3]; &ASInstalled[sp] := False; $End; End; {$SSImpl} Procedure Wait(delta: LongInt); Var "start: LongInt; Begin "start := TickCount; "While (TickCount - start) < delta Do $Yield; End; Procedure SerSend(s: Ser); Const "serOBufSize = 2; { normally 64 } Type "BufOut = Packed Array [0..serOBufSize] Of Char; "BufRec = Record .fIdle: Boolean; .parmPtr: ParmBlkPtr; .buf: BufOut; ,End; "BufRecPtr = ^BufRec; Var "bufRecA: BufRec; "bufRecB: BufRec; "whichBR: BufRecPtr; "parmA: ParamBlockRec; "parmB: ParamBlockRec; "parmCtl: ParamBlockRec; "pparmCtl: ParmBlkPtr; "refOut: Integer; "sWaiting: LongInt; "sORead: Cardinal; "sOWrite: LongInt; "err: OSErr; "ichNext: Integer; "Procedure SetBreak(p: ParmBlkPtr); "Begin $SetUpParm(p, 0); $p^.CSCode := 12; $err := PBControl(p, True); $While p^.ioResult > 0 Do &Yield; "End; "Procedure ClearBreak(p: ParmBlkPtr); "Begin $SetUpParm(p, 0); $p^.CSCode := 11; $err := PBControl(p, True); $While p^.ioResult > 0 Do &Yield; "End; "Procedure TestBusy(brp: BufRecPtr); "Var $err: OSErr; "Begin $If Not brp^.fIdle Then &Begin (err := brp^.parmPtr^.ioResult; (If err <= 0 Then { IO complete } *Begin ,If err = 0 Then .Begin 0If brp^.parmPtr^.ioReqCount <> brp^.parmPtr^.ioActCount Then 2SerialError(s, 'SerSend.SendCount', 0); .End ,Else .SerialError(s, 'SerSend', err); ,brp^.fIdle := True; *End; &End; "End; "Procedure InitBufRec(brp: BufRecPtr; p: ParmBlkPtr; refnum: Integer); "Begin $InitParm(p, refnum, @brp^.buf); $brp^.fIdle := True; $brp^.parmPtr := p; "End; "Function SelectBR(Var brp: BufRecPtr; brpA, brpB: BufRecPtr): Boolean; "Var $fSelect: Boolean; "Begin $brp := brpA; $fSelect := brp^.fIdle; $If Not fSelect Then &Begin (brp := brpB; (fSelect := brp^.fIdle; &End; $SelectBR := fSelect; "End; Begin "refOut := NumFromPortDir(s^.port, SDirSnd); "InitBufRec(@bufRecA, @parmA, refOut); "InitBufRec(@bufRecB, @parmB, refOut); "pparmCtl := @parmCtl; "InitParm(pparmCtl, refOut, Nil); "While s^.snding Do $Begin &TestBusy(@bufRecA); &TestBusy(@bufRecB); &If SelectBR(whichBR, @bufRecA, @bufRecB) Then (Begin *sWaiting := PipeAvail(s^.pipSnd); *If sWaiting > 0 Then ,Begin .sOWrite := Min(sWaiting, serOBufSize); .sORead := sOWrite; .PipeRead(s^.pipSnd, @whichBR^.buf, sORead); .If sORead < sOWrite Then 0Begin { must be time for a break, or something } 2sOWrite := sORead; 2SetupParm(whichBR^.parmPtr, sOWrite); 2err := PBWrite(whichBR^.parmPtr, True); 2whichBR^.fIdle := False; 2ichNext := PipeGet(s^.pipSnd); { check that it's a mark! } 2If ichNext >= 0 Then 4SerialError(s, 'SerSend.break', 0); 2ichNext := PipeGetMark(s^.pipSnd); 2While (Not whichBR^.fIdle) Do 4Begin 6TestBusy(@bufRecA); 6TestBusy(@bufRecB); 6Yield; 4End; 2Wait(6); { until all possible characters have shifted out } 2SetBreak(pparmCtl); 2Wait(ichNext); { 14 is short break; 210 is long break } 2ClearBreak(pparmCtl); 0End .Else 0Begin; 2SetupParm(whichBR^.parmPtr, sOWrite); 2err := PBWrite(whichBR^.parmPtr, True); 2whichBR^.fIdle := False; 0End; ,End; (End; &Yield; $End; "While (Not bufRecA.fIdle) Or (Not bufRecB.fIdle) Do $Begin &TestBusy(@bufRecA); &TestBusy(@bufRecB); &Yield; $End; "s^.sdone := True; End; Procedure SerRcv(s: Ser); Const "SerIBufSize = 32; Var "rdr: ParamBlockRec; "bufIn: Packed Array [0..serIBufSize] Of Char; "refIn: Integer; "sWaiting: LongInt; "sLeft: LongInt; "sIRead: LongInt; "sIWrite: Cardinal; Begin "refIn := NumFromPortDir(s^.port, SDirRcv); "While s^.rcving Do $Begin &sWaiting := SerWaiting(refIn); &If sWaiting > 0 Then (Begin *sLeft := PipeGuarantee(s^.pipRcv); *If sLeft > 0 Then ,Begin .sIRead := Min(sLeft, sWaiting); .sIRead := Min(serIBufSize, sIRead); .SerRead(s, @rdr, refIn, @bufIn, sIRead); .sIWrite := sIRead; .PipeWrite(s^.pipRcv, @bufIn, sIWrite); .If sIRead <> sIWrite Then 0SerialError(s, 'SerPoll.In.Count', 0); ,End; (End; &Yield; $End; "s^.rdone := True; End; {$SSInit} { InitSer; } Procedure InitSer; Const "ASyncDriver = 256; Begin "ASHandle := Nil; "ASLoaded := False; "ASInstalled[SPortA] := False; "ASInstalled[SPortB] := False; "ASHandle := GetResource('SERD', ASyncDriver); "DetachResource(ASHandle); "HNoPurge(ASHandle); "HLock(ASHandle); "ASLoaded := True; End; Procedure DisposNPtr(p: Ptr); Begin "If p <> Nil Then $DisposPtr(p); End; { NewSer: Ser; } Function NewSer; Var "p: Ptr; "buf: Ptr; "sTask: Ptr; "rTask: Ptr; "s: Ser; Begin "p := NewPtr(SizeOf(SerRec)); "buf := NewPtr(serBufSize); "sTask := NewPtr(sTaskSize); "rTask := NewPtr(rTaskSize); "If (p = Nil) Or (buf = Nil) Or (sTask = Nil) Or (rTask = Nil) Then $Begin &DisposNPtr(p); &DisposNPtr(buf); &DisposNPtr(sTask); &DisposNPtr(rTask); &s := Nil; $End "Else $Begin &s := Pointer(Ord(p)); &s^.sTask := Pointer(sTask); &s^.rTask := Pointer(rTask); &s^.buf := buf; &With s^ Do (Begin *port := SPortA; *pipRcv := Nil; *pipSnd := Nil; *spd := SSp1200; *par := SParNone; *wid := SWid8; *stp := SStp1; *xon := Chr(CtlDC1); { Default XOn character } *xoff := Chr(CtlDC3); { Default XOff character } *fXOn := False; *fCTS := False; { MB doesn't like CTS to default on *** } *fInFlx := False; *fEvBrk := False; *fEvCTS := False; *cumErr := 0; *error := Nil; *sdone := True; *snding := False; *rdone := True; *rcving := False; (End; $End; "NewSer := s; End; { OpenSer(s: Ser; port: SPortSel; pipRcv, pipSnd: Pipe); } Procedure OpenSer; Var "rn: Integer; "name: Str255; "t: Task; Begin "s^.port := port; "s^.pipRcv := pipRcv; "s^.pipSnd := pipSnd; "CloseDriver(NumFromPortDir(port, SDirRcv)); "CloseDriver(NumFromPortDir(port, SDirSnd)); "SerInstall(port); "NameFromPortDir(port, SDirRcv, name); "rn := OpenDriver(name); "NameFromPortDir(port, SDirSnd, name); "rn := OpenDriver(name); "SetSerConfig(s); "SetHandshake(s); "SetBuffer(s, NumFromPortDir(port, SDirRcv), s^.buf, serBufSize); "s^.sdone := False; "s^.snding := True; "t := Fork(Pointer(Ord(@SerSend)), Ord(s), s^.sTask, sTaskSize); "s^.rdone := False; "s^.rcving := True; "t := Fork(Pointer(Ord(@SerRcv)), Ord(s), s^.rTask, rTaskSize); End; { CloseSer(s: Ser); } Procedure CloseSer; Begin "s^.snding := False; "s^.rcving := False; "{ make sure send pipe and receive buffers empty before closing down. } "Repeat $RunTasks "Until (s^.rdone) And (s^.rdone); "CloseDriver(NumFromPortDir(s^.port, SDirRcv)); "CloseDriver(NumFromPortDir(s^.port, SDirSnd)); "SerUnInstall(s^.port); End; { EndSer; } Procedure EndSer; Begin "If ASHandle <> Nil Then $Begin &{ &If ASInstalled[SPortA] Or ASInstalled[SPortB] Then (Begin *While True Do; (End; &} &HPurge(ASHandle); &HUnLock(ASHandle); &DisposHandle(ASHandle); &ASHandle := Nil; &ASLoaded := False; $End; End; {$SSImpl} { SetSerSpeed(s: Ser; spd: SSpeed); } Procedure SetSerSpeed; Begin "s^.spd := spd; "SetSerConfig(s); End; { GetSerSpeed(s: Ser): SSpeed; } Function GetSerSpeed; Begin "GetSerSpeed := s^.spd; End; { SetSerParity(s: Ser; par: SParity); } Procedure SetSerParity; Begin "s^.par := par; "SetSerConfig(s); End; { GetSerParity(s: Ser): SParity; } Function GetSerParity; Begin "GetSerParity := s^.par; End; { SetSerWidth(s: Ser; wid: SWidth); } Procedure SetSerWidth; Begin "s^.wid := wid; "SetSerConfig(s); End; { GetSerWidth(s: Ser): SWidth; } Function GetSerWidth; Begin "GetSerWidth := s^.wid; End; { SetSerStop(s: Ser; stp: SStop); } Procedure SetSerStop; Begin "s^.stp := stp; "SetSerConfig(s); End; { GetSerStop(s: Ser): SStop; } Function GetSerStop; Begin "GetSerStop := s^.stp; End; { SetSerBEvent(s: Ser; fEvBrk: Boolean); } Procedure SetSerBEvent; Begin "s^.fEvBrk := fEvBrk; "SetHandshake(s); End; { GetSerBEvent(s: Ser): Boolean; } Function GetSerBEvent; Begin "GetSerBEvent := s^.fEvBrk; End; { SetSerCEvent(s: Ser; fEvCTS: Boolean); } Procedure SetSerCEvent; Begin "s^.fEvCTS := fEvCTS; "SetHandshake(s); End; { GetSerCEvent(s: Ser): Boolean; } Function GetSerCEvent; Begin "GetSerCEvent := s^.fEvCTS; End; { SetSerCTS(s: Ser; on: Boolean); } Procedure SetSerCTS; Begin "s^.fCTS := on; "SetHandshake(s); End; { GetSerCTS(s: Ser): Boolean; } Function GetSerCTS; Begin "GetSerCTS := s^.fCTS; End; { ExaSerCTS(s: Ser): Boolean; } Function ExaSerCTS; Var "status: ASStaRec; "result: Boolean; Begin "GetStatus(s, status); "If status.CTSHold <> 0 Then $result := True "Else $result := False; "ExaSerCTS := Result; End; { SetSerCN(s: Ser; xon: Char); } Procedure SetSerCN; Begin "s^.xon := xon; "SetHandshake(s); End; { GetSerCN(s: Ser): Char; } Function GetSerCN; Begin "GetSerCN := s^.xon; End; { SetSerCF(s: Ser; xoff: Char); } Procedure SetSerCF; Begin "s^.xoff := xoff; "SetHandshake(s); End; { GetSerCF(s: Ser): Char; } Function GetSerCF; Begin "GetSerCF := s^.xoff; End; { SetSerXON(s: Ser; on: Boolean); } Procedure SetSerXON; Begin "s^.fXOn := on; "SetHandshake(s); End; { GetSerXON(s: Ser): Boolean; } Function GetSerXON; Begin "GetSerXON := s^.fXOn; End; { ExaSerXOFF(s: Ser): Boolean; } Function ExaSerXOFF; Var "status: ASStaRec; "result: Boolean; Begin "GetStatus(s, status); "If status.XOffHold <> 0 Then $result := True "Else $result := False; "ExaSerXOFF := result; End; { SetSerInXON(s: Ser; on: Boolean); } Procedure SetSerInXON; Begin "s^.fInFlx := on; "SetHandshake(s); End; { GetSerInXON(s: Ser): Boolean; } Function GetSerInXON; Begin "GetSerInXON := s^.fInFlx End; { ExaSerInXOFF(s: Ser): Boolean; } Function ExaSerInXOFF; Var "status: ASStaRec; "result: Boolean; Begin "GetStatus(s, status); "If status.XOFFSent <> 0 Then $result := True "Else $result := False; "ExaSerInXOFF := result; End; { SndSerXN(s: Ser); } Procedure SndSerXN; Begin "PipePut(s^.pipSnd, s^.xon); End; { SndSerXF(s: Ser); } Procedure SndSerXF; Begin "PipePut(s^.pipSnd, s^.xoff); End; { ExaSerErrs(s: Ser): Integer; } Function ExaSerErrs; Begin "ExaSerErrs := s^.cumErr; "s^.cumErr := 0 End; { SetSerErr(s: Ser; errProc: ProcPtr); } Procedure SetSerErr; Begin "s^.error := errProc; End; { GetSerErr(s: Ser): ProcPtr; } Function GetSerErr; Begin "GetSerErr := s^.error; End; End. 5]VP:H r^bsM; Copyright 1983 by Apple Computer ; Mike Boich ; Martin P. Haeberli ;TaskAsm.text -- Assembly Language Support for Multi-Tasking. ;---------------------------------------------------------------------- ; TaskAsm - Macintosh OS IO Interface routines. ; ; Supports Yield, Resume, ... ; ; Calling sequences: ; ; Error codes: ; ; Written By: Martin P. Haeberli December 11, 1983 ; ; Modification History: ; 11 Dec 83 M Haeberli Cleaned up comments and code. ;---------------------------------------------------------------------- ; 0.Include TlAsm/SysEqu.Text 0.Include TlAsm/SysMacs.Text 0.Proc TaskAsm 0.Def InitTA 0.Def Yield 0.Def Resume 0.Def RegA5 0.Def HaraKiri ;---------------------------------------------------------------------- ; ; Offsets and Static Variables used by and in TaskAsm. ; savedSP .Equ 4 ;Offset for saved Stack Pointer. TaskCur .Long 0 resumeSP .Long 0 ;---------------------------------------------------------------------- ; ; Procedure InitTA; ; ; Initializes TaskAsm. ; ; Arguments: ; None. ; ; Results: ; None. ; ; Registers: ; D0: ec: error code ; A0: param: Paramater list address. ; A1: ra: Return Address. ; InitTA 0MoveQ #0,D0 0LEA TaskCur,A0 0Move.L D0,(A0) 0LEA resumeSP,A0 0Move.L D0,(A0) 0Clr.L StkLowPt ; disable VBL stack checking. 0RTS ;Return to caller. ;---------------------------------------------------------------------- ; ; Procedure Yield; ; ; Yields control of the processor to the next task. ; ; Arguments: ; None. ; ; Results: ; None. ; ; Registers: ; D0: ec: error code ; A0: param: Paramater list address. ; A1: ra: Return Address. ; Yield 0MoveM.L D0-D7/A0-A6,-(SP) ;Save all them registers. 0Move.L TaskCur,A0 ;TaskCur points to current TaskRec. 0Move.L SP,savedSP(A0) ;Save stack pointer 0BrA.S UnResume ;Switch back to main process. UnYield 0Move.L TaskCur,A0 ;TaskCur points to current TaskRec. 0Move.L savedSP(A0),SP 0MoveM.L (SP)+,D0-D7/A0-A6 ;Restore all them registers. 0RTS ;Return to caller. ;---------------------------------------------------------------------- ; ; Procedure Resume(t: Task); ; ; Resumes task specified by t. ; ; Argument: ; t: Points to TaskRec for the new task. ; ; Results: ; None. ; ; Registers: ; D0: ec: error code ; A0: param: Parameter list address. ; A1: ra: Return Address. ; Resume 0Move.L 4(SP),D0 ;Recover argument 0Move.L (SP)+,(SP) ;Move return address up stack. 0Move.L resumeSP,D1 ;Make sure we're OK. 0BNE.S ResumeExit ;Nope, do nothing. 0LEA TaskCur,A0 0Move.L D0,(A0) ;Save task pointer. 0MoveM.L D0-D7/A0-A6,-(SP) ;Save all them registers. 0LEA resumeSP,A0 0Move.L SP,(A0) ;Save stack pointer 0BrA.S UnYield ;Resume process in question UnResume 0LEA resumeSP,A0 0Move.L (A0),SP ;Restore stack pointer 0Clr.L (A0) ;Clear busy flag. 0MoveM.L (SP)+,D0-D7/A0-A6 ;Restore all them registers. ResumeExit 0RTS ;return to caller ;---------------------------------------------------------------------- ; ; Function RegA5: LongInt; ; ; Returns current value of A5. ; ; Argument: ; None. ; ; Results: ; None. ; ; Registers: ; D0: ec: error code ; A0: param: Parameter list address. ; A1: ra: Return Address. ; RegA5 0Move.L A5,4(SP) 0RTS ;return to caller ;---------------------------------------------------------------------- ; ; Procedure HaraKiri; ; ; Kills current process, if any. ; ; Argument: ; None. ; ; Results: ; None. ; ; Registers: ; D0: ec: error code ; A0: param: Parameter list address. ; A1: ra: Return Address. ; ;Procedure HaraKiri; ;Begin ; If TaskCurrent <> Nil Then ; Begin ; Kill(TaskCurrent); ; End; ;End; ;} 0.Ref Kill HaraKiri 0LEA TaskCur,A0 0Move.L (A0),D0 ;Get task pointer. 0BEq.S @1 0LEA resumeSP,A0 ;Switch to 'Resume' stack. 0Move.L (A0),SP 0Move.L D0,-(SP) ;Pass task pointer to Kill. 0JSR Kill ;Call task kill. @1 0BrA.S UnResume 0.End W^g5P:H r^ { Copyright 1983 by Apple Computer 8Mike Boich 8Martin P. Haeberli } Unit TaskDefs; Interface Uses {$U obj:OSIntf } OSIntf; Type (Task = ^TaskRec; (TaskRec = Record @next: Task; { Pointer to next Task or Nil } @sp: Ptr; { Saved stack pointer } @fDeAll: Boolean; { Deallocate task object on \death } :End; Procedure InitTasks; Procedure RunTasks; Procedure EndTasks; Procedure Yield; Procedure HaraKiri; Procedure Kill(t: Task); Function ThisTask: Task; Function Fork(proc: ProcPtr; arg: LongInt; t: Task; s: Size): Task; Implementation { no code here, it's all in TaskImpl, TaskAsm } End. 3. "6F^5PH r ^$${ Copyright 1983 by Apple Computer 8Mike Boich 8Martin P. Haeberli } Unit TaskImpl; Interface Uses {$U obj:QuickDraw } QuickDraw, %{$U obj:OSIntf } OSIntf, %{$U TaskDefs } TaskDefs; Implementation { Const "OffsetDelta = 24; } Var "TaskFirst: Task; "TaskCurrent: Task; Procedure InitTA; External; Procedure Resume(t: Task); External; Function RegA5: LongInt; External; Procedure HaraKiri; External; { InitTasks; } Procedure InitTasks; Begin "TaskFirst := Nil; "TaskCurrent := Nil; "InitTA; End; { RunTasks; } Procedure RunTasks; Begin "TaskCurrent := TaskFirst; "While TaskCurrent <> Nil Do $Begin &Resume(TaskCurrent); &TaskCurrent := TaskCurrent^.next; $End; End; { EndTasks; } Procedure EndTasks; Var "taskKill: Task; "taskNext: Task; Begin "If TaskCurrent = Nil Then $Begin &taskKill := TaskFirst; &While taskKill <> Nil Do (Begin *taskNext := taskKill^.next; *Kill(taskKill); *taskKill := taskNext; (End; &TaskFirst := Nil; &InitTA; $End; End; { Kill(t: Task); } Procedure Kill; Var "taskPrev: Task; "taskCur: Task; "taskNext: Task; "found: Boolean; Begin "taskPrev := Pointer(Ord(@TaskFirst)); "taskCur := taskPrev^.next; "found := False; "While (taskCur <> Nil) And (Not found) Do $Begin &If taskCur = t Then (Begin *found := True; *taskPrev^.next := taskCur^.next; (End; &taskPrev := taskCur; &taskCur := taskPrev^.next; $End; "If t^.fDeAll Then $DisposPtr(Pointer(Ord(t))); End; { ThisTask: Task; } Function ThisTask; Begin "ThisTask := TaskCurrent; End; Procedure IniTskRec(proc: ProcPtr; arg: LongInt; t: Task; s: Size); Var "pArg: ^LongInt; "pProc: ^ProcPtr; "pStack: ^LongInt; "i: Integer; Begin "pArg := Pointer(Ord(t) + s - 4); "pProc := Pointer(Ord(pArg)- 4); "pStack := Pointer(Ord(pProc) - 4); "pArg^ := arg; "pProc^ := Pointer(Ord(@HaraKiri)); "pStack^ := Ord(proc); "pStack := Pointer(Ord(pStack) - 4); "pStack^ := 0; "pStack := Pointer(Ord(pStack) - 4); "pStack^ := RegA5; "For i := 1 to 13 Do $Begin &pStack := Pointer(Ord(pStack) - 4); &pStack^ := 0; $End; "t^.sp := Pointer(Ord(pStack)); End; { Fork(proc: ProcPtr; arg: LongInt; t: Task; s: Size): Task; } Function Fork; Begin "If t = Nil Then $Begin &t := Pointer(Ord(NewPtr(s))); &If t <> Nil Then (t^.fDeAll := True $End "Else $t^.fDeAll := False; "If t <> Nil Then $Begin &IniTskRec(proc, arg, t, s); &t^.next := TaskFirst; &TaskFirst := t; $End; "Fork := t; End; End. 3. "6F^5D!$ǐ^#.{ Copyright 1983, 1984 by Apple Computer 8Mike Boich 8Martin P. Haeberli } {$I NewSerial/TrmSwtch } { Compile switches and constants } Unit TermUtil; {$L-} Interface Uses {$U obj/QuickDraw } QuickDraw, %{$U obj/OSIntf } OSIntf, %{$U obj/ToolIntf } ToolIntf, %{$U obj/PackIntf } PackIntf; Type #Chars16 = Packed Array [1..16] Of Char; { for setting file info } #CheatPtr = ^Chars16; #Model = (Macintosh, Lisa); Function Min(x, y: LongInt): LongInt; Function Max(x, y: LongInt): LongInt; Procedure ReportError(str: Str255; code: Integer); { sets file info for term files } Procedure SetTheFInfo(fName: Str255; t: OSType); Procedure TermBell; Function GetModel: Model; Function InRange(min, a, max: Integer): Boolean; Function ForceRange(min, a, max: Integer): Integer; Procedure IntToStr(x: Integer; Var s: Str255); { converts pos integer to str } Procedure PushInteger(int: Integer); Procedure PushString(str: Str255); Procedure PushPointer(p: Ptr); Procedure CallProc(proc: ProcPtr); Procedure DebugTrap; Procedure ChkErr(err: Integer; explain: Str255); Implementation {$S Util } Function Min; Begin "Min := x; "If x > y Then $Min := y; End; {$S Util } Function Max; Begin "Max := y; "If x > y Then $Max := x; End; {$S Util } { ReportError(str: Str255; code: Integer); } Procedure ReportError; Begin "FlashMenuBar(0); FlashMenuBar(0); FlashMenuBar(0); FlashMenuBar(0); End; {$S Util } { sets file info for term files } Procedure SetTheFInfo(fName: Str255; t: OSType); Var "theParms: ParamBlockRec; "TheInfo: CheatPtr; "errCode: OSErr; Procedure InitIO; Begin "With theParms Do $Begin &ioCompletion := NIL; &ioResult := 0; &ioNamePtr := @fName; &ioVRefNum := 0; { default } &ioLink := Nil; &ioType := 0; &ioFVersNum := 0; &ioFlVersNum := 0; $End; End; Begin "InitIO; "errCode := PBGetFInfo(@theParms, False); "With theParms Do $Begin &InitIO; &With ioFlFndrInfo Do (Begin *fdType := 'TEXT'; *fdCreator := t; *fdFlags := 0; { the Finder gets to set these bytes. } *fdLocation.h := 0; *fdLocation.v := 0; *fdFldr := 0; (End; &errCode := ReadDateTime(ioFlMdDate); { set the mod date } $End; { With } "errCode := PBSetFInfo(@theParms, False); End; {$S Util } Procedure TermBell; Begin "SysBeep(15); End; {$S Util } Function GetModel; Const "RomVersionAddress = $400008; Type "VerArray = Packed Array [0..1] Of Char; Var "pVersion: ^VerArray; Begin "pVersion := Pointer(Ord(RomVersionAddress)); "If Ord(pVersion^[0]) = 0 Then $GetModel := Macintosh "Else $GetModel := Lisa; End; {$S Util } { InRange(min, a, max: Integer): Boolean; } Function InRange; Begin "InRange := ((min <= a) And (a <= max)) End; {$S Util } { ForceRange(min, a, max: Integer): Integer; } Function ForceRange; Begin "If min > a Then $a := min; "If a > max Then $a := max; "ForceRange := a; End; {$S Util }                ' *:*;9*<:*=;*><*?=*@>*A?*B@* A+E+ D,H , IG, JH, KI, J MNLOMPNQORPSQTRUS VT WU XV YW ZX[Y\Z][^\_]`^a_b`cadbecfdgehfigjhkilj mk!nl"om#n qrpsqr uvtwuxvywzx{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 {  |! }"  ~#! $" %# &$ '% (& )' *( +) *-.,/-0.1/20314253 478697:8;9<:=;><?= @> A? @CDBECDGHFIGJHKILJMKL5,O,PN,QO,RP,SQ, R UVTWUXVYWZX[Y\Z][ ^\ _] `^ a_ b`cadbecfdgef ijhkij mnlompnqorpsqtrus vt wu xv yw zx{y|z}{~|}~          !"#                                              , S,G , K            ! " #! $" %# &$ '% (& )' *( +) ,* -+ ., /- 0. 1/ 20 31 42 53 64 75 86 97 :8 ;9 !<: "=; #>< $?= %@> &A? 'B@ (CA )DB *EC +FD ,GE -HF .IG /JH 0KI 1LJ 2MK 3NL 4OM 5PN 6QO 7RP 8SQ 9TR :US ;VT YW ?ZX @[Y A\Z B][ C^\ D_] E`^ Fa_ Gb` Hca Idb Jec Kfd Lge Mhf Nig Ojh Pki Qlj Rmk Snl Tom Upn Vqo Wrp Xsq Ytr Zus [vt \wu ]xv ^yw _zx `{y a|z b}{ c~| d} e~ f g !!!!!! """""" ########## # #  $$$$$$$$$$ $ $ $ $  %%%%%%%% &&&&&&&&&& & & & & &&&&&&&&&&&&&&&&&&& &!&"&#&$&%&&&'&(&)&*&+ '''''''''' ' '  (((( )))))))) ++++++++D