\ Gad.blk. 01Oct88pJa Forth version of the program GAD.C, fun with gadgets, by John Draper, from FredFish #1. This program showed the need to make a word that fills struc- tures. It uses the parser which loads in the include files, allowing hex number, constants, addresses to be loaded into a structure, starting from the first field, until the last one. (including the famous KludgeFillxx fields) Compare this with the 'C' listing. \ Load screen for Gad.blk 08Aug88pJacr .( loading include files ) 2 load cr .( loading code screens ) 3 15 thru cr .( type 'fun' to start ) \ Load the needed Include files. 01Oct88pJaonly forth also Intuition definitions tload i:intuition/border tload i:intuition/gadget tload i:intuition/image tload i:intuition/intuimessage tload i:intuition/intuitext tload i:intuition/screen tload i:intuition/window Graphics definitions tload i:graphics/rastport Exec definitions tload i:exec/ports tload i:exec/tasks only forth Exec also forth Intuition also forth Graphics also forth also definitions \ Define an image for the knob. 08Aug88pJacreate custimage hex 0000 w, 0000 w, 0180 w, 0660 w, 1818 w, 2004 w, 4002 w, 4002 w, 4002 w, 4002 w, 2004 w, 1818 w, 0660 w, 0180 w, 0000 w, 0000 w, decimal Image cus_image cus_image sizeoff Image erase 16 cus_image Width s! 16 cus_image Height s! 1 cus_image Depth s! 1 cus_image PlanePick s! custimage cus_image ImageData s! \ Intuition text structures. 08Aug88pJaIntuiText cus_text cus_text {fill 2 2 JAM1 0 2 -11 0 0 0 a" Custom Prop Gadget" cus_text IText s! IntuiText cus1_txt cus1_txt {fill 2 2 JAM1 0 161 23 0 0 cus_text a" Vert side" cus1_txt IText s! IntuiText cus2_txt cus2_txt {fill 2 2 JAM1 0 20 50 0 0 cus1_txt a" Hor side" cus2_txt IText s! IntuiText ntext ntext {fill 2 2 JAM1 0 10 -11 0 0 0 a" Number entry" ntext IText s! \ More intuitexts. 05Aug88pJaIntuiText bool_str bool_str {fill 2 2 JAM1 0 4 1 0 0 0 a" START" bool_str IText s! IntuiText bool2_str bool2_str {fill 2 2 JAM1 0 9 1 0 0 0 a" STOP" bool2_str IText s! IntuiText rtxt rtxt {fill 2 2 JAM1 0 -9 2 0 0 0 a" R" rtxt IText s! IntuiText gtxt gtxt {fill 2 2 JAM1 0 -9 2 0 0 0 a" G" gtxt IText s! IntuiText btxt btxt {fill 2 2 JAM1 0 -9 2 0 0 0 a" B" btxt IText s! \ Special info for proportionals. 08Aug88pJaImage r_img Image g_img Image b_img PropInfo r_prop PropInfo g_prop PropInfo b_prop PropInfo cust_prop cust_prop {fill FREEHORIZ!FREEVERT $8000 $8000 $800 $800 150 50 1 1 0 0 512 constant STRINGSIZE create DefString a" 0000000000000" STRINGSIZE here rot - - allot align create Undo STRINGSIZE allot align \ String info and Borders 08Aug88pJaStringInfo TexString TexString {fill DefString Undo 0 STRINGSIZE 0 0 14 0 0 0 0 0 0 create Pairs -1 w, -1 w, 160 w, -1 w, 160 w, 9 w, -1 w, 9 w, -1 w, -1 w, create Pairs1 0 w, 0 w, 51 w, 0 w, 51 w, 11 w, 0 w, 11 w, 0 w, 0 w, 5 constant NUM_PAIRS Border StrBorder StrBorder {fill -1 -1 1 0 JAM1 NUM_PAIRS Pairs 0 Border butt_border butt_border {fill -1 -1 1 0 JAM1 NUM_PAIRS Pairs1 0 \ Gadget definitions. 07Aug88pJa0 constant BLUE_GADGET Gadget blue_gad blue_gad {fill 0 17 112 150 11 GADGHCOMP GADGIMMEDIATE!RELVERIFY PROPGADGET b_img 0 btxt 0 b_prop BLUE_GADGET 0 1 constant GREEN_GADGET Gadget green_gad green_gad {fill blue_gad 17 97 120 11 GADGHCOMP GADGIMMEDIATE!RELVERIFY PROPGADGET g_img 0 gtxt 0 g_prop GREEN_GADGET 0 2 constant RED_GADGET Gadget red_gad red_gad {fill green_gad 17 82 90 11 GADGHCOMP GADGIMMEDIATE!RELVERIFY PROPGADGET r_img 0 rtxt 0 r_prop RED_GADGET 0 \ gadget definitions. 07Aug88pJa3 constant TEX_GAD Gadget tex_gad tex_gad {fill red_gad 30 30 150 11 GADGHCOMP STRINGCENTER!LONGINT!RELVERIFY STRGADGET StrBorder 0 ntext 0 TexString TEX_GAD 0 4 constant CUST_KNOB Gadget cust_knob cust_knob {fill tex_gad 17 140 150 50 GADGHCOMP!GADGIMAGE GADGIMMEDIATE!RELVERIFY PROPGADGET cus_image 0 cus2_txt 0 cust_prop CUST_KNOB 0 5 constant BOOL_GAD1 Gadget bool_gad bool_gad {fill cust_knob 30 46 50 10 GADGHCOMP GADGIMMEDIATE!RELVERIFY BOOLGADGET butt_border 0 bool_str 0 0 BOOL_GAD1 0 \ window definition. 08Aug88pJa6 constant BOOL_GAD2 Gadget bool2_gad bool2_gad {fill bool_gad 30 60 50 10 GADGHCOMP GADGIMMEDIATE!RELVERIFY BOOLGADGET butt_border 0 bool2_str 0 0 BOOL_GAD2 0 variable rp variable w IntuiMessage message NewWindow nw nw {fill 319 0 320 200 -1 -1 CLOSEWINDOW!GADGETUP!GADGETDOWN!REFRESHWINDOW WINDOWDEPTH!WINDOWSIZING!WINDOWDRAG!WINDOWCLOSE!SMART_REFRESH!ACTIVATE bool2_gad 0 0 0 0 50 50 320 200 WBENCHSCREEN a" Fun with Gadgets" nw Title s! \ Initialize proportional info. 08Aug88pJahex : initprop FREEHORIZ AUTOKNOB or { PropInfo dup r_prop Flags s! dup g_prop Flags s! b_prop Flags s! 1000 dup r_prop HorizBody s! dup g_prop HorizBody s! b_prop HorizBody s! 8000 dup r_prop HorizPot s! dup g_prop HorizPot s! b_prop HorizPot s! ; decimal : refresh ; \ 0 w @ red_gad RefreshGadgets ; : cleanup w @ CloseWindow true abort" Done " ; \ Open the window and get messages. 08Aug88pJa: getwindow nw OpenWindow dup w ! 0= abort" Can't open window!" w @ { Window RPort s@ rp ! refresh ; : getmessage (s -- n|0=none ) \ also sets message w @ { Window UserPort s@ GetMsg dup if dup message [ sizeoff IntuiMessage 8- ] literal cmove dup ReplyMsg then ; : idcmpwait (s -- ) w @ { Window UserPort s@ { MsgPort mp_SigBit s@ 1 swap << Wait ; \ Gadget actions. 08Aug88pJa: do-textgadget ." new value: " { StringInfo TexString LongInt s@ . cr ; : do-blue ." blue value: " { PropInfo b_prop HorizPot s@ . cr ; : do-red ." red value: " { PropInfo r_prop HorizPot s@ . cr ; : do-green ." green value: " { PropInfo g_prop HorizPot s@ . cr ; variable running : do-start running @ not if ." starting.." running on else ." uh?? " then cr ; : do-stop running @ if ." ..stopping" running off else ." what??" then cr ; \ Gadget Messages. 08Aug88pJa: buttondown { IntuiMessage message IAddress s@ { Gadget GadgetID s@ CUST_KNOB = if ." Playing with my knob?... " then ; : buttonup { IntuiMessage message IAddress s@ { Gadget GadgetID s@ dup CUST_KNOB = if ." ...thanks " cr drop else dup TEX_GAD = if do-textgadget drop else dup BLUE_GADGET = if do-blue drop else dup GREEN_GADGET = if do-green drop else dup RED_GADGET = if do-red drop else dup BOOL_GAD1 = if do-start drop else BOOL_GAD2 = if do-stop then then then then then then then ; \ Main loop 08Aug88pJa: process (s message -- ) { IntuiMessage Class s@ dup CLOSEWINDOW and if drop cleanup else dup REFRESHWINDOW and if drop refresh else dup GADGETDOWN and if drop buttondown else GADGETUP and if buttonup then then then then ; : fun initprop getwindow begin idcmpwait begin getmessage while message process repeat again ; \ Gad.blk 01Oct88pJa This example uses A4th' output window: it cannot be made a seperate task. Background tasks must provide their own output file/device. Another reason is that this program aborts, some- thing a background task cannot do. A background must have one entrance point and one exit point. You can get away with it. But at some time you will encounter weird problems, best not to invite them. \ Load screen for Gad.blk 08Aug88pJa I load all the include files at the beginning and forget the first word to reload. The include files will not be reloaded. \ Load the needed Include files. 08Aug88pJa After all the include files are loaded context is set to allow access to all the definitions. \ Define an image for the knob. 08Aug88pJacustimage The hex data describing the image. cus_image An Intuition Image structure for the custom knob. This way to initialize a structure works also inside a colon definition. It is a cumbersome but clear way of initializing a structure. \ Intuition text structures. 08Aug88pJaEach line of text used in gadgets, and menu's, are defined in an Intuition text structure. Each one is delcared in this and the next screen. Here the {fill command will initialize a structure. It fills thestructure from first to last field, using the correct fieldsize. Constants and addresses are easily included. String addresses can also be used if it is a normal forth word. The special word a" cannot be used. It needs to be explicitely initialized. cus_text Identifies the custom gadget. cus1_txt Identifies the vertical side. cus2_txt the horizontal. ntext A name for the string gadget. \ text structures. 08Aug88pJabool_str Name for start button. bool2_str Name for stop button. rtxt Name for red proportional gadget. gtxt Name for green proportional gadget. btxt Name for blue proportional gadget. \ Special info for proportionals. 08Aug88pJar_img g_img b_img Proportional gadgets need an image and r_prop g_prop b_prop proportional structures. These are autoknobs, values set in the program. cust_prop The custom proportional gadget needs it's values set. Note the use of $ for hex values. STRINGSIZE Size of stringbuffers for string gadget. DefString The default string, which I place in the buffer, before I allocate it. The I 'allot' the remainder. Undo The undo buffer for text string gadgets, can be shared by many. \ String info and Borders 08Aug88pJaTexString String info structure for string gadget. Pairs data for string gadget border Pairs1 data for boolean gadget borders. NUM_PAIRS number of pairs describing each border. StrBorder Border struct for string gadget. butt_border Border struct for boolean gadgets. \ Gadget definitions. 08Aug88pJaBLUE_GADGET In the example, gad.c, they used constants to identify each gadget, not realy required, because Forth can compare addresses just as well. blue_gad A proportional gadget, using autoknob in b_img. GREEN_GADGET Id. number for green gadget green_gad Proportional green gadget, linked to blue_gad. RED_GADGET Id. number for red gadget. red_gad Proportional gagdget for red. \ gadget definitions. 08Aug88pJaTEX_GAD id# for text gadget. tex_gad A string gadget used here to enter a number. CUST_KNOB id# for custom gadget. cust_knob A custom knob image is used for this proportional gadget, using both horizontal and vertical. BOOL_GAD1 id# for first boolean gadget. bool_gad Boolean gadget used as a 'start' button. \ window definition. 08Aug88pJaBOOL_GAD2 id# for boolean gadget. bool2_gad Button to stop what the previous button started. rp Holds the rastport for the window after it's opened. w The pointer to the window after it was opened. message To copy the Intuition message received. nw The newwindow. Note the way the flags are declared. The parser uses ! as 'or' but it needs the flags without any spaces. Wrapping is easy using blocks. \ Initialize proportional info. 08Aug88pJainitprop The proportional info structures must have certain fields set. That can be done in the declaration area or here Note that the current structure is set to PropInfo, before any fields are compiled. Compiling r_prop does not set the current structure to PropInfo. A possible shortcoming of the way structures are handled. refresh While playing around found out that refreshing is not needed. cleanup Close the window, and stop the program. \ Open the window and get messages. 08Aug88pJagetwindow Opens the window, sets the window pointer 'w' and the rastport address. getmessage (s -- n|0=none ) Returns a message from the window, copies the message and reply's it to Intuition. Returns non zero for a message, and zero for none. idcmpwait (s -- ) Suspends program until a message arives at the idcpm. \ Gadget actions. 08Aug88pJado-textgadget What should be done when textgadget tells us the user is finished entering a new value. do-blue When the user selects a new value for blue, this will tell him what it is. do-red And for the red potentiometer. do-green And the green pot. running do-start When start button is selected, it will set running on do-stop Stop the 'running'. \ Gadget Messages. 08Aug88pJabuttondown Each time a mouse button is pressed it can be intercepted here. If the gadgimmediate flag is set for the gadgets of interest. buttonup When a gadget is selected, the gadgetup message will bring us here. Can inspect the GadgetId field or compare the address of the gadget with the IAddress in the message. The rest is a big 'case' statement. \ Main loop. 08Aug88pJaprocess Process the message according to the possible messages received from IDCMP port. Closing the window takes precedence and refreshing is not realy required. When other messages are selected either in the NewWindow or through ModifyIDCMP, this will have to be changed. fun The main loop, can be simple and clear, unlike jumbled 'C' example.
