home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / COMAL3-1.DMS / in.adf / Demos / GadToolsDemo < prev    next >
Encoding:
Text File  |  1993-03-30  |  14.4 KB  |  514 lines
  1. // GadTools demo program
  2. //
  3. // NOTE: This program requires WorkBench 2.0 to run!
  4.  
  5. USE System
  6. USE IntuitionWindow
  7. USE IntuitionScreen
  8. USE PortObjects
  9. USE IDCMP
  10. USE ExecLists
  11. USE TagItem
  12. USE IntuiText
  13. USE SystemCode
  14. USE GadToolsInclude
  15. USE GadToolsLibrary
  16. USE IntuitionLibrary
  17. USE GraphicsLibrary
  18. USE ExecLibrary
  19.  
  20. // Gadget ID's
  21. DIM BUTTON_ID OF UBYTE
  22. DIM CYCLE_ID OF UBYTE
  23. DIM STRING_ID OF UBYTE
  24. DIM LIST_ID OF UBYTE
  25. DIM MX_ID OF UBYTE
  26. DIM SLIDER_ID OF UBYTE
  27. DIM CHECK_ID OF UBYTE
  28. DIM INTEGER_ID OF UBYTE
  29. DIM INCREMENT_ID OF UBYTE
  30. DIM PALETTE_ID OF UBYTE
  31.  
  32. BUTTON_ID:=0
  33. CYCLE_ID:=1
  34. STRING_ID:=2
  35. LIST_ID:=3
  36. MX_ID:=4
  37. SLIDER_ID:=5
  38. CHECK_ID:=6
  39. INTEGER_ID:=7
  40. INCREMENT_ID:=8
  41. PALETTE_ID:=9
  42.  
  43. // Other definitions
  44. DIM SLIDER_MIN OF UBYTE
  45. DIM SLIDER_MAX OF UBYTE
  46.  
  47. SLIDER_MIN:=1
  48. SLIDER_MAX:=31
  49.  
  50. // Variables
  51. DIM window OF POINTER TO Window
  52. DIM glist OF POINTER TO Gadget  // Gadget list pointer
  53. DIM list OF List
  54. DIM vi OF ULONG                 // VisualInfo pointer
  55.  
  56. DIM intgad OF POINTER TO Gadget // Pointer to our integer gadget
  57. DIM value OF ULONG              // .. and the current value
  58. value:=42
  59.  
  60. // We need a Tag array
  61. DIM taglist(0..7) OF TagItem
  62.  
  63. // It's possible to use the default font with GadTools,
  64. // but extra computations must be made to get the size
  65. // and positions of the Gadgets right.
  66. // We'll want to use Topaz-80 for simplicity.
  67.  
  68. DIM topaz80 OF TextAttr
  69. topaz80.ta_Name:=ADR("topaz.font")
  70. topaz80.ta_YSize:=8
  71.  
  72. // Some data for our gadgets
  73. DIM day_labels(0..7) OF ULONG
  74. DIM DayName$(0..6) OF 9
  75. DayName$(0):="Sunday"
  76. DayName$(1):="Monday"
  77. DayName$(2):="Tuesday"
  78. DayName$(3):="Wednesday"
  79. DayName$(4):="Thursday"
  80. DayName$(5):="Friday"
  81. DayName$(6):="Saturday"
  82. FOR i:=0 TO 6 DO
  83.   day_labels(i):=ADR(DayName$(i))
  84. ENDFOR i
  85.  
  86. DIM month_labels(0..12) OF ULONG
  87. DIM MonthName$(0..11) OF 9
  88. MonthName$(0):="January"
  89. MonthName$(1):="February"
  90. MonthName$(2):="March"
  91. MonthName$(3):="April"
  92. MonthName$(4):="May"
  93. MonthName$(5):="June"
  94. MonthName$(6):="July"
  95. MonthName$(7):="August"
  96. MonthName$(8):="September"
  97. MonthName$(9):="October"
  98. MonthName$(10):="November"
  99. MonthName$(11):="December"
  100. FOR i:=0 TO 11 DO
  101.   month_labels(i):=ADR(MonthName$(i))
  102. ENDFOR i
  103.  
  104. DIM textbuffer(20) OF UBYTE   // For displaying Gadget event information
  105.  
  106. // Now we are ready to start
  107. WriteInfo
  108. setup
  109. create_gadgets
  110. handle_input
  111.  
  112. // ******* end of main program  **********
  113.  
  114. PROC WriteInfo
  115.   PRINT
  116.   PRINT
  117.   PRINT
  118.   PRINT
  119.   PRINT "     GadTools Demo"
  120.   PRINT "     -------------"
  121.   PRINT "     This program demonstrates the new 'gadtools.library' of OS2."
  122.   PRINT
  123.   PRINT "     The program was originally written by Paul Miller for"
  124.   PRINT "     The AmigaWorld Tech Journal (volume 1 #3) and translated"
  125.   PRINT "     into Comal by Svend Daugaard Pedersen."
  126.   PRINT
  127.   PRINT "     This program is very close to the original C version."
  128.   PRINT "     See CITDemo for another more elegant implementation."
  129.   PRINT
  130.   PRINT AT 19,1: "  Press any key to start demo"
  131.   WHILE KEY$="" DO WAIT
  132. ENDPROC WriteInfo
  133.  
  134. PROC abort(Text$)
  135.   closedown
  136.   END Text$
  137. ENDPROC abort
  138.  
  139. PROC setup
  140.   LOCAL NewWindow OF NewWindow
  141.   NewWindow.LeftEdge:=50
  142.   NewWindow.TopEdge:=20
  143.   NewWindow.Width:=510
  144.   NewWindow.Height:=150
  145.   NewWindow.DetailPen:=$FF
  146.   NewWindow.BlockPen:=$FF
  147.   NewWindow.Title:=ADR("GadTools Demo")
  148.   NewWindow.Screen:=ComalStruc@.IO_Screen
  149.   NewWindow.IDCMPFlags:=LISTVIEWIDCMP BITOR SLIDERIDCMP BITOR CHECKBOXIDCMP BITOR MXIDCMP BITOR CLOSEWINDOW BITOR REFRESHWINDOW
  150.   NewWindow.Flags:=ACTIVATE BITOR WINDOWDRAG BITOR WINDOWDEPTH BITOR WINDOWCLOSE BITOR SIMPLE_REFRESH
  151.   NewWindow.Type:=CUSTOMSCREEN
  152.   
  153.   window:=OpenWindow(ADR(NewWindow))
  154.   taglist(0).ti_Tag:=TAG_DONE
  155.   vi:=GetVisualInfoA(window@.WScreen,ADR(taglist()))
  156.   IF vi=0 THEN
  157.     abort("Couldn't get default public screen's VisualInfo.")
  158.   ENDIF
  159. ENDPROC setup
  160.  
  161. PROC closedown
  162.   LOCAL node OF POINTER TO Node
  163.  
  164.   node:=RemTail(ADR(list))
  165.   WHILE node DO
  166.     DEALLOCATE(node)
  167.     node:=RemTail(ADR(list))
  168.   ENDWHILE
  169.   CloseWindow(window)
  170.   IF glist THEN FreeGadgets(glist)
  171.   IF vi THEN FreeVisualInfo(vi)
  172. ENDPROC closedown
  173.  
  174. PROC create_gadgets
  175.   LOCAL top OF USHORT             // offset into Window under titlebar
  176.   LOCAL ng OF NewGadget           // for Gadget positioning
  177.   LOCAL gad OF POINTER TO Gadget  // our running Gadget pointer
  178.   LOCAL node OF POINTER TO Node   // for our LISTVIEW list allocation
  179.   LOCAL index OF LONG             // ditto
  180.  
  181.   // let's determine the top Window border height
  182.   // (taking into account  whatever system font has
  183.   // been used to render the titlebar) so we can
  184.   // place the Gadgets properly within the Window.
  185.   // Overwriting of the titlebar is possible if
  186.   // you're not careful.
  187.   top:=window@.BorderTop+1
  188.  
  189.   // this initial call is required when using the
  190.   // GadTool toolkit. It gives the toolkit a place
  191.   // to keep track of Gadget context information,
  192.   // and also forms a starting point to begin the
  193.   // Gadget creation with.
  194.   // Each Gadget creation call requires a pointer
  195.   // to the previous Gadget as one of its arguments,
  196.   // and this pointer is used for the first one.
  197.   // The Gadgets are automatically linked with this
  198.   // facility. Also, there is no need to check the
  199.   // returned Gadget pointer until it is actually
  200.   // used, such as if the Gadget data need be refe-
  201.   // renced, and of course before the Gadget list is
  202.   // added to a Window.
  203.  
  204.   // We pass the ADDRESS of our Gadget list pointer,
  205.   // so the toolkit can allocate some memory there:
  206.   gad:=CreateContext(ADR(glist))
  207.  
  208.   // Now we can fill out the NewGadget structure to
  209.   // describe where we want the Gadget to be placed.
  210.  
  211.   // Create a centered read-only Gadget:
  212.   ng.ng_LeftEdge:=window@.Width/2
  213.   ng.ng_TopEdge:=top+4
  214.   ng.ng_Width:=0                       // this is computed automatically
  215.   ng.ng_Height:=8
  216.   ng.ng_GadgetText:=ADR("GadTools Toolkit Demo")
  217.   ng.ng_TextAttr:=ADR(topaz80)         // this is required!!
  218.   ng.ng_GadgetID:=0
  219.   ng.ng_Flags:=PLACETEXT_IN BITOR NG_HIGHLABEL
  220.   ng.ng_VisualInfo:=vi                 // this is required!!
  221.  
  222.   // note the specified flags - see GadToolsInclude
  223.   // for additional flags and their descriptions.
  224.    
  225.   gad:=CreateGadgetA(TEXT_KIND,gad,ADR(ng),ADR(taglist()))
  226.  
  227.   // The NewGadget stucture is not modified by any Gadget
  228.   // creation call, so you'll only need to change informa-
  229.   // tion that actually needs to be changed
  230.  
  231.   ng.ng_LeftEdge:=10
  232.   ng.ng_TopEdge:=5+top
  233.   ng.ng_Width:=100
  234.   ng.ng_Height:=12
  235.   ng.ng_GadgetText:=ADR("QUIT DEMO")
  236.   ng.ng_GadgetID:=BUTTON_ID
  237.   ng.ng_Flags:=0
  238.   gad:=CreateGadgetA(BUTTON_KIND,gad,ADR(ng),ADR(taglist()))
  239.  
  240.   // Prepare a List for the LISTVIEW Gadget below
  241.   index:=0
  242.   WHILE month_labels(index) DO
  243.     ALLOCATE(node)
  244.     IF node=0 THEN
  245.       abort("Couldn't allocate LISTVIEW List.")
  246.     ENDIF
  247.     node@.ln_Name:=month_labels(index)
  248.     index:+1
  249.     AddTail(ADR(list),node)
  250.   ENDWHILE
  251.  
  252.   // We'll create a string Gadget to be attached to the LISTVIEW below
  253.   ng.ng_Width:=150
  254.   ng.ng_Height:=14
  255.   ng.ng_GadgetText:=0
  256.   ng.ng_GadgetID:=STRING_ID
  257.   taglist(0).ti_Tag:=GTST_MaxChars
  258.   taglist(0).ti_Data:=50
  259.   taglist(1).ti_Tag:=TAG_DONE
  260.   gad:=CreateGadgetA(STRING_KIND,gad,ADR(ng),ADR(taglist()))
  261.  
  262.   // A LISTVIEW gadget - note that it works using an EXEC List
  263.   ng.ng_LeftEdge:=10
  264.   ng.ng_TopEdge:=40+top
  265.   ng.ng_Width:=150
  266.   ng.ng_Height:=57
  267.   ng.ng_GadgetText:=ADR("Months:")
  268.   ng.ng_GadgetID:=LIST_ID
  269.   ng.ng_Flags:=NG_HIGHLABEL BITOR PLACETEXT_ABOVE
  270.   taglist(0).ti_Tag:=GTLV_Labels
  271.   taglist(0).ti_Data:=ADR(list)
  272.   taglist(1).ti_Tag:=GTLV_Top
  273.   taglist(1).ti_Data:=1
  274.   taglist(2).ti_Tag:=GTLV_ShowSelected    // String Gadget
  275.   taglist(2).ti_Data:=gad
  276.   taglist(3).ti_Tag:=GTLV_Selected
  277.   taglist(3).ti_Data:=3
  278.   taglist(4).ti_Tag:=GTLV_ScrollWidth
  279.   taglist(4).ti_Data:=18
  280.   taglist(5).ti_Tag:=TAG_DONE
  281.   gad:=CreateGadgetA(LISTVIEW_KIND,gad,ADR(ng),ADR(taglist()))
  282.  
  283.   // A cycle gadget:
  284.   ng.ng_LeftEdge:=50
  285.   ng.ng_TopEdge:=110+top
  286.   ng.ng_Width:=100
  287.   ng.ng_Height:=12
  288.   ng.ng_GadgetText:=ADR("Day:")
  289.   ng.ng_GadgetID:=CYCLE_ID
  290.   ng.ng_Flags:=NG_HIGHLABEL BITOR PLACETEXT_LEFT
  291.   taglist(0).ti_Tag:=GTCY_Labels
  292.   taglist(0).ti_Data:=ADR(day_labels())
  293.   taglist(1).ti_Tag:=GTCY_Active
  294.   taglist(1).ti_Data:=1
  295.   taglist(2).ti_Tag:=TAG_DONE
  296.   gad:=CreateGadgetA(CYCLE_KIND,gad,ADR(ng),ADR(taglist()))
  297.  
  298.   // A set of mutually-exclusive Gadgets which performs the
  299.   // same function as the CYCLE Gadget above -- if you have
  300.   // 5 or less items to select from, the smaller CYCLE Gadget
  301.   // would be a better choice -- the user doesn't want to have
  302.   // to click through too many choices -- if you have room go
  303.   // with a MX Gadget -- it's more visual as to the choices
  304.   ng.ng_LeftEdge:=260
  305.   ng.ng_TopEdge:=25+top
  306.   ng.ng_GadgetID:=MX_ID
  307.   ng.ng_Flags:=PLACETEXT_LEFT
  308.   taglist(0).ti_Tag:=GTMX_Labels
  309.   taglist(0).ti_Data:=ADR(day_labels())
  310.   taglist(1).ti_Tag:=GTMX_Active
  311.   taglist(1).ti_Data:=5
  312.   taglist(2).ti_Tag:=GTMX_Spacing
  313.   taglist(2).ti_Data:=3
  314.   taglist(3).ti_Tag:=TAG_DONE
  315.   gad:=CreateGadgetA(MX_KIND,gad,ADR(ng),ADR(taglist()))
  316.  
  317.   // Here we'll create a SLIDER with an automatic value display:
  318.   ng.ng_LeftEdge:=300
  319.   ng.ng_TopEdge:=120+top
  320.   ng.ng_Width:=180
  321.   ng.ng_Height:=12
  322.   ng.ng_GadgetText:=ADR("DAY:  ")
  323.   ng.ng_GadgetID:=SLIDER_ID
  324.   ng.ng_Flags:=PLACETEXT_LEFT
  325.   taglist(0).ti_Tag:=GTSL_Min
  326.   taglist(0).ti_Data:=SLIDER_MIN
  327.   taglist(1).ti_Tag:=GTSL_Max
  328.   taglist(1).ti_Data:=SLIDER_MAX
  329.   taglist(2).ti_Tag:=GTSL_Level
  330.   taglist(2).ti_Data:=1
  331.   taglist(3).ti_Tag:=GTSL_LevelFormat
  332.   taglist(3).ti_Data:=ADR("%2ld")
  333.   taglist(4).ti_Tag:=GTSL_MaxLevelLen
  334.   taglist(4).ti_Data:=2
  335.   taglist(5).ti_Tag:=TAG_USER+$30000+$16  // GA_RELVERIFY
  336.   taglist(5).ti_Data:=TRUE
  337.   taglist(6).ti_Tag:=TAG_DONE
  338.   gad:=CreateGadgetA(SLIDER_KIND,gad,ADR(ng),ADR(taglist()))
  339.  
  340.   // A CHECKBOX
  341.   ng.ng_LeftEdge:=window@.Width-40
  342.   ng.ng_TopEdge:=10+top
  343.   ng.ng_GadgetID:=CHECK_ID
  344.   ng.ng_GadgetText:=ADR("Check Me")
  345.   ng.ng_Flags:=PLACETEXT_LEFT
  346.   taglist(0).ti_Tag:=TAG_DONE
  347.   gad:=CreateGadgetA(CHECKBOX_KIND,gad,ADR(ng),ADR(taglist()))
  348.  
  349.   // An integer Gadget for cosmic significance
  350.   ng.ng_TopEdge:=30+top
  351.   ng.ng_LeftEdge:=window@.Width-50
  352.   ng.ng_Width:=40
  353.   ng.ng_Height:=14
  354.   ng.ng_GadgetText:=ADR("Cosmic Significance:")
  355.   ng.ng_Flags:=PLACETEXT_LEFT BITOR NG_HIGHLABEL
  356.   ng.ng_GadgetID:=INTEGER_ID
  357.   taglist(0).ti_Tag:=GTIN_Number
  358.   taglist(0).ti_Data:=value
  359.   taglist(1).ti_Tag:=GTIN_MaxChars
  360.   taglist(1).ti_Data:=4
  361.   taglist(2).ti_Tag:=TAG_DONE
  362.   gad:=CreateGadgetA(INTEGER_KIND,gad,ADR(ng),ADR(taglist()))
  363.   intgad:=gad
  364.  
  365.   // And make a button to play with the integer Gadget with
  366.   ng.ng_LeftEdge:=window@.Width-110
  367.   ng.ng_TopEdge:=50+top
  368.   ng.ng_Width:=100
  369.   ng.ng_Height:=12
  370.   ng.ng_GadgetText:=ADR("INCREMENT")
  371.   ng.ng_GadgetID:=INCREMENT_ID
  372.   ng.ng_Flags:=0
  373.   taglist(0).ti_Tag:=TAG_DONE
  374.   gad:=CreateGadgetA(BUTTON_KIND,gad,ADR(ng),ADR(taglist()))
  375.  
  376.   // Neat-o! make a ready-to-go palette selector Gadget
  377.   ng.ng_LeftEdge:=window@.Width-160
  378.   ng.ng_TopEdge:=80+top
  379.   ng.ng_Width:=150
  380.   ng.ng_Height:=30
  381.   ng.ng_GadgetText:=ADR("Our Colors")
  382.   ng.ng_GadgetID:=PALETTE_ID
  383.   ng.ng_Flags:=PLACETEXT_ABOVE BITOR NG_HIGHLABEL
  384.   taglist(0).ti_Tag:=GTPA_Depth
  385.   taglist(0).ti_Data:=window@.WScreen@.BitMap.Depth
  386.   taglist(1).ti_Tag:=GTPA_Color
  387.   taglist(1).ti_Data:=1
  388.   taglist(2).ti_Tag:=GTPA_IndicatorWidth
  389.   taglist(2).ti_Data:=20
  390.   taglist(3).ti_Tag:=TAG_DONE
  391.   gad:=CreateGadgetA(PALETTE_KIND,gad,ADR(ng),ADR(taglist()))
  392.  
  393.   // Now we're ready to add the Gadget list.
  394.   // Quit if the final Gadget pointer is NULL - this
  395.   // means that one of the Gadget allocations failed.
  396.   // If it exists, add it to the window and refresh,
  397.   // then add the new GT_RefreshWindow() call.
  398.  
  399.   IF gad=0 THEN
  400.     abort("Couldn't allocate the Gadget list.")
  401.   ENDIF
  402.  
  403.   AddGList(window,glist,$FFFF,$FFFF,0)
  404.   RefreshGList(glist,window,0,$FFFF)
  405.   GT_RefreshWindow(window,0)
  406. ENDPROC create_gadgets
  407.  
  408. PROC handle_input
  409.   LOCAL message OF POINTER TO IntuiMessage
  410.   LOCAL gadget OF POINTER TO Gadget
  411.   LOCAL class OF ULONG
  412.   LOCAL code OF USHORT
  413.  
  414.   LOOP
  415.     window@.UserPort@.Wait
  416.  
  417.     // Use the new GadTools GT_GetIMsg() function
  418.     // to get input events:
  419.     message:=GT_GetIMsg(window@.UserPort)
  420.     WHILE message DO
  421.       class:=message@.Class
  422.       code:=message@.Code
  423.  
  424.       // We'll assume it's a Gadget, but no harm is
  425.       // done if it isn't
  426.       gadget:=message@.IAddress
  427.  
  428.       // Use the GT_ReplyIMsg() function to reply to the message
  429.       GT_ReplyIMsg(message)
  430.  
  431.       CASE class OF
  432.       WHEN CLOSEWINDOW
  433.         abort("Done.")
  434.       WHEN GADGETUP
  435.         handle_gadgetup(gadget@,code)
  436.       WHEN GADGETDOWN
  437.         handle_gadgetdown(gadget@,code)
  438.       WHEN REFRESHWINDOW
  439.         // When using a window of type SIMPLE_REFRESH,
  440.         // use this input event and GadTools-compatible
  441.         // refreshing code.
  442.         GT_BeginRefresh(window)
  443.         GT_EndRefresh(window,TRUE)
  444.       OTHERWISE
  445.         // No action
  446.       ENDCASE
  447.       message:=GT_GetIMsg(window@.UserPort)
  448.     ENDWHILE
  449.   ENDLOOP
  450. ENDPROC handle_input
  451.  
  452. PROC handle_gadgetup(REF gadget OF Gadget,code OF USHORT)
  453.   LOCAL BytePtr OF POINTER TO UBYTE
  454.   LOCAL StringInfo OF POINTER TO StringInfo
  455.  
  456.   CASE gadget.GadgetID OF
  457.   WHEN BUTTON_ID
  458.     abort("QUIT.")
  459.   WHEN CYCLE_ID
  460.     PRINT "CYCLE GADGET: item=",DayName$(code)
  461.   WHEN STRING_ID
  462.     PRINT "LISTVIEW STRING GADGET: string=",
  463.     StringInfo:=gadget.SpecialInfo
  464.     BytePtr:=StringInfo@.Buffer
  465.     WHILE BytePtr@<>0 DO
  466.       PRINT CHR$(BytePtr@),
  467.       BytePtr:=BytePtr+1
  468.     ENDWHILE
  469.     PRINT
  470.   WHEN LIST_ID
  471.     PRINT "LISTVIEW GADGET: item=",MonthName$(code)
  472.   WHEN SLIDER_ID
  473.     PRINT "SLIDER GADGET: ",code
  474.   WHEN CHECK_ID
  475.     PRINT "CHECKBOX GADGET: state=",
  476.     IF (gadget.Flags BITAND $0080) THEN
  477.       PRINT "ON"
  478.     ELSE
  479.       PRINT "OFF"
  480.     ENDIF
  481.   WHEN INTEGER_ID
  482.     PRINT "INTEGER GADGET: value=",
  483.     StringInfo:=gadget.SpecialInfo
  484.     PRINT StringInfo@.LongInt
  485.   WHEN INCREMENT_ID
  486.       // here we use a Tag-based Gadget attributes
  487.       // modifying function -- just pass the appropriate
  488.       // Tags you want modified
  489.     value:+1
  490.     taglist(0).ti_Tag:=GTIN_Number
  491.     taglist(0).ti_Data:=value
  492.     taglist(1).ti_Tag:=TAG_DONE
  493.     GT_SetGadgetAttrsA(intgad,window,0,ADR(taglist()))
  494.     PRINT "INCREMENT INTEGER: value=",
  495.     StringInfo:=intgad@.SpecialInfo
  496.     PRINT StringInfo@.LongInt
  497.   WHEN PALETTE_ID
  498.     PRINT "PALETTE GADGET: color=",code
  499.   OTHERWISE
  500.       // No action
  501.   ENDCASE
  502. ENDPROC handle_gadgetup
  503.  
  504. PROC handle_gadgetdown(REF gadget OF Gadget,code OF USHORT)
  505.   CASE gadget.GadgetID OF
  506.   WHEN MX_ID
  507.     // Seems this requires a GADGETDOWN event
  508.     PRINT "MX (MUTUAL EXCLUDE) GADGET: item=",DayName$(code)
  509.   OTHERWISE
  510.       // No action
  511.   ENDCASE
  512. ENDPROC handle_gadgetdown
  513.  
  514.