home *** CD-ROM | disk | FTP | other *** search
/ Mac Mania 2 / MacMania 2.toast / Demo's / Tools&Utilities / Programming / ViewIt 2.24 / FORTRAN Demo Projects / Absoft MacFortran II 3.2 Demos / fDemoAF.f < prev    next >
Encoding:
Text File  |  1993-09-21  |  3.7 KB  |  144 lines  |  [TEXT/MPS ]
  1. C NOTE: Read the "MPW Fortrans" section of "About Compilers"
  2. C before compiling AF programs that use FaceWare modules.
  3.  
  4. C FaceIt 2.2 Demonstration Program
  5. C ©FaceWare 1989-93.  All Rights Reserved.
  6. C1 - run program to see on-line comments
  7.  
  8.     GLOBAL DEFINE
  9.     include "Types.inc"
  10.     include "QuickDraw.inc"
  11.     include "ToolUtils.inc"
  12.     include "Controls.inc"
  13.     include "Events.inc"
  14.     include "OSUtils.inc"
  15.     include "OSEvents.inc"
  16.     include "SegLoad.inc"
  17.     include "Files.inc"
  18.     include "Resources.inc"
  19.     include "FaceStorAF.inc"
  20.     END
  21. C2
  22.     include "FaceProcAF.inc"
  23.  
  24.       PROGRAM fDemoAF
  25.     implicit none
  26.       record /FaceRec/ fRec
  27.       common/FaceStuff/fRec
  28.     integer*1 keys(16)
  29.     integer*2 mode
  30.     integer*4 oldCount,newCount
  31.     character*256 fileName
  32. C3
  33.       fRec.uName = 'fDemo.Rsrc'
  34. C4
  35.       call FaceIt(0,DoInit,3,0,0,0)
  36. C5
  37.     call FaceIt(0,NewWnd,1010,1,0,0)
  38.     call FaceIt(0,NewWnd,1020,1,0,0)
  39. C6
  40.     call FaceIt(0,NewWnd,1030,1,0,0)
  41. C7
  42.     call FaceIt(0,NewWnd,1040,2,0,0)
  43. C8
  44.       do while (.true.)
  45.         call FaceIt(0,DoLoop,0,0,0,0)
  46. C9
  47. C10
  48.         if (fRec.uMenuID == 101) then
  49.         if (fRec.uMenuItem == 1) then
  50.           fRec.uString = 'Demonstration of the use of FaceIt'
  51.      +//char(13)//'to support program-wide features.'
  52.           call FaceIt(0,ShoStr,3,12,(1 + (409*65536)),0)
  53.         end if
  54. C11
  55.       else if (fRec.uMenuID == 102) then
  56.         if (fRec.uMenuItem == 6) then
  57.           call FaceIt(0,GetWVC,1010,0,0,0)
  58.           call FaceIt(0,SavWnd,1010,0,0,0)
  59.           call FaceIt(0,GetWVC,1020,0,0,0)
  60.           call FaceIt(0,SavWnd,1020,0,0,0)
  61.           call FaceIt(0,GetWVC,1040,0,0,0)
  62.           call FaceIt(0,SavWnd,1040,0,0,0)
  63.         end if
  64. C12
  65.       else if ((fRec.uMenuID >= 105).and.(fRec.uMenuID <= 1040)) then
  66.         if (fRec.uMenuItem == 1) then
  67.           call SysBeep(%val2(5))
  68.         else if (fRec.uMenuItem == 2) then
  69.           call SysBeep(%val2(5))
  70.           call SysBeep(%val2(5))
  71.         else if (fRec.uMenuItem == 3) then
  72.           call SysBeep(%val2(5))
  73.           call SysBeep(%val2(5))
  74.           call SysBeep(%val2(5))
  75. C13
  76.         else if (fRec.uMenuItem == 4) then
  77.           call FaceIt(0,GetCtl,1030,0,1,4)
  78.           call FaceIt(0,PopMen,107,fRec.cRect(1)-9,fRec.cRect(2)-10,0)
  79. C14
  80.         else if (fRec.uMenuItem == 8) then
  81. C15
  82.         call FaceIt(0,ShoAlt,1010,0,1,1)
  83.         mode = fRec.uResult
  84.         oldCount = 0
  85.         if (mode > 1) then
  86.           do while (.true.)
  87. C16
  88.             newCount = TickCount()
  89.             if (newCount - oldCount > 180) then
  90.               call SysBeep(%val2(5))
  91.             oldCount = newCount
  92.             end if
  93. C17
  94.             if (mode == 2) then
  95.               if (GetNextEvent(%val2(-1),fRec.fEvent) <> 0) then
  96.               if (fRec.fEvent(1) == 5) then
  97.                 exit
  98.               else
  99.                 call FaceIt(0,DoEvnt,0,0,0,0)
  100.               end if
  101.             end if
  102.             end if
  103. C18
  104.             if (mode == 3) then
  105.               call GetKeys(keys)
  106.             if ((BitTst(keys,%val4(61))<>0)
  107.      +         .and.(BitTst(keys,%val4(48))<>0)) then
  108.               call FlushEvents(%val2(62),%val2(0))
  109.               exit
  110.             end if
  111.             end if
  112.           end do
  113.         end if
  114.         end if
  115. C19
  116.       else if (fRec.uMenuID == 1100) then
  117.         if (fRec.uMenuItem == 2) then
  118.           if (fRec.fActiveWnd == 0) then
  119.           fRec.uString = 'No Window'
  120.         else if (fRec.fActiveID <> 1200) then
  121.           fRec.uString = 'Non-ViewIt Window'
  122.         else if (fRec.fActiveResID == 1204) then
  123.           fRec.uString = 'Help Window'
  124.         else if (fRec.fActiveResID == 1010) then
  125.           fRec.uString = 'Editor Window'
  126.         else if (fRec.fActiveResID == 1020) then
  127.           fRec.uString = 'Clipboard Window'
  128.         else if (fRec.fActiveResID == 1030) then
  129.           fRec.uString = 'Beeps Window'
  130.         end if
  131.         call FaceIt(0,SetItm2,105,10,3,0)
  132. C20
  133.         else if (fRec.uMenuItem == 512) then
  134.           if ((fRec.uString == 'TEXT').and.(fRec.uResult == 1)) then
  135.           fileName = fRec.uName
  136.           call FaceIt(0,GetCtl,1010,0,1,1)
  137.           fRec.uName = fileName
  138.           call FaceIt(fRec.cControl,1551,0,1,0,0) !OpnCTxt
  139.         end if
  140.         end if
  141.       end if
  142.       end do
  143.       end
  144.