home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / code / ras_mwin.sit < prev    next >
Encoding:
Text File  |  1988-06-20  |  13.8 KB  |  709 lines

  1. 18-Jun-88 14:35:08-MDT,14844;000000000000
  2. Return-Path: <u-lchoqu%sunset@cs.utah.edu>
  3. Received: from cs.utah.edu by SIMTEL20.ARPA with TCP; Sat, 18 Jun 88 14:34:42 MDT
  4. Received: by cs.utah.edu (5.54/utah-2.0-cs)
  5.     id AA22392; Sat, 18 Jun 88 14:34:36 MDT
  6. Received: by sunset.utah.edu (5.54/utah-2.0-leaf)
  7.     id AA24679; Sat, 18 Jun 88 14:34:33 MDT
  8. Date: Sat, 18 Jun 88 14:34:33 MDT
  9. From: u-lchoqu%sunset@cs.utah.edu (Lee Choquette)
  10. Message-Id: <8806182034.AA24679@sunset.utah.edu>
  11. To: rthum@simtel20.arpa
  12. Subject: MWIndex.Ras
  13.  
  14.  
  15.  
  16. Program Index;
  17.  
  18. (* Index.
  19.     By Scott Gillespie @Reed College.  Program to index MacWrite 4.5
  20.        files *)
  21.  
  22. (* All of the libraries below are standard Rascal libraries *)
  23.  
  24. Uses __ToolTraps,
  25.      __OSTraps,
  26.      __EasyED,
  27. (*$U+*)
  28.      uToolIntf,
  29.      uOSIntf ;
  30.  
  31.  
  32. Link __Help, __Extendio, __Uniform, __EasyMenus,__SFNames,
  33.      __EasyED, __OSTraps, __Extras, __IO ;
  34.  
  35. EventMask  362; (*2+8+32+64+256 mdown, kdown, auto, update, activate *)
  36.  
  37. Const
  38.   DocMenu = 1000;
  39.   IndexMenu = 1001;
  40.   WordsMenu = 1002;
  41.  
  42.   RasEditId = 302;
  43.   RasRunID = 301;
  44.   RasRunItem = 1;
  45.  
  46.   RunID = IndexMenu;
  47.   RunItem = 9;
  48.  
  49.   dbReturn  = 1;
  50.   dbWord    = 2;
  51.   dbChapter = 3;
  52.   dbPage    = 4;
  53.   dbInc     = 5;
  54.   dbDec     = 6;
  55.   dbAdd     = 7;
  56.   dbBackUp  = 8;
  57.  
  58.   SelectNum = $13D;
  59.   KeyNum = $13E;
  60.  
  61.  
  62. Type
  63.   FileName = Byte[64];
  64.   pFileName = ^FileName;
  65.  
  66. Var
  67.   Speaking: Boolean;
  68.   DontHave: Boolean;
  69.   CurrentPara,Vref: Integer;
  70.     LastNib: byte;
  71.     NextAsc,
  72.     NeedNib: Boolean;
  73.   SHand: ^StringPtr;
  74.   TE: TEHandle;
  75.   TEChars: CharsHandle;
  76.   TEWind: WindowPtr;
  77.   MyLog: DialogPtr;
  78.   LastEntry: Str255;
  79.   LastWord: Str255;
  80.  
  81.   fInd,vrefInd: Integer;
  82.   nameInd: Str255;
  83.  
  84.   CurPnum: Integer;
  85.   AbsPageNum: Boolean;
  86.  
  87.   DocName: FileName;
  88.  
  89.   SelectTrap,
  90.   KeyTrap: PtrL;
  91.  
  92. ExtDef  (* variables stolen from Easymenus *)
  93.     MaxMenus,
  94.     NumMenus: Integer;
  95.     MenuIDs: Integer[10];
  96.  
  97.   (* The next few procedures comprise a sneaky way of getting Run... into
  98.      my Index menu.  It's a long story... *)
  99.  
  100. Function DoRemap(L: Longint): Longint;
  101. Var
  102.   Id,Item: Integer;
  103. {
  104.   Id := HiWord(L);
  105.   Item := LoWord(L);
  106.   If (ID = RunID) and (Item = RunItem) Then
  107.     L := (Longint(RasRunID)<<16) or RasRunItem;
  108.   DoRemap := L; 
  109. };
  110.  
  111. Function MyMenuSelect(StartPt: Longint): Longint; Clean;
  112. Var
  113.   TLong: Longint;
  114. {
  115.   RegCall(Call SelectTrap,,,,Result TLong, StartPt);
  116.   Return(DoRemap(TLong));
  117. };
  118.  
  119. Function MyMenuKey(theKey: Integer): Longint; Clean;
  120. Var
  121.   TLong: Longint;
  122. {
  123.   RegCall(Call KeyTrap,,,,Result TLong, theKey);
  124.   Return(DoRemap(TLong));
  125. };
  126.  
  127. Proc InitRunMenuTrick();
  128. {
  129.   SelectTrap := GetTrapAddress(SelectNum);
  130.   KeyTrap := GetTrapAddress(KeyNum);
  131.  
  132.   SetTrapAddress(@MyMenuSelect,SelectNum);
  133.   SetTrapAddress(@MyMenuKey,KeyNum);
  134. };
  135.  
  136. Proc HaltRunMenuTrick();
  137. {
  138.   SetTrapAddress(SelectTrap,SelectNum);
  139.   SetTrapAddress(KeyTrap,KeyNum);
  140. };
  141.  
  142. PROCEDURE hider();  
  143. var w: ptrL;
  144. {                             (* Hides all but the front window *)
  145.  w := FrontWindow();
  146.  w += $90;
  147.  loop(w^,w:=w^,w+=$90;w:=w^,w=0)
  148.    HideWindow(w);   
  149. };
  150.  
  151.  
  152.     (* The following procedures are taken almost verbatim from
  153.        ReadMacWrite.src, posted a while ago *)
  154.  
  155. Func IsBit(b: byte; bitnum:integer): Boolean; { Return((b>>bitnum) and 1)
  156. };
  157. Proc ffread(f: integer; buf: ptrb; amt: longint); { fread(f,buf,@amt) };
  158.  
  159. Function Decompress(b: byte): Integer;
  160. {
  161.   if neednib Then {
  162.     neednib := False;
  163.     Decompress := (LastNib or b);
  164.     }
  165.   Else
  166.     if nextasc Then {
  167.       nextasc := False;
  168.       neednib := True;
  169.       LastNib := b << 4;
  170.       Decompress := -1;
  171.       }
  172.   Else
  173.     if b=15 Then {
  174.       nextasc := True;
  175.       Decompress := -1;
  176.       }
  177.   Else
  178.     Return(ptrb(++b + " etnroaisdlhcfp")^);
  179. };
  180.  
  181. Procedure Addchar(c: integer);
  182. Var
  183.   size: longint;
  184. {
  185.   size := GethandleSize(TEChars);
  186.   SethandleSize(TEChars,size+1);
  187.   TEChars^^[Size] := c;
  188. };
  189.  
  190. Proc FileDone(); { Sysbeep(5) };
  191.  
  192. Proc Flush();
  193. var
  194.   io: integer;
  195. {
  196.   io := FlushVol(Nil,VrefInd);
  197. };
  198.  
  199. Func NextScreen(StartPara: Integer): Integer;
  200. Const
  201.   MaxChars = 10000;
  202. Type
  203.   IArray = Record
  204.     height: integer;
  205.     pagepos: integer;
  206.     ParaHand: Union
  207.         pagenum: byte;
  208.         Hand: ^^Longint;
  209.     End;
  210.     StPos: Union
  211.        St: byte;  (* first byte is status *)
  212.        Pos: longint;
  213.     End;
  214.     DataLength: integer;
  215.     formats: Integer;
  216.   End;
  217.  
  218. Var
  219.     GotOne: Boolean;
  220.     StartPNum,
  221.     LastPNum: Integer;
  222.     Buf: ^Byte[20];
  223.     press: Boolean;
  224.     off: Longint;
  225.     infohand: ^^Iarray[20];
  226.     f, count,i,c,j,d,k,len: integer;
  227.     DocVars: Record
  228.        IApos: Longint;
  229.        IAlength: Integer;
  230.        End;
  231. {
  232.  
  233.   If StartPara < 0 Then Return(-1);
  234.  
  235.   GotOne := False;
  236.   Buf := NewPtr(0L);
  237.   New_Ed(DocName);
  238.   watch();
  239.  
  240.   fopen(@f,DocName,0,vref);
  241.   If absPageNum Then {
  242.     fmoveto(f,16L);
  243.     ffread(f,@StartPNum,2L);
  244.     };
  245.  
  246.   fmoveto(f,252L);           (* Main Document info *)
  247.   fmove(f,12L);
  248.   ffread(f,DocVars,6L);
  249.  
  250.   InfoHand := NewHandle(Longint(DocVars.IALength));
  251.   fmoveto(f,DocVars.IAPos);  (* Paragraph Array *)
  252.   Hlock(InfoHand);
  253.   ffread(f,InfoHand^,Longint(DocVars.IALength));
  254.   Hunlock(InfoHand);
  255.   Count := DocVars.IALength/16;
  256.   loop(count,i:=StartPara,,++i=count) {
  257.     Off := InfoHand^^[i].stpos.pos and $00FFFFFF;  (* clear status byte
  258. *)
  259.     press := isbit(InfoHand^^[i].stpos.st,3);
  260.     If (!Gotone and absPageNum) Then
  261.       CurPNum := InfoHand^^[i].ParaHand.PageNum;
  262.     If InfoHand^^[i].ParaHand.PageNum > CurPNum Then
  263.        Break;
  264.     GotOne := True;
  265.     LastPNum := InfoHand^^[i].ParaHand.PageNum;
  266.     fMoveTo(f,off);
  267.     if InfoHand^^[i].height <= 0 Then Continue; (* not text *)
  268.     fgetint(f,@len);
  269.  
  270.     If (GetHandleSize(TEChars)+len) > MaxChars Then
  271.       If i<>StartPara Then
  272.         Break;
  273.  
  274.     SetPtrSize(buf,longint(len));
  275.     ffread(f,buf,longint(len));
  276.     If !press Then
  277.         loop(len,j:=0,,++j=len)
  278.            Addchar(Integer(buf^[j]))
  279.       Else
  280.         loop(len,NextAsc:=False;NeedNib:=False;j:=0;k:=0,++k,) {
  281.           d := Decompress(buf^[k] >> 4);
  282.           If d > 0 then {
  283.             Addchar(d);
  284.             If ++j>=len then break;
  285.             };
  286.           d := Decompress(buf^[k] and Byte($0F));
  287.           If d > 0 then {
  288.             Addchar(d);
  289.             If ++j>=len then break;
  290.             };
  291.           };
  292.     };
  293.  
  294.   If !absPageNum Then {
  295.     ++CurPNum;
  296.     ChangePage(1);
  297.     }
  298.   Else
  299.     SetPage(LastPNum+StartPNum);
  300.  
  301.  
  302.   If i=count Then
  303.     NextScreen := -1
  304.    Else
  305.     NextScreen := i;
  306.  
  307.   Disposptr(Buf);
  308.   Disposhandle(infohand);
  309.   fclose(f);
  310.   Flush();
  311.   TECalText(TE);
  312.   adjust_ed();
  313.   arrow();
  314. };
  315.  
  316. Proc NewFile();
  317. Var
  318.     good : Integer;
  319.     np: ptrb;
  320. {
  321.   ngetfile(100,70,@np," WORD"+2,1,@vref,@good);
  322.   if !good then return;
  323.   DocName := pFileName(np)^;
  324.   CurPNum := 0;
  325.   CurrentPara := NextScreen(0);
  326.   If CurrentPara = -1 Then
  327.     FileDone();
  328. };
  329.  
  330. Func ItemHandle(Item: Integer): Handle;
  331. Var
  332.   R: Rect;
  333.   aType: Integer;
  334.   THand: Handle;
  335. {
  336.   GetDItem(MyLog,Item,@atype,@THand,@R);
  337.   Return(THand);
  338. };
  339.  
  340. Proc FlashIt(Item: Integer);
  341. Var
  342.   C: Controlhandle;
  343.   T: Longint;
  344. {
  345.   C := ItemHandle(Item);
  346.   HiliteControl(C,1);
  347.   Loop(,T:=TickCount()+12,,TickCount()>T);
  348.   HiliteControl(C,0);
  349. };
  350.  
  351. Proc ShowWord(s,f: integer);
  352. Var
  353.   TextHand: Handle;
  354.   NewWord: Str255;
  355.   i: integer;
  356. {
  357.   If ((f=s) or ((f-s)>255)) then Return;
  358.   TextHand := ItemHandle(dbWord);
  359.   NewWord[0]:= f-s;
  360.   Loop(,i:=s,,++i>f)
  361.     NewWord[i-s+1] := TEChars^^[i];
  362.   SetIText(TextHand,NewWord);
  363.   SelIText(MyLog,dbWord,0,30000);
  364. };
  365.  
  366. Procedure SetPage(i: integer);
  367. Var
  368.  PHand: Handle;
  369.  Str: Str255;
  370.  Num: Longint;
  371. {
  372.   PHand := ItemHandle(dbPage);
  373.   Num := i;
  374.   NumToString(Num,Str);
  375.   SetIText(pHand,Str);
  376. };
  377.  
  378. Procedure ChangePage(amt: integer);
  379. Var
  380.  PHand: Handle;
  381.  Str: Str255;
  382.  Num: Longint;
  383. {
  384.   PHand := ItemHandle(dbPage);
  385.   GetIText(pHand,@Str);
  386.   StringToNum(Str,@Num);
  387.   Num += amt;
  388.   NumToString(Num,Str);
  389.   SetIText(pHand,Str);
  390. };
  391.  
  392. Procedure MyCat(s1,s2: Str255);
  393. Var
  394.   i: integer;
  395. {
  396.   If (s1[0] + s2[0]) > 254 Then Return;
  397.   Loop(s2[0],i:=s2[0],,!--i)
  398.     s1[s1[0]+i] := s2[i];
  399.   s1[0]+=s2[0];
  400. };
  401.  
  402. Proc PutWord(Word: Str255);
  403. Var
  404.   err: integer;
  405. {
  406.   If DontHave Then Return;
  407.   fputs(FInd,Word);
  408.   fputc(FInd,13);
  409.   ferr(@err);
  410.   if err Then {sysbeep(2);sysbeep(2);sysbeep(2);sysbeep(2);};
  411. };
  412.  
  413. Procedure AddEntry();
  414. Var
  415.   Str: Str255;
  416.   tHand: Handle;
  417. {
  418.   tHand := ItemHandle(dbWord);
  419.   GetIText(tHand,@str);
  420.   if !str[0] Then Return;
  421.   if LastEntry[0] Then
  422.     PutWord(LastEntry);
  423.   LastEntry := Str;
  424.   LastWord := Str;
  425.   If Speaking Then sysbeep(1);
  426.   tHand := ItemHandle(dbChapter);
  427.   GetIText(tHand,@str);
  428.   MyCat(LastEntry," ");
  429.   MyCat(LastEntry,Str);
  430.   tHand := ItemHandle(dbPage);
  431.   GetIText(tHand,@str);
  432.   MyCat(LastEntry,Str);
  433. };
  434.  
  435. Procedure RemoveLast();
  436. Var
  437.   THand: Handle;
  438.   Str: Str255;
  439. {
  440.   If !LastEntry[0] Then { Sysbeep(2); Return };
  441.   LastEntry[0]:=0;
  442.   THand := ItemHandle(dbWord);
  443.   SetIText(THand,LastWord);
  444.   SelIText(Mylog,dbWord,0,30000);
  445. };
  446.  
  447. Procedure HandleDlog(item: integer);
  448. {
  449.   Case Item of
  450.     dbInc: ChangePage(1);
  451.     dbDec: ChangePage(-1);
  452.     dbAdd: AddEntry();
  453.     dbBackUp: RemoveLast();
  454.   End;
  455. };
  456.  
  457. Proc CloseIndex();
  458. {
  459.   If DontHave Then
  460.     Return;
  461.   if LastEntry[0] Then
  462.     PutWord(LastEntry);
  463.   FClose(fInd);
  464.   Flush();
  465.   HideWindow(MyLog);
  466. };
  467.  
  468. Proc NewIndex(nameptr:ptrb;vref:integer);
  469. Var
  470.   Good: Integer;
  471. {
  472.   Good := 1;
  473.  
  474.   If !nameptr Then
  475.     PutFile(@nameptr,@vref,@good);
  476.  
  477.   If !good Then Return;
  478.   CloseIndex();
  479.   DontHave := False;
  480.   fcreate(nameptr," rIND"+2," TEXT"+2,vref);
  481.   fopen(@fInd,nameptr,3,vref);
  482.   VrefInd := vref;
  483.   SetWTitle(MyLog,nameptr);
  484.   fseek(fInd,0L,2);
  485.   ShowWindow(MyLog);
  486. };
  487.  
  488. Proc OpenIndex();
  489. Var
  490.  nameptr: ptrb;
  491.  vref,good: integer;
  492. {
  493.   GetFile(@nameptr,@vref,@good);
  494.   If !good then
  495.     Return;
  496.   NewIndex(nameptr,vref);
  497. };
  498.  
  499. Proc SaveIndex();
  500. Var
  501.   io: Integer;
  502. {
  503.     if LastEntry[0] Then PutWord(LastEntry);
  504.     Flush();
  505. };  
  506.  
  507. Proc InitMyMenus();
  508. Var m: ptrl;
  509. {
  510.   m := NewMenu(IndexMenu,"Index");
  511.   InsertMenu(m,RasEditID);
  512.   MenuIds[0] := IndexMenu;
  513.   ++Nummenus;
  514.  
  515.   AddItem(IndexMenu, "New...");
  516.   AddItem(IndexMenu, "Open...");
  517.   AddItem(IndexMenu, "Save");
  518.   AddItem(IndexMenu, "Close");
  519.   AddItem(IndexMenu, "(-");
  520.   AddItem(IndexMenu, "Feedback");
  521.   AddItem(IndexMenu, "(-");
  522.   AddItem(IndexMenu, "Help");
  523.   AddItem(IndexMenu, "Run...");
  524.   AddItem(IndexMenu, "Quit");
  525.  
  526.   AddMenu(DocMenu, "Document");
  527.   AddItem(DocMenu, "Open.../O");
  528.   AddItem(DocMenu, "(-");
  529.   AddItem(DocMenu, "Next Page/N");
  530.   AddItem(DocMenu, "Go To First Page/G");
  531.   AddItem(DocMenu, "(-");
  532.   AddItem(DocMenu, "Up/Q");
  533.   AddItem(DocMenu, "Down/W");
  534.   AddItem(DocMenu, "(-");
  535.   AddItem(DocMenu, "True Numbering");
  536.  
  537.   AddMenu(WordsMenu, "Words");
  538.   AddItem(WordsMenu, "Add Word/A");
  539.   AddItem(WordsMenu, "Back Up/B");
  540. };
  541.  
  542.  
  543. Proc _Init();
  544. Var
  545.   TheInfo: AppFile;
  546.   message,count: Integer;
  547. {
  548.   CurPNum := 0;
  549.   AbsPageNum := False;
  550.  
  551.   Speaking := False;
  552.   DontHave := True;
  553.   InitEasyMenus();
  554.   InitMyMenus();
  555.   Init_ED("Untitled",3,12,5,41,506,238);
  556.   hider();
  557.   TE := Get_EDHandle();
  558.   TEChars :=  Get_EDChars();
  559.   TEWind := Get_EDWindow();
  560.  
  561.   MyLog := GetNewDialog(1000,Nil,-1L);
  562.   CurrentPara := -1;
  563.  
  564.   LastEntry[0] := 0;
  565.   InitRunMenuTrick();
  566.   CountAppFiles(@message,@count);
  567.   if !count or (message = AppPrint) Then return;
  568.   GetAppFiles(1,theInfo);
  569.   if EqualString("index.help",theInfo.fname,false,True) Then {
  570.     Help(theInfo.fname,0);
  571.     Return;
  572.     };
  573.   NewIndex(theInfo.fname,theInfo.vrefNum);
  574. };
  575.  
  576. Proc _Menu(id,item: integer);
  577. {
  578.   Case id of
  579.     DocMenu:
  580.       Case item of
  581.         1: NewFile();
  582.         3:{ CurrentPara := NextScreen(CurrentPara);
  583.             If CurrentPara = -1 Then
  584.               FileDone();
  585.             };
  586.         4:{ ChangePage(-CurPNum);
  587.             CurPNum := 0;
  588.             CurrentPara := NextScreen(0);
  589.             If CurrentPara = -1 Then
  590.               FileDone();
  591.            };
  592.         6: EDPage(-1);
  593.         7: EDPage(1);
  594.         9: {
  595.           absPageNum := !absPageNum;
  596.           CheckEasy(ID,Item,absPageNum);
  597.           };
  598.       End;
  599.  
  600.     IndexMenu:
  601.       Case item of
  602.         1: NewIndex(Nil,0);
  603.         2: OpenIndex();
  604.         3: SaveIndex();
  605.         4: CloseIndex();
  606.         5:;
  607.         6:   {
  608.                Speaking := !Speaking;
  609.                CheckEasy(IndexMenu,item,Speaking);
  610.              };
  611.         7:;
  612.         8: Help("Index.Help",0);
  613.         9: (* Run... *) ;
  614.         10: ReqHalt();
  615.       End;
  616.  
  617.     WordsMenu:
  618.       Case item of
  619.         1: { AddEntry(); FlashIt(dbAdd) };
  620.         2: { RemoveLast(); FlashIt(dbBackUp) };
  621.         3: { ChangePage(1); FlashIt(dbInc) };
  622.         4: { ChangePage(-1); FlashIt(dbDec) };
  623.       End;
  624.   End;
  625. };
  626.  
  627. Proc _Halt();
  628. {
  629.   HaltRunMenuTrick();
  630.   DisposDialog(MyLog);
  631.   HaltEasyMenus();
  632.   Halt_ED();
  633.   PutWord(LastEntry);
  634.   fclose(FInd);
  635.   Flush();
  636. };
  637.  
  638. procedure _event(Event: EventRecord);
  639. Const
  640.     Comkey      = 256;
  641. Var
  642.   Men: Longint;
  643.   WhichWindow: WindowPtr;
  644.   WhichDlog: DialogPtr;
  645.   item,start,finish: integer;
  646.   TEHit,
  647.   DontLog: Boolean;
  648.  
  649. {
  650.  
  651.   TEHit := False;
  652.   DontLog := False;
  653.  
  654.   If Event.What = MouseDown Then
  655.     If FindWindow(Event.Where.vh,@WhichWindow) > 2 Then
  656.       Begin
  657.         SelectWindow(WhichWindow);
  658.         If (WhichWindow = TEWind) Then
  659.           TEHit := True;
  660.       End;
  661.  
  662.   If Event.What = KeyDown Then
  663.     If (Event.Modifiers and ComKey) Then
  664.       DontLog := True
  665.     Else
  666.       If ((Event.Message % 128) = 13) Then
  667.         If FrontWindow() = MyLog Then {
  668.           HandleDlog(dbAdd);
  669.           Flashit(dbAdd);
  670.           SelIText(MyLog,dbWord,0,30000);
  671.           Event.What := -1;
  672.           Return;
  673.           };
  674.  
  675.   If (IsDialogEvent(Event) and !DontLog) Then {
  676.     If DialogSelect(Event,@Whichdlog,@item) Then
  677.       HandleDlog(item);
  678.     Event.What := -1;
  679.     Return;
  680.     };
  681.  
  682.   Event_ED(Event);
  683.  
  684.   Case Event.What of
  685.     KeyDown:
  686.         If (Event.Modifiers and ComKey) then {
  687.             Men := MenuKey(Integer(Event.Message%256));
  688.             If Hiword(Men) < 1000 Then Return;
  689.             HiliteMenu(Hiword(Men));
  690.             _Menu(Hiword(Men),LoWord(Men));
  691.             HiliteMenu(0);
  692.             Event.What := -1;
  693.             };
  694.   End;
  695.  
  696.   If TEHit Then
  697.     Begin
  698.       Get_EDSelect(@start,@finish);
  699.       If start<>finish Then
  700.         ShowWord(start,finish);
  701.     End;
  702.  };
  703.  
  704.  
  705. procedure _main();
  706. {
  707.   Main_ED();
  708. };
  709.