-> ReqBuilder.e v1.00 by Zebedee/A51 (24-Feb-97)
-> Allows the user to `build' reqtools requesters via a GUI

MODULE 'gadtools','exec/ports','graphics/text','intuition/intuition',
       'intuition/screens','libraries/gadtools','tools/constructors',
       'reqtools','libraries/reqtools'

ENUM ERR_NONE,ERR_FONT,ERR_GAD,ERR_KICK,ERR_PUB,ERR_VIS,ERR_WIN

RAISE ERR_FONT IF OpenFont()=NIL,
      ERR_GAD  IF CreateGadgetA()=NIL,
      ERR_KICK IF KickVersion()=FALSE,
      ERR_PUB  IF LockPubScreen()=NIL,
      ERR_VIS  IF GetVisualInfoA()=NIL,
      ERR_WIN  IF OpenWindowTagList()=NIL

ENUM GDBT_TITLE,GDBT_BODY,GDBT_GADGETS,GDBT_TEST,GDBT_PRINT,GDBT_ABOUT,
     GDSL_DEFAULT,GDCB_CENTRE

DEF topaz80,mywin=NIL:PTR TO window,wanted=TRUE,centre=TRUE,
    title[255]:STRING,body[255]:STRING,gadgets[255]:STRING,
    default=0:PTR TO LONG,ctr:PTR TO LONG,new[255]:STRING,temps[5]:STRING,
    real[255]:STRING,maxdef=1:PTR TO LONG

PROC countGadgets(my_gads:PTR TO LONG)
  maxdef:=0
  FOR ctr:=0 TO StrLen(gadgets)
    MidStr(temps,gadgets,ctr,1)
    IF StrCmp(temps,'|',1) THEN INC maxdef
  ENDFOR
  Gt_SetGadgetAttrsA(my_gads[GDSL_DEFAULT],mywin,NIL,[GTSL_MAX,maxdef,NIL])
ENDPROC

PROC handleGadgetEvent(win,gad:PTR TO gadget,code,slider_level:PTR TO LONG,my_gads:PTR TO LONG)
  DEF id
  id:=gad.gadgetid
  SELECT id
    CASE GDBT_TITLE;  RtGetStringA(title,255,'Enter requester title:',NIL,NIL)
    CASE GDBT_BODY;   RtGetStringA(body,255,'Enter body text:',NIL,NIL)
    CASE GDBT_GADGETS
      RtGetStringA(gadgets,255,'Enter gadget text:',NIL,NIL)
      countGadgets(my_gads)
    CASE GDBT_TEST
      sortVars()
      IF centre
        RtEZRequestA(new,gadgets,0,0,[RTEZ_REQTITLE,title,RTEZ_FLAGS,EZREQF_CENTERTEXT,RT_UNDERSCORE,"_",RTEZ_DEFAULTRESPONSE,default,NIL])
      ELSE
        RtEZRequestA(new,gadgets,0,0,[RTEZ_REQTITLE,title,RT_UNDERSCORE,"_",RTEZ_DEFAULTRESPONSE,default,NIL])
      ENDIF
    CASE GDBT_PRINT
      sortVars()
      WriteF('RtEZRequestA(\a\s\a,\a\s\a,NIL,NIL,[RTEZ_REQTITLE,\a\s\a,\sRT_UNDERSCORE,"_",RTEZ_DEFAULTRESPONSE,\d,NIL]\n',real,gadgets,title,IF centre THEN 'RTEZ_FLAGS,EZREQF_CENTERTEXT,' ELSE '',default)
->      WriteF('RtEZRequestA(\a\s\a,\a\s\a,NIL,NIL,[RTEZ_REQTITLE,\a\s\a,RT_UNDERSCORE,"_",RTEZ_DEFAULTRESPONSE,\d,NIL]\n',real,gadgets,title,default)
    CASE GDSL_DEFAULT
      slider_level[]:=code
      default:=code
    CASE GDCB_CENTRE;IF code THEN centre:=TRUE ELSE centre:=FALSE
    CASE GDBT_ABOUT;showAbout()
  ENDSELECT
ENDPROC

PROC showAbout()
  RtEZRequestA('Requester Builder v1.00 (24-Feb-97) By Ivan Oliver\n\n'+
               'TITLE  : The title of the requester\n'+
               'BODY   : The main chunk of text in the requester.\n'+
               '         Start a new line with a bar (|).\n'+
               'GADGETS: The buttons at the bottom of the requester.\n'+
               '         Separate buttons with a bar (|).\n'+
               'TEST   : Test the requester to see it working.\n'+
               'PRINT  : Show the actual command called with the\n'+
               '         required parameters on the screen.\n'+
               'DEFAULT: Gadget to highlight.  Gadget numbers start\n'+
               '         with 1 on the left increasing towards the\n'+
               '         right by 1 each time.  The rightmost gadget\n'+
               '         is always 0.  One gadget always returns 0.','_Ok',0,0,[RTEZ_REQTITLE,'About...',RT_UNDERSCORE,"_",NIL])
ENDPROC

PROC sortVars()
  StrCopy(new,'')
  StrCopy(real,'')
  FOR ctr:=0 TO StrLen(body)
    MidStr(temps,body,ctr,1)
    IF StrCmp(temps,'|',1)
      StrAdd(new,'\n');StrAdd(real,'\\n')
    ELSE
      StrAdd(new,temps);StrAdd(real,temps)
    ENDIF
  ENDFOR
ENDPROC

PROC handleVanillaKey(win,code,slider_level:PTR TO LONG,my_gads:PTR TO LONG)
  SELECT "w" OF code
    CASE "t","T";RtGetStringA(title,255,'Enter requester title:',NIL,NIL)
    CASE "b","B";RtGetStringA(body,255,'Enter body text:',NIL,NIL)
    CASE "g","G"
      RtGetStringA(gadgets,255,'Enter gadget text:',NIL,NIL)
      countGadgets(my_gads)
    CASE "s","S"
      sortVars()
      IF centre
        RtEZRequestA(new,gadgets,0,0,[RTEZ_REQTITLE,title,RTEZ_FLAGS,EZREQF_CENTERTEXT,RT_UNDERSCORE,"_",RTEZ_DEFAULTRESPONSE,default,NIL])
      ELSE
        RtEZRequestA(new,gadgets,0,0,[RTEZ_REQTITLE,title,RT_UNDERSCORE,"_",RTEZ_DEFAULTRESPONSE,default,NIL])
      ENDIF
    CASE "p","P"
      sortVars()
      WriteF('RtEZRequestA(\a\s\a,\a\s\a,NIL,NIL,[RTEZ_REQTITLE,\a\s\a,\sRT_UNDERSCORE,"_",RTEZ_DEFAULTRESPONSE,\d,NIL]\n',real,gadgets,title,IF centre THEN 'RTEZ_FLAGS,EZREQF_CENTERTEXT,' ELSE '',default)
    CASE "d"
      slider_level[]:=Min(slider_level[]+1,maxdef)
      default:=code
      Gt_SetGadgetAttrsA(my_gads[GDSL_DEFAULT],win,NIL,[GTSL_LEVEL,slider_level[],NIL])
    CASE "D"
      slider_level[]:=Max(slider_level[]-1,0)
      default:=code
      Gt_SetGadgetAttrsA(my_gads[GDSL_DEFAULT],win,NIL,[GTSL_LEVEL,slider_level[],NIL])
    CASE "c";Gt_SetGadgetAttrsA(my_gads[GDCB_CENTRE],win,NIL,[GTCB_CHECKED,FALSE,NIL]);centre:=FALSE
    CASE "C";Gt_SetGadgetAttrsA(my_gads[GDCB_CENTRE],win,NIL,[GTCB_CHECKED,TRUE,NIL]);centre:=TRUE
    CASE "a","A";showAbout()
  ENDSELECT
ENDPROC

PROC createAllGadgets(glistptr:PTR TO LONG,vi,topborder,slider_level,my_gads:PTR TO LONG)
  DEF gad,ng:PTR TO newgadget
  gad:=CreateContext(glistptr)
  ng:=[12,(4+topborder),66,12,'_Title',topaz80,GDBT_TITLE,NIL,vi,0]:newgadget
  my_gads[GDBT_TITLE]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL]))
  ng:=[78,(4+topborder),66,12,'_Body',topaz80,GDBT_BODY,NIL,vi,0]:newgadget
  my_gads[GDBT_BODY]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL]))
  ng:=[144,(4+topborder),66,12,'_Gadgets',topaz80,GDBT_GADGETS,NIL,vi,0]:newgadget
  my_gads[GDBT_GADGETS]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL]))
  ng:=[210,(4+topborder),66,12,'Te_st',topaz80,GDBT_TEST,NIL,vi,0]:newgadget
  my_gads[GDBT_TEST]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL]))
  ng:=[276,(4+topborder),66,12,'_Print',topaz80,GDBT_PRINT,NIL,vi,0]:newgadget
  my_gads[GDBT_PRINT]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL]))
  ng:=[342,(4+topborder),66,12,'_About',topaz80,GDBT_ABOUT,NIL,vi,0]:newgadget
  my_gads[GDBT_ABOUT]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL]))
  ng:=[107,(16+topborder),169,11,'_Default:   ',topaz80,GDSL_DEFAULT,NIL,vi,0]:newgadget
  my_gads[GDSL_DEFAULT]:=(gad:=CreateGadgetA(SLIDER_KIND,gad,ng,[GTSL_MIN,0,GTSL_MAX,maxdef,GTSL_LEVEL,slider_level,GTSL_LEVELFORMAT,'\z\d[2]',GTSL_MAXLEVELLEN,2,GT_UNDERSCORE,"_",NIL]))
  ng:=[382,(16+topborder),169,11,'_Centre Text:',topaz80,GDCB_CENTRE,NIL,vi,0]:newgadget
  my_gads[GDCB_CENTRE]:=(gad:=CreateGadgetA(CHECKBOX_KIND,gad,ng,[GTCB_CHECKED,centre,GT_UNDERSCORE,"_",NIL]))
ENDPROC gad

PROC processWindowEvents(mywin:PTR TO window,slider_level:PTR TO LONG,
                           my_gads:PTR TO LONG)
  DEF imsg:PTR TO intuimessage,imsgClass,imsgCode,gad
  WHILE wanted
    Wait(Shl(1,mywin.userport.sigbit))
    WHILE wanted AND (imsg:=Gt_GetIMsg(mywin.userport))
      gad:=imsg.iaddress
      imsgClass:=imsg.class
      imsgCode:=imsg.code
      Gt_ReplyIMsg(imsg)
      SELECT imsgClass
      CASE IDCMP_GADGETDOWN; handleGadgetEvent(mywin,gad,imsgCode,slider_level,my_gads)
      CASE IDCMP_MOUSEMOVE;  handleGadgetEvent(mywin,gad,imsgCode,slider_level,my_gads)
      CASE IDCMP_GADGETUP;   handleGadgetEvent(mywin,gad,imsgCode,slider_level,my_gads)
      CASE IDCMP_VANILLAKEY; handleVanillaKey(mywin,imsgCode,slider_level,my_gads)
      CASE IDCMP_CLOSEWINDOW;IF RtEZRequestA('Are you sure ?','_Yes|_NO!',0,0,[RTEZ_REQTITLE,'Quit...',RT_UNDERSCORE,"_",RTEZ_DEFAULTRESPONSE,0,NIL])=1 THEN wanted:=FALSE
      CASE IDCMP_REFRESHWINDOW
        Gt_BeginRefresh(mywin)
        Gt_EndRefresh(mywin,TRUE)
      ENDSELECT
    ENDWHILE
  ENDWHILE
ENDPROC

PROC gadtoolsWindow() HANDLE
  DEF font=NIL,mysc=NIL:PTR TO screen,glist=NIL,
      my_gads[8]:ARRAY OF LONG,vi,slider_level=0,topborder
  topaz80:=['topaz.font',8,0,0]:textattr
  font:=OpenFont(topaz80)
  mysc:=LockPubScreen(NIL)
  vi:=GetVisualInfoA(mysc,[NIL])
  topborder:=mysc.wbortop+mysc.font.ysize+1
  createAllGadgets({glist},vi,topborder,slider_level,my_gads)
  mywin:=OpenWindowTagList(NIL,
                     [WA_TITLE,'Requester Builder v1.00',
                      WA_SCREENTITLE,'CARNAGE - Always where you never expect us to be!',
                      WA_GADGETS,   glist, WA_RMBTRAP,       TRUE,
                      WA_WIDTH,       420, WA_MINWIDTH,        50,
                      WA_HEIGHT,       44, WA_MINHEIGHT,       50,
                      WA_DRAGBAR,    TRUE, WA_DEPTHGADGET,   TRUE,
                      WA_ACTIVATE,   TRUE, WA_CLOSEGADGET,   TRUE,
                      WA_SIZEGADGET,FALSE, WA_SMARTREFRESH,  TRUE,
                      WA_IDCMP,IDCMP_CLOSEWINDOW OR IDCMP_REFRESHWINDOW OR
                                IDCMP_VANILLAKEY OR SLIDERIDCMP OR
                                STRINGIDCMP OR BUTTONIDCMP,
                      WA_PUBSCREEN,mysc,NIL])
  Gt_RefreshWindow(mywin,NIL)
  DrawBevelBoxA(mywin.rport,8,topborder+2,404,27,[GT_VISUALINFO,vi,NIL])
  DrawBevelBoxA(mywin.rport,6,topborder+1,408,29,[GT_VISUALINFO,vi,GTBB_RECESSED,TRUE,NIL])
  StrCopy(title,'Title...')
  StrCopy(body,'Hello world!|(What a boring example)')
  StrCopy(gadgets,'_I know...|_Not really!')
  default:=0
  processWindowEvents(mywin,{slider_level},my_gads)
EXCEPT DO
  IF mywin THEN CloseWindow(mywin)
  FreeGadgets(glist)
  IF vi THEN FreeVisualInfo(vi)
  IF mysc THEN UnlockPubScreen(mysc,NIL)
  IF font THEN CloseFont(font)
  ReThrow()
ENDPROC

PROC main() HANDLE
  KickVersion(37)
  IF gadtoolsbase:=OpenLibrary('gadtools.library',37)
    IF reqtoolsbase:=OpenLibrary('reqtools.library',37)
      gadtoolsWindow()
    ELSE
      WriteF('ERROR: Unable to open reqtools.library v37\n')
    ENDIF
  ELSE
    WriteF('ERROR: Unable to open gadtools.library v37\n')
  ENDIF
EXCEPT DO
  IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  SELECT exception
  CASE ERR_FONT; WriteF('ERROR: Unable to open topaz.font 8\n')
  CASE ERR_GAD;  WriteF('ERROR: Unable to create gadgets\n')
  CASE ERR_KICK; WriteF('ERROR: Requires Kickstart v37\n')
  CASE ERR_PUB;  WriteF('ERROR: Unable to lock default public screen\n')
  CASE ERR_VIS;  WriteF('ERROR: Unable to GetVisualInfo()\n')
  CASE ERR_WIN;  WriteF('ERROR: Unable to open the window\n')
  ENDSELECT
ENDPROC