/********************************************************\ ** The Retreat Fan Club Mailing List ** ! PLEASE ! ** ** By Zebedee/Area 51 (06-JUL-97) ** DO NOT ** ** Written using Amiga E v3.1i registered ** DISTRIBUTE ** \********************************************************/ OPT PREPROCESS ->#define debug MODULE 'gadtools','exec/ports','graphics/text','intuition/intuition', 'intuition/screens','libraries/gadtools','graphics/rastport', 'reqtools','libraries/reqtools','asl','libraries/asl','workbench/startup' ENUM ERR_NONE,ERR_FONT,ERR_GAD,ERR_KICK,ERR_LIB,ERR_PUB,ERR_VIS,ERR_WIN, ERR_ASL,ERR_SCR RAISE ERR_FONT IF OpenFont()=NIL, ERR_GAD IF CreateGadgetA()=NIL, ERR_KICK IF KickVersion()=FALSE, ERR_ASL IF AllocAslRequest()=NIL, ERR_PUB IF LockPubScreen()=NIL, ERR_VIS IF GetVisualInfoA()=NIL, ERR_WIN IF OpenWindowTagList()=NIL, ERR_SCR IF OpenScreenTagList()=NIL ENUM GDST_SURNAME,GDST_FORENAME,GDST_ADDRL1,GDST_ADDRL2,GDST_ADDRL3, GDST_ADDRL4,GDST_ADDRL5,GDST_POSTCODE,GDMX_SEX,GDST_DOB,GDST_PHONE, GDST_FAX,GDST_EMAIL,GDST_NUMBER,GDST_AGENT,GDST_JOINED,GDST_EXPIRES, GDBT_OPEN,GDBT_SAVE,GDBT_FIRST,GDBT_PREVIOUS,GDBT_NEXT,GDBT_LAST, GDBT_DELETE,GDBT_UNDELETE,GDBT_SEARCH,GDBT_ABOUT,GDBT_QUIT,GDSL_LOCATE, GDCY_TITLE CONST MAX=100 DEF topaz80,mywin=NIL:PTR TO window,wanted=TRUE,ffull[255]:STRING, recnum=0:PTR TO LONG,sex[MAX]:ARRAY OF LONG,maxrec=0:PTR TO LONG, surnameptr[MAX]:ARRAY OF LONG,forenameptr[MAX]:ARRAY OF LONG,addrl1ptr[MAX]:ARRAY OF LONG, addrl2ptr[MAX]:ARRAY OF LONG,addrl3ptr[MAX]:ARRAY OF LONG,addrl4ptr[MAX]:ARRAY OF LONG, addrl5ptr[MAX]:ARRAY OF LONG,postcodeptr[MAX]:ARRAY OF LONG,fpath[255]:STRING, temps[255]:STRING,title:PTR TO LONG,fname[255]:STRING,myscr=NIL:PTR TO screen, surnamestr:PTR TO LONG,forenamestr:PTR TO LONG,addrl1str,addrl2str,addrl3str,addrl4str,addrl5str, postcodestr PROC handleGadgetEvent(win,gad:PTR TO gadget,code,slider_level:PTR TO LONG,my_gads:PTR TO LONG) DEF id id:=gad.gadgetid StrCopy(temps,gad.specialinfo::stringinfo.buffer) SELECT id CASE GDBT_ABOUT;showAbout() CASE GDBT_QUIT;checkQuit() CASE GDCY_TITLE SELECT code CASE 0;sex[recnum]:='Mr' CASE 1;sex[recnum]:='Mrs' CASE 2;sex[recnum]:='Ms' ENDSELECT CASE GDST_SURNAME;StrCopy(surnameptr[recnum],temps) CASE GDST_FORENAME;StrCopy(forenameptr[recnum],temps) #ifdef debug CASE GDST_ADDRL1;requestText() CASE GDST_ADDRL2;requestText() CASE GDST_ADDRL3;requestText() CASE GDST_ADDRL4;requestText() CASE GDST_ADDRL5;requestText() CASE GDST_POSTCODE;requestText() CASE GDST_DOB;requestText() CASE GDST_PHONE;requestText() CASE GDST_FAX;requestText() CASE GDST_EMAIL;requestText() CASE GDST_NUMBER;requestText() CASE GDST_AGENT;requestText() CASE GDST_JOINED;requestText() CASE GDST_EXPIRES;requestText() #endif CASE GDBT_OPEN getFilename('Select file to open...') IF fname MidStr(temps,fpath,StrLen(fpath)-1,1) StrCopy(ffull,'') StrAdd(ffull,fpath) IF Not(StrCmp(':',temps,1)) THEN StrAdd(ffull,'/') StrAdd(ffull,fname) IF FileLength(ffull)=-1 RtEZRequestA('File not found','_Ok',0,0,[RTEZ_REQTITLE,'Error!',RTEZ_FLAGS,EZREQF_CENTERTEXT,RT_SCREEN,myscr,RT_REQPOS,REQPOS_CENTERSCR,RT_UNDERSCORE,"_",NIL]) StrCopy(ffull,'') ENDIF ENDIF CASE GDBT_SAVE getFilename('Select file to save as...') IF fname MidStr(temps,fpath,StrLen(fpath)-1,1) StrCopy(ffull,'') StrAdd(ffull,fpath) IF Not(StrCmp(':',temps,1)) THEN StrAdd(ffull,'/') StrAdd(ffull,fname) IF FileLength(ffull)=-1 RtEZRequestA('File not found','_Ok',0,0,[RTEZ_REQTITLE,'Error!',RTEZ_FLAGS,EZREQF_CENTERTEXT,RT_REQPOS,REQPOS_CENTERSCR,RT_SCREEN,myscr,RT_UNDERSCORE,"_",NIL]) StrCopy(ffull,'') ENDIF ENDIF CASE GDBT_FIRST Gt_SetGadgetAttrsA(my_gads[GDSL_LOCATE],win,NIL,[GTSL_LEVEL,0,NIL]) recnum:=0 showRecord(my_gads) CASE GDBT_LAST Gt_SetGadgetAttrsA(my_gads[GDSL_LOCATE],win,NIL,[GTSL_LEVEL,maxrec,NIL]) recnum:=maxrec showRecord(my_gads) CASE GDBT_NEXT IF recnum addRecord() sex[recnum]:=0 surnameptr[recnum]:=NEW surnamestr[32] forenameptr[recnum]:=NEW forenamestr[32] addrl1ptr[recnum]:=NEW addrl1str[32] addrl2ptr[recnum]:=NEW addrl2str[32] addrl3ptr[recnum]:=NEW addrl3str[32] addrl4ptr[recnum]:=NEW addrl4str[32] addrl5ptr[recnum]:=NEW addrl5str[32] postcodeptr[recnum]:=NEW postcodestr[32] /* IF maxrec=1 gadgetOn(GDBT_SEARCH,my_gads) gadgetOn(GDBT_FIRST,my_gads) gadgetOn(GDBT_PREVIOUS,my_gads) gadgetOn(GDBT_LAST,my_gads) gadgetOn(GDBT_DELETE,my_gads) gadgetOn(GDBT_UNDELETE,my_gads) gadgetOn(GDBT_SAVE,my_gads) gadgetOn(GDST_FORENAME,my_gads) gadgetOn(GDST_SURNAME,my_gads) gadgetOn(GDST_ADDRL1,my_gads) gadgetOn(GDST_ADDRL2,my_gads) gadgetOn(GDST_ADDRL3,my_gads) gadgetOn(GDST_ADDRL4,my_gads) gadgetOn(GDST_ADDRL5,my_gads) gadgetOn(GDST_POSTCODE,my_gads) gadgetOn(GDST_DOB,my_gads) gadgetOn(GDST_PHONE,my_gads) gadgetOn(GDST_FAX,my_gads) gadgetOn(GDST_EMAIL,my_gads) gadgetOn(GDST_NUMBER,my_gads) gadgetOn(GDST_JOINED,my_gads) gadgetOn(GDST_AGENT,my_gads) gadgetOn(GDST_EXPIRES,my_gads) gadgetOn(GDCY_TITLE,my_gads) ENDIF*/ Gt_SetGadgetAttrsA(my_gads[GDSL_LOCATE],win,NIL,[GTSL_MAX,maxrec,NIL]) ENDIF ENDIF Gt_SetGadgetAttrsA(my_gads[GDSL_LOCATE],win,NIL,[GTSL_LEVEL,recnum,NIL]) showRecord(my_gads) CASE GDBT_PREVIOUS IF recnum>0 THEN DEC recnum ELSE RtEZRequestA('No more records!','_Ok',0,NIL,[RTEZ_REQTITLE,'Error...',RT_REQPOS,REQPOS_CENTERSCR,RT_SCREEN,myscr,RT_UNDERSCORE,"_",NIL]) Gt_SetGadgetAttrsA(my_gads[GDSL_LOCATE],win,NIL,[GTSL_LEVEL,recnum,NIL]) showRecord(my_gads) -> CASE GDBT_NEXT;information('I bet this doesn''t work but I can live in hope!',1,0,'*',1,0) /* CASE GAD_STRING;WriteF('Gadget string: "\s".\n',gad.specialinfo::stringinfo.buffer) CASE GAD_BUTTON WriteF('Button was pressed, slider reset to 5.\n') slider_level[]:=5 Gt_SetGadgetAttrsA(my_gads[GAD_SLIDER],win,NIL,[GTSL_LEVEL,slider_level[],NIL])*/ ENDSELECT ENDPROC PROC showRecord(my_gads:PTR TO LONG) Gt_SetGadgetAttrsA(my_gads[GDST_SURNAME],mywin,NIL,[GTST_STRING,surnameptr[recnum],NIL]) Gt_SetGadgetAttrsA(my_gads[GDST_FORENAME],mywin,NIL,[GTST_STRING,forenameptr[recnum],NIL]) Gt_SetGadgetAttrsA(my_gads[GDST_ADDRL1],mywin,NIL,[GTST_STRING,addrl1ptr[recnum],NIL]) Gt_SetGadgetAttrsA(my_gads[GDST_ADDRL2],mywin,NIL,[GTST_STRING,addrl2ptr[recnum],NIL]) Gt_SetGadgetAttrsA(my_gads[GDST_ADDRL3],mywin,NIL,[GTST_STRING,addrl3ptr[recnum],NIL]) Gt_SetGadgetAttrsA(my_gads[GDST_ADDRL4],mywin,NIL,[GTST_STRING,addrl4ptr[recnum],NIL]) Gt_SetGadgetAttrsA(my_gads[GDST_ADDRL5],mywin,NIL,[GTST_STRING,addrl5ptr[recnum],NIL]) Gt_SetGadgetAttrsA(my_gads[GDST_POSTCODE],mywin,NIL,[GTST_STRING,postcodeptr[recnum],NIL]) Gt_SetGadgetAttrsA(my_gads[GDMX_SEX],mywin,NIL,[GTMX_ACTIVE,sex[recnum],NIL]) #ifdef debug RtEZRequestA('Record \d','_Ok',0,[recnum],[RTEZ_REQTITLE,'Debug...',RTEZ_FLAGS,EZREQF_CENTERTEXT,RT_REQPOS,REQPOS_CENTERSCR,RT_SCREEN,myscr,RT_UNDERSCORE,"_",NIL]) #endif ENDPROC PROC handleVanillaKey(win,code,slider_level:PTR TO LONG,my_gads:PTR TO LONG) SELECT "z" OF code CASE "?";showAbout() CASE "q","Q";checkQuit() CASE "<" recnum:=0 Gt_SetGadgetAttrsA(my_gads[GDSL_LOCATE],win,NIL,[GTSL_LEVEL,recnum,NIL]) CASE ">" recnum:=maxrec Gt_SetGadgetAttrsA(my_gads[GDSL_LOCATE],win,NIL,[GTSL_LEVEL,recnum,NIL]) CASE "-" IF recnum>0 THEN DEC recnum ELSE RtEZRequestA('No more records!','_Ok',0,NIL,[RTEZ_REQTITLE,'Error...',RT_REQPOS,REQPOS_CENTERSCR,RT_SCREEN,myscr,RT_UNDERSCORE,"_",NIL]) Gt_SetGadgetAttrsA(my_gads[GDSL_LOCATE],win,NIL,[GTSL_LEVEL,recnum,NIL]) CASE "s","S";ActivateGadget(my_gads[GDST_SURNAME],win,NIL) CASE "f","F";ActivateGadget(my_gads[GDST_FORENAME],win,NIL) CASE "d","D";ActivateGadget(my_gads[GDST_ADDRL1],win,NIL) CASE "p","P";ActivateGadget(my_gads[GDST_POSTCODE],win,NIL) CASE "b","B";ActivateGadget(my_gads[GDST_DOB],win,NIL) CASE "t","T";ActivateGadget(my_gads[GDST_PHONE],win,NIL) CASE "a","A";ActivateGadget(my_gads[GDST_FAX],win,NIL) CASE "m","M";ActivateGadget(my_gads[GDST_EMAIL],win,NIL) CASE "n","N";ActivateGadget(my_gads[GDST_NUMBER],win,NIL) CASE "g","G";ActivateGadget(my_gads[GDST_AGENT],win,NIL) CASE "j","J";ActivateGadget(my_gads[GDST_JOINED],win,NIL) CASE "r","R";ActivateGadget(my_gads[GDST_EXPIRES],win,NIL) CASE "x","X" IF sex=0 THEN sex:=1 ELSE sex:=0 Gt_SetGadgetAttrsA(my_gads[GDMX_SEX],win,NIL,[GTMX_ACTIVE,sex,NIL]) CASE "i","I" INC title IF title=3 THEN title:=0 Gt_SetGadgetAttrsA(my_gads[GDCY_TITLE],win,NIL,[GTCY_ACTIVE,title,NIL]) -> CASE "","";ActivateGadget(my_gads[GDST_],win,NIL) /* CASE "t";ActivateGadget(my_gads[GAD_STRING],win,NIL) CASE "T";Gt_SetGadgetAttrsA(my_gads[GAD_STRING],win,NIL,[GTST_STRING,'Default text',NIL]) CASE "m" INC mxval IF mxval=3 THEN mxval:=0 Gt_SetGadgetAttrsA(my_gads[GAD_MX],win,NIL,[GTMX_ACTIVE,mxval,NIL]) CASE "M" DEC mxval IF mxval=-1 THEN mxval:=2 Gt_SetGadgetAttrsA(my_gads[GAD_MX],win,NIL,[GTMX_ACTIVE,mxval,NIL])*/ 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:=[106,(16+topborder),200,12,'_Surname:',topaz80,GDST_SURNAME,NIL,vi,0]:newgadget my_gads[GDST_SURNAME]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,25,GT_UNDERSCORE,"_",NIL])) ng:=[411,(16+topborder),200,12,'_Forename:',topaz80,GDST_FORENAME,NIL,vi,0]:newgadget my_gads[GDST_FORENAME]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,25,GT_UNDERSCORE,"_",NIL])) ng:=[106,(30+topborder),200,12,'A_ddress:',topaz80,GDST_ADDRL1,NIL,vi,0]:newgadget my_gads[GDST_ADDRL1]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,50,GT_UNDERSCORE,"_",NIL])) ng:=[106,(42+topborder),200,12,'',topaz80,GDST_ADDRL2,NIL,vi,0]:newgadget my_gads[GDST_ADDRL2]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,50,GT_UNDERSCORE,"_",NIL])) ng:=[106,(54+topborder),200,12,'',topaz80,GDST_ADDRL3,NIL,vi,0]:newgadget my_gads[GDST_ADDRL3]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,50,GT_UNDERSCORE,"_",NIL])) ng:=[106,(66+topborder),200,12,'',topaz80,GDST_ADDRL4,NIL,vi,0]:newgadget my_gads[GDST_ADDRL4]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,50,GT_UNDERSCORE,"_",NIL])) ng:=[106,(78+topborder),200,12,'',topaz80,GDST_ADDRL5,NIL,vi,0]:newgadget my_gads[GDST_ADDRL5]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,50,GT_UNDERSCORE,"_",NIL])) ng:=[106,(90+topborder),200,12,'_Postcode:',topaz80,GDST_POSTCODE,NIL,vi,0]:newgadget my_gads[GDST_POSTCODE]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,9,GT_UNDERSCORE,"_",NIL])) ng:=[411,(54+topborder),200,12,'DO_B:',topaz80,GDST_DOB,NIL,vi,0]:newgadget my_gads[GDST_DOB]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,13,GT_UNDERSCORE,"_",NIL])) ng:=[411,(66+topborder),200,12,'_Telephone:',topaz80,GDST_PHONE,NIL,vi,0]:newgadget my_gads[GDST_PHONE]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,25,GT_UNDERSCORE,"_",NIL])) ng:=[411,(78+topborder),200,12,'F_ax:',topaz80,GDST_FAX,NIL,vi,0]:newgadget my_gads[GDST_FAX]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,25,GT_UNDERSCORE,"_",NIL])) ng:=[411,(90+topborder),200,12,'e_Mail:',topaz80,GDST_EMAIL,NIL,vi,0]:newgadget my_gads[GDST_EMAIL]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,25,GT_UNDERSCORE,"_",NIL])) ng:=[106,(121+topborder),200,12,'_Number:',topaz80,GDST_NUMBER,NIL,vi,0]:newgadget my_gads[GDST_NUMBER]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,15,GT_UNDERSCORE,"_",NIL])) ng:=[411,(121+topborder),200,12,'A_gent:',topaz80,GDST_AGENT,NIL,vi,0]:newgadget my_gads[GDST_AGENT]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,50,GT_UNDERSCORE,"_",NIL])) ng:=[106,(133+topborder),200,12,'_Joined:',topaz80,GDST_JOINED,NIL,vi,0]:newgadget my_gads[GDST_JOINED]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,13,GT_UNDERSCORE,"_",NIL])) ng:=[411,(133+topborder),200,12,'Expi_res:',topaz80,GDST_EXPIRES,NIL,vi,0]:newgadget my_gads[GDST_EXPIRES]:=(gad:=CreateGadgetA(STRING_KIND,gad,ng,[GTST_STRING,'',GTST_MAXCHARS,13,GT_UNDERSCORE,"_",NIL])) ng:=[411,(30+topborder),200,12,'Se_x:',topaz80,GDMX_SEX,NIL,vi,0]:newgadget ng.flags:=2 my_gads[GDMX_SEX]:=(gad:=CreateGadgetA(MX_KIND,gad,ng,[GTMX_LABELS,['Male','Female',NIL],GTMX_ACTIVE,0,GTMX_SPACING,1,GTMX_TITLEPLACE,PLACETEXT_LEFT,GT_UNDERSCORE,"_",NIL])) ng:=[84,(164+topborder),42,12,'_Open',topaz80,GDBT_OPEN,NIL,vi,0]:newgadget ng.flags:=0 my_gads[GDBT_OPEN]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng:=[126,(164+topborder),42,12,'Sa_ve',topaz80,GDBT_SAVE,NIL,vi,0]:newgadget my_gads[GDBT_SAVE]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng:=[168,(164+topborder),24,12,'|_<',topaz80,GDBT_FIRST,NIL,vi,0]:newgadget my_gads[GDBT_FIRST]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng:=[192,(164+topborder),26,12,'<_-',topaz80,GDBT_PREVIOUS,NIL,vi,0]:newgadget my_gads[GDBT_PREVIOUS]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng:=[218,(164+topborder),26,12,'_+>',topaz80,GDBT_NEXT,NIL,vi,0]:newgadget my_gads[GDBT_NEXT]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng:=[244,(164+topborder),24,12,'_>|',topaz80,GDBT_LAST,NIL,vi,0]:newgadget my_gads[GDBT_LAST]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng:=[268,(164+topborder),58,12,'De_lete',topaz80,GDBT_DELETE,NIL,vi,0]:newgadget my_gads[GDBT_DELETE]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng:=[326,(164+topborder),74,12,'_Undelete',topaz80,GDBT_UNDELETE,NIL,vi,0]:newgadget my_gads[GDBT_UNDELETE]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng:=[400,(164+topborder),58,12,'Sear_ch',topaz80,GDBT_SEARCH,NIL,vi,0]:newgadget my_gads[GDBT_SEARCH]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng:=[458,(164+topborder),49,12,'About',topaz80,GDBT_ABOUT,NIL,vi,0]:newgadget my_gads[GDBT_ABOUT]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng:=[507,(164+topborder),42,12,'_Quit',topaz80,GDBT_QUIT,NIL,vi,0]:newgadget my_gads[GDBT_QUIT]:=(gad:=CreateGadgetA(BUTTON_KIND,gad,ng,[GT_UNDERSCORE,"_",NIL])) ng:=[131,(176+topborder),418,12,' ',topaz80,GDSL_LOCATE,NIL,vi,0]:newgadget my_gads[GDSL_LOCATE]:=(gad:=CreateGadgetA(SLIDER_KIND,gad,ng,[GTSL_MIN,1,GTSL_MAX,maxrec,GTSL_LEVEL,0,GTSL_LEVELFORMAT,'\z\d[5]',GTSL_MAXLEVELLEN,2,GT_UNDERSCORE, "_",NIL])) ng:=[550,(30+topborder),61,12,'',topaz80,GDCY_TITLE,NIL,vi,0]:newgadget my_gads[GDCY_TITLE]:=(gad:=CreateGadgetA(CYCLE_KIND,gad,ng,[GTCY_LABELS,['Mr','Mrs','Ms',NIL],GTCY_ACTIVE,0,GT_UNDERSCORE,"_",NIL])) ENDPROC gad PROC showAbout() RtEZRequestA('The Retreat\nFan Club Mailing List\n\nAmiga version by Ivan Oliver\nLast update 06-Jul-97','_Ok',0,NIL,[RTEZ_REQTITLE,'About...',RTEZ_FLAGS,EZREQF_CENTERTEXT,RT_REQPOS,REQPOS_CENTERSCR,RT_SCREEN,myscr,RT_UNDERSCORE,"_",NIL]) ENDPROC PROC checkQuit() IF (RtEZRequestA('Are you sure?','_Yes|_NO!',0,0,[RTEZ_REQTITLE,'Quit...',RTEZ_FLAGS,EZREQF_CENTERTEXT,RT_UNDERSCORE,"_",RT_REQPOS,REQPOS_CENTERSCR,RT_SCREEN,myscr,RTEZ_DEFAULTRESPONSE,0,NIL])=1) THEN wanted:=FALSE ENDPROC 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;checkQuit() 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[32]:ARRAY OF LONG,vi,slider_level=5,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) myscr:=OpenScreenTagList(NIL,[SA_PENS,[-1]:INT,SA_DEPTH,2, SA_WIDTH,640,SA_HEIGHT,256, SA_DISPLAYID,$29000,SA_TYPE,PUBLICSCREEN, SA_TITLE,'The Retreat Screen',NIL]) mywin:=OpenWindowTagList(NIL, [WA_TITLE,'Fan Club Mailing List [Rev. 1-00]', WA_SCREENTITLE,'The Retreat', WA_GADGETS, glist, WA_RMBTRAP, TRUE, WA_WIDTH, 640, WA_MINWIDTH, 50, WA_HEIGHT, 245, WA_MINHEIGHT, 50, WA_DRAGBAR, TRUE, WA_DEPTHGADGET, TRUE, WA_ACTIVATE, TRUE, WA_CLOSEGADGET, FALSE, WA_SIZEGADGET,FALSE, WA_SMARTREFRESH, TRUE, WA_IDCMP, IDCMP_REFRESHWINDOW OR IDCMP_VANILLAKEY OR SLIDERIDCMP OR STRINGIDCMP OR BUTTONIDCMP, WA_PUBSCREEN,myscr,NIL]) Gt_RefreshWindow(mywin,NIL) drawBevelBox(19,23,600,94,vi,FALSE) drawBevelBox(21,24,596,92,vi,FALSE) drawBevelBox(19,128,600,32,vi,FALSE) drawBevelBox(21,129,596,30,vi,FALSE) drawBevelBox(19,171,600,32,vi,TRUE) drawBevelBox(21,172,596,30,vi,FALSE) drawBevelBox(19,214,600,25,vi,FALSE) drawBevelBox(21,215,596,23,vi,FALSE) PrintIText(mywin.rport,[2,0,RP_JAM1,0,0,['topaz.font',8,4,0]:textattr,'Personal Details...',NIL]:intuitext,24,14) PrintIText(mywin.rport,[2,0,RP_JAM1,0,0,['topaz.font',8,4,0]:textattr,'Membership Details...',NIL]:intuitext,24,119) PrintIText(mywin.rport,[2,0,RP_JAM1,0,0,['topaz.font',8,4,0]:textattr,'Control Panel...',NIL]:intuitext,24,162) PrintIText(mywin.rport,[2,0,RP_JAM1,0,0,['topaz.font',8,4,0]:textattr,'Information...',NIL]:intuitext,24,205) information('This copy is registered to Mr I E Oliver',1,0,'39 Beckly Court, Armada Way, Plymouth, Devon, PL1 1LD, England',1,0) #ifdef debug gadgetOff(GDBT_SEARCH,my_gads) gadgetOff(GDBT_FIRST,my_gads) gadgetOff(GDBT_PREVIOUS,my_gads) gadgetOff(GDBT_LAST,my_gads) gadgetOff(GDBT_DELETE,my_gads) gadgetOff(GDBT_UNDELETE,my_gads) gadgetOff(GDBT_SAVE,my_gads) gadgetOff(GDST_FORENAME,my_gads) gadgetOff(GDST_SURNAME,my_gads) gadgetOff(GDST_ADDRL1,my_gads) gadgetOff(GDST_ADDRL2,my_gads) gadgetOff(GDST_ADDRL3,my_gads) gadgetOff(GDST_ADDRL4,my_gads) gadgetOff(GDST_ADDRL5,my_gads) gadgetOff(GDST_POSTCODE,my_gads) gadgetOff(GDST_DOB,my_gads) gadgetOff(GDST_PHONE,my_gads) gadgetOff(GDST_FAX,my_gads) gadgetOff(GDST_EMAIL,my_gads) gadgetOff(GDST_NUMBER,my_gads) gadgetOff(GDST_JOINED,my_gads) gadgetOff(GDST_AGENT,my_gads) gadgetOff(GDST_EXPIRES,my_gads) gadgetOff(GDCY_TITLE,my_gads) #endif RtEZRequestA('Undocumented hotkeys:\n\nI => Cycle the title gadget\n- => Previous record\n+ => Next record\n? => Equivalent to "About"','_Ok',0,0,[RTEZ_REQTITLE,'Notice...',RT_REQPOS,REQPOS_CENTERSCR,RT_SCREEN,myscr,RT_UNDERSCORE,"_",NIL]) processWindowEvents(mywin,{slider_level},my_gads) EXCEPT DO IF mywin THEN CloseWindow(mywin) IF myscr THEN CloseScreen(myscr) FreeGadgets(glist) IF vi THEN FreeVisualInfo(vi) IF myscr THEN UnlockPubScreen(mysc,NIL) IF font THEN CloseFont(font) ReThrow() ENDPROC PROC drawBevelBox(x,y,w,h,vi,recessed) DrawBevelBoxA(mywin.rport,x,y,w,h,[GT_VISUALINFO,vi,GTBB_RECESSED,recessed,NIL]) ENDPROC PROC fatalError(text) EasyRequestArgs(0,[20,0,'Fatal Error...',text,'Ok'],0,0) ENDPROC PROC gadgetOn(gadget,my_gads:PTR TO LONG) OnGadget(my_gads[gadget],mywin,NIL) ENDPROC PROC gadgetOff(gadget,my_gads:PTR TO LONG) OffGadget(my_gads[gadget],mywin,NIL) ENDPROC PROC information(linea,pena,stylea,lineb,penb,styleb) SetABPenDrMd(mywin.rport,0,0,RP_JAM2) RectFill(mywin.rport,23,216,614,236) IF StrCmp(lineb,'*',ALL) PrintIText(mywin.rport,[pena,0,RP_JAM2,0,0,['topaz.font',8,stylea,0]:textattr,linea,NIL]:intuitext,320-(StrLen(linea)*8/2),222) ELSE PrintIText(mywin.rport,[pena,0,RP_JAM2,0,0,['topaz.font',8,stylea,0]:textattr,linea,NIL]:intuitext,320-(StrLen(linea)*8/2),218) PrintIText(mywin.rport,[penb,0,RP_JAM2,0,0,['topaz.font',8,styleb,0]:textattr,lineb,NIL]:intuitext,320-(StrLen(lineb)*8/2),227) ENDIF ENDPROC #ifdef debug PROC requestText() RtEZRequestA('"\s"','_Ok!',0,[temps],[RTEZ_REQTITLE,'Debug...',RT_REQPOS,REQPOS_CENTERSCR,RT_SCREEN,myscr,RT_UNDERSCORE,"_",NIL]) ENDPROC #endif PROC getFilename(frtitle) HANDLE DEF fr:PTR TO filerequester fr:=AllocAslRequest(ASL_FILEREQUEST,[ASL_HAIL,frtitle,ASL_HEIGHT,200, ASL_WIDTH,320,ASL_LEFTEDGE,0,ASL_TOPEDGE,0,ASL_OKTEXT,'Ok', ASL_CANCELTEXT,'Cancel',ASL_FILE,fname,ASL_DIR,fpath,ASLFR_SCREEN,myscr,NIL]) IF AslRequest(fr,NIL) fname:=fr.file UpperStr(fname) fpath:=fr.drawer UpperStr(fpath) ELSE fname:=FALSE fpath:=FALSE ENDIF EXCEPT IF fr THEN FreeAslRequest(fr) SELECT exception CASE ERR_ASL; fatalError('Unable to allocate ASL request') ENDSELECT ReThrow() ENDPROC PROC main() HANDLE KickVersion(37) IF gadtoolsbase:=OpenLibrary('gadtools.library',37) IF reqtoolsbase:=OpenLibrary('reqtools.library',37) IF aslbase:=OpenLibrary('asl.library',37) ->addRecord() gadtoolsWindow() ELSE fatalError('Unable to open asl.library v37') ENDIF ELSE fatalError('Unable to open reqtools.library v37') ENDIF ELSE fatalError('Unable to open gadtools.library v37') ENDIF -> EasyRequestArgs(0,[20,0,'','Goodbye','Ok'],0,0) EXCEPT DO IF aslbase THEN CloseLibrary(aslbase) IF reqtoolsbase THEN CloseLibrary(reqtoolsbase) IF gadtoolsbase THEN CloseLibrary(gadtoolsbase) SELECT exception CASE ERR_FONT; fatalError('Unable to open topaz.font 8') CASE ERR_GAD; fatalError('Unable to create gadgets') CASE ERR_KICK; WriteF('ERROR: Requires v37 (KS2+)\n') CASE ERR_PUB; fatalError('Unable to lock default public screen') CASE ERR_VIS; fatalError('GetVisualInfoA() failed') CASE ERR_WIN; fatalError('Unable to open the window') ENDSELECT ENDPROC version: CHAR '$VER: The Retreat Mailing List Database v1.00 (06-Jul-97)',0