home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 149.lha / ColorTerm / menustuff.4th < prev    next >
Encoding:
Text File  |  1988-04-26  |  8.6 KB  |  278 lines
  1. \ This file Copyright 1988 by Warren Block.
  2.  
  3. \ menustuff.f
  4.  
  5. DECIMAL
  6.  
  7. GLOBAL Continue?
  8.  
  9. \ Project   Baud Rate   Columns
  10. \  About       300        40
  11. \  -----      1200        80
  12. \  Quit       2400
  13.  
  14. CREATE Project$   0," Project"
  15. CREATE About$     0," About"
  16. CREATE Blank$     0,"      "
  17. CREATE Quit$      0," Quit "
  18. CREATE Baud$      0," Baud Rate"
  19. CREATE Baud300$   0,"     300"
  20. CREATE Baud1200$  0,"    1200"
  21. CREATE Baud2400$  0,"    2400"
  22. CREATE Column$    0," Columns"
  23. CREATE Column40$  0,"    40"
  24. CREATE Column80$  0,"    80"
  25.  
  26. 3 CONSTANT NumMenus
  27. 3 CONSTANT NumProjectItems
  28. 3 CONSTANT NumBaudItems
  29. 2 CONSTANT NumColumnItems
  30.  
  31. GLOBAL MenuBase
  32. GLOBAL ProjectITextBase
  33. GLOBAL ProjectMItemBase
  34. GLOBAL BaudITextBase
  35. GLOBAL BaudMItemBase
  36. GLOBAL ColumnITextBase
  37. GLOBAL ColumnMItemBase
  38.  
  39. VARIABLE ProjectMenu
  40. VARIABLE BaudMenu
  41. VARIABLE ColumnMenu
  42.  
  43. struct Menu DefaultMenu
  44.    NULL        DefaultMenu +muNextMenu  !
  45.    1           DefaultMenu +muLeftEdge  W!
  46.    0           DefaultMenu +muTopEdge   W!
  47.    78          DefaultMenu +muWidth     W!
  48.    10          DefaultMenu +muHeight    W!
  49.    MENUENABLED DefaultMenu +muFlags     W!
  50.    NULL        DefaultMenu +muMenuName  W!
  51.    NULL        DefaultMenu +muFirstItem !
  52. structend
  53.  
  54. struct IntuiText DefaultIText
  55.    0     DefaultIText +itFrontPen  C!
  56.    1     DefaultIText +itBackPen   C!
  57.    JAM2  DefaultIText +itDrawMode  C!
  58.    2     DefaultIText +itLeftEdge  W!
  59.    1     DefaultIText +itTopEdge   W!
  60.    NULL  DefaultIText +itITextFont !
  61.    NULL  DefaultIText +itIText     !
  62.    NULL  DefaultIText +itNextText  !
  63. structend
  64.  
  65. struct MenuItem DefaultMItem
  66.    NULL DefaultMItem +miNextItem      !
  67.    2    DefaultMItem +miLeftEdge      W!
  68.    0    DefaultMItem +miTopEdge       W!
  69.    20   DefaultMItem +miWidth         W!
  70.    10   DefaultMItem +miHeight        W!
  71.    ITEMTEXT HIGHCOMP | ITEMENABLED | DefaultMItem +miFlags W!
  72.    NULL DefaultMItem +miMutualExclude !
  73.    NULL DefaultMItem +miItemFill      !
  74.    NULL DefaultMItem +miSelectFill    !
  75.    0    DefaultMItem +miCommand       C!
  76.    NULL DefaultMItem +miSubItem       !
  77.    0    DefaultMItem +miNextSelect    W!
  78. structend
  79.  
  80. : GetMenuMemory   ( --- )  \ Allocate RAM for menu stuff.
  81.    NumProjectItems IntuiText * MEMF_PUBLIC MEMF_CLEAR | AllocMem
  82.    TO ProjectITextBase
  83.    NumProjectItems MenuItem  * MEMF_PUBLIC MEMF_CLEAR | AllocMem
  84.    TO ProjectMItemBase
  85.    NumBaudItems IntuiText    * MEMF_PUBLIC MEMF_CLEAR | AllocMem
  86.    TO BaudITextBase
  87.    NumBaudItems MenuItem     * MEMF_PUBLIC MEMF_CLEAR | AllocMem
  88.    TO BaudMItemBase
  89.    NumColumnItems IntuiText  * MEMF_PUBLIC MEMF_CLEAR | AllocMem
  90.    TO ColumnITextBase
  91.    NumColumnItems MenuItem   * MEMF_PUBLIC MEMF_CLEAR | AllocMem
  92.    TO ColumnMItemBase
  93.    NumMenus Menu             * MEMF_PUBLIC MEMF_CLEAR | AllocMem
  94.    TO MenuBase
  95.    MenuBase ProjectMenu !
  96.    MenuBase Menu + BaudMenu !
  97.    MenuBase Menu 2* + ColumnMenu ! ;
  98.  
  99. : FreeMenuMemory   ( --- )  \ Deallocate menu RAM.
  100.    ProjectITextBase NumProjectItems IntuiText * FreeMem
  101.    ProjectMItemBase NumProjectItems MenuItem  * FreeMem
  102.    BaudITextBase    NumBaudItems    IntuiText * FreeMem
  103.    BaudMItemBase    NumBaudItems    MenuItem  * FreeMem
  104.    ColumnITextBase  NumColumnItems  IntuiText * FreeMem
  105.    ColumnMItemBase  NumColumnItems  MenuItem  * FreeMem
  106.    MenuBase         NumMenus        Menu      * FreeMem ;
  107.  
  108. : ProjectITexts   ( n --- itext )  \ Array of IntuiTexts.
  109.    ProjectITextBase SWAP IntuiText * + ;
  110.  
  111. : ProjectMItems   ( n --- mitem )  \ Array of MenuItems.
  112.    ProjectMItemBase SWAP MenuItem * + ;
  113.  
  114. : BaudITexts   ( n --- itext )  \ Array of IntuiTexts.
  115.    BaudITextBase SWAP IntuiText * + ;
  116.  
  117. : BaudMItems   ( n -- mitem )  \ Array of MenuItems.
  118.    BaudMItemBase SWAP MenuItem * + ;
  119.  
  120. : ColumnITexts   ( n --- itext )
  121.    ColumnITextBase SWAP IntuiText * + ;
  122.  
  123. : ColumnMItems   ( n --- mitem )
  124.    ColumnMItemBase SWAP MenuItem * + ;
  125.  
  126. : InitIText   ( addr --- )  \ Copy defaults into an IntuiText.
  127.    DefaultIText SWAP IntuiText CMOVE ;
  128.  
  129. : InitITexts   ( --- )  \ Prepare all the IntuiTexts.
  130.    NumProjectItems 0 DO
  131.      I ProjectITexts InitIText
  132.    LOOP
  133.    NumBaudItems 0 DO
  134.      I BaudITexts    InitIText
  135.    LOOP
  136.    NumColumnItems 0 DO
  137.      I ColumnITexts InitIText
  138.    LOOP ;
  139.  
  140. : PointStrings   ( --- )  \ Set string pointers for IntuiText structures.
  141.    About$    0 ProjectITexts +itIText !
  142.    Blank$    1 ProjectITexts +itIText !
  143.    Quit$     2 ProjectITexts +itIText !
  144.    Baud300$  0 BaudITexts    +itIText !
  145.    Baud1200$ 1 BaudITexts    +itIText !
  146.    Baud2400$ 2 BaudITexts    +itIText !
  147.    Column40$ 0 ColumnITexts  +itIText !
  148.    Column80$ 1 ColumnITexts  +itIText ! ;
  149.  
  150. : InitMItem   ( addr --- )  \ Copy defaults into a MenuItem.
  151.    DefaultMItem SWAP MenuItem CMOVE ;
  152.  
  153. : InitMItems   ( --- )  \ Put default values in all the MenuItems.
  154.    NumProjectItems 0 DO
  155.      I ProjectMItems InitMItem
  156.      I ProjectITexts  I ProjectMItems +miItemFill !
  157.      I 10* I ProjectMItems +miTopEdge W!
  158.      91    I ProjectMItems +miWidth   W!
  159.      ITEMTEXT HIGHCOMP | ITEMENABLED | I ProjectMItems +miFlags W!
  160.    LOOP
  161.    ITEMTEXT HIGHCOMP | 1 ProjectMItems +miFlags W!  \ can't select blank
  162.    NumBaudItems 0 DO
  163.      I BaudMItems InitMItem
  164.      I BaudITexts  I BaudMItems +miItemFill !
  165.      I 10* I BaudMItems +miTopEdge W!
  166.      83    I BaudMItems +miWidth   W!
  167.      ITEMTEXT HIGHCOMP | ITEMENABLED | CHECKIT | I BaudMItems +miFlags W!
  168.    LOOP
  169.    ITEMTEXT HIGHCOMP | ITEMENABLED | CHECKIT | CHECKED |
  170.    1 BaudMItems +miFlags W!
  171.    NumColumnItems 0 DO
  172.      I ColumnMItems InitMItem
  173.      I ColumnITexts  I ColumnMItems +miItemFill !
  174.      I 10* I ColumnMItems +miTopEdge W!
  175.      67    I ColumnMItems +miWidth   W!
  176.      ITEMTEXT HIGHCOMP | ITEMENABLED | CHECKIT | I ColumnMItems +miFlags W!
  177.    LOOP
  178.    ITEMTEXT HIGHCOMP | ITEMENABLED | CHECKIT | CHECKED |
  179.    0 ColumnMItems +miFlags W! ;
  180.  
  181. : CreateLinks   ( --- )  \ Put everything together.
  182.    NumProjectItems 1- 0 DO
  183.      I 1+ ProjectMItems  I ProjectMItems +miNextItem !
  184.    LOOP
  185.    NULL NumProjectItems 1- ProjectMItems +miNextItem !
  186.    NumBaudItems 1- 0 DO
  187.      I 1+ BaudMItems  I BaudMItems +miNextItem !
  188.    LOOP
  189.    NULL NumBaudItems 1- BaudMItems +miNextItem !
  190.    NumColumnItems 1- 0 DO
  191.      I 1+ ColumnMItems  I ColumnMItems +miNextItem !
  192.    LOOP
  193.    NULL NumColumnItems 1- ColumnMItems +miNextItem ! ;
  194.  
  195. : AddExtras   ( --- )  \ Extra stuff for MenuItems.
  196.    0 ProjectMItems +miFlags W@ COMMSEQ |
  197.    0 ProjectMItems +miFlags W!
  198.    ASCII A  0 ProjectMItems +miCommand C!
  199.    65534    0 ProjectMItems +miMutualExclude !
  200.    2 ProjectMItems +miFlags W@ COMMSEQ |
  201.    2 ProjectMItems +miFlags W!
  202.    ASCII Q  2 ProjectMItems +miCommand C!
  203.    65533    2 ProjectMItems +miMutualExclude !
  204.    65534    0 BaudMItems +miMutualExclude !
  205.    65533    1 BaudMItems +miMutualExclude !
  206.    65531    2 BaudMItems +miMutualExclude !
  207.    65534    0 ColumnMItems +miMutualExclude !
  208.    65533    1 ColumnMItems +miMutualExclude ! ;
  209.  
  210. : CreateMenus   ( --- )  \ Tie everything together.
  211.    DefaultMenu ProjectMenu @ Menu CMOVE
  212.    Project$        ProjectMenu @ +muMenuName !
  213.    78              ProjectMenu @ +muWidth W!
  214.    BaudMenu @      ProjectMenu @ +muNextMenu !
  215.    0 ProjectMItems ProjectMenu @ +muFirstItem !
  216.    DefaultMenu BaudMenu @ Menu CMOVE
  217.    Baud$        BaudMenu @ +muMenuName  !
  218.    80           BaudMenu @ +muLeftEdge  W!
  219.    86           BaudMenu @ +muWidth     W!
  220.    ColumnMenu @ BaudMenu @ +muNextMenu  !
  221.    0 BaudMItems BaudMenu @ +muFirstItem !
  222.    DefaultMenu ColumnMenu @ Menu CMOVE
  223.    Column$ ColumnMenu @ +muMenuName !
  224.    168     ColumnMenu @ +muLeftEdge W!
  225.    67      ColumnMenu @ +muWidth    W!
  226.    NULL    ColumnMenu @ +muNextMenu !
  227.    0 ColumnMItems ColumnMenu @ +muFirstItem ! ;
  228.  
  229. : SetUpMenus   ( --- )  \ Create menus.
  230.    GetMenuMemory
  231.    InitITexts
  232.    PointStrings
  233.    InitMItems
  234.    CreateLinks
  235.    AddExtras
  236.    CreateMenus
  237.    CurrentWindow @ ProjectMenu @ SetMenuStrip ;
  238.  
  239. : MenuNum   ( code -- n )  \ Calculate menu number from message code.
  240.    31 AND ;
  241.  
  242. : ItemNum   ( code -- n )  \ Calculate item number from message code.
  243.    -5 SCALE 63 AND ;
  244.  
  245. : HandleMenus   ( code --- )  \ Do appropriate menu actions.
  246.    1200 LOCALS| pbaud code |
  247.    code MenuNum CASE
  248.      0 OF
  249.        code ItemNum CASE
  250.          0  OF  TalkAbout           ENDOF
  251.        { 1  OF  ...impossible...    ENDOF }
  252.          2  OF  FALSE TO Continue?  ENDOF
  253.        ENDCASE
  254.      ENDOF
  255.      1 OF
  256.        ReadMessage @ AbortIO
  257.        code ItemNum CASE
  258.          0  OF   300 TO pbaud  ENDOF
  259.          1  OF  1200 TO pbaud  ENDOF
  260.          2  OF  2400 TO pbaud  ENDOF
  261.        ENDCASE
  262.        pbaud SetSerialParams
  263.        ReadMessage @ BeginIO
  264.      ENDOF
  265.      2 OF
  266.        code ItemNum CASE
  267.          0 OF  ColumnWidth @ 39 = NOT IF
  268.                  40 ProjectMenu SwitchRes
  269.                THEN
  270.          ENDOF
  271.          1 OF  ColumnWidth @ 79 = NOT IF
  272.                  80 ProjectMenu SwitchRes
  273.                THEN
  274.          ENDOF
  275.        ENDCASE
  276.      ENDOF
  277.    ENDCASE ;
  278.