OPT OSVERSION=37 OPT PREPROCESS MODULE 'intuition/intuition', 'gadtools','libraries/gadtools', 'intuition/gadgetclass','intuition/screens', 'graphics/gfxbase','graphics/text','graphics/rastport', 'exec/lists','exec/nodes','exec/ports','utility/tagitem', 'diskfont','exec','graphics/view','graphics/rastport', 'intuition/intuition','intuition/screens','iff', 'intuition/intuitionbase','reqtools','libraries/reqtools', 'asl','libraries/asl' DEF screen:PTR TO screen,visual=NIL, rp:PTR TO rastport,winfont:textattr, scrfont:PTR TO textattr,checkquit=FALSE, offx,offy,strinfo:PTR TO stringinfo, txt[256]:STRING,which=0,fontx,fonty, class,code,iadd:PTR TO gadget,project0_window=NIL:PTR TO window, project0_glist=NIL,project0_font=NIL, commstring:PTR TO gadget, loadcommand, cornerlines, save,cancel,mcode,saven, ibase:PTR TO intuitionbase,win:PTR TO window,x,y,z, s0[120]:STRING,s1[120]:STRING,s2[120]:STRING, s3[120]:STRING,s4[120]:STRING,s5[120]:STRING, s6[120]:STRING,s7[120]:STRING, quit=0,cfile,value,read,co=0,taglist[32]:ARRAY OF LONG, len,buf[120]:STRING,num:LONG,actwind,ver[32]:STRING,actscreen, sa[120]:STRING, ttt[256]:STRING,req:PTR TO filerequester,tt1[256]:ARRAY OF CHAR ENUM ER_NONE, ER_SCREEN, ER_VISUAL, ER_CONTEXT, ER_MENUS, ER_GADGET, ER_WINDOW, ER_NOGT, ER_NODF, ER_FONT, ER_NOUTIL, ER_NOCFG, ER_NORQ CONST GA_COMMSTRING=0, GA_LOADCOMMAND=1, GA_CORNERLINES=2, GA_SAVE=3, GA_CANCEL=4 PROC computefont(width,height) DEF msg:PTR TO mn DEF tf:PTR TO textfont DEF nde:PTR TO ln DEF gfx:PTR TO gfxbase Forbid() gfx:=gfxbase tf:=gfx.defaultfont msg:=tf.mn nde:=msg.ln winfont.name:=nde.name winfont.ysize:=fonty:=tf.ysize winfont.style:=tf.style winfont.flags:=tf.flags fontx:=tf.xsize Permit() IF (width<>0 AND height<>0) IF ((cx(width)+offx+screen.wborright)>screen.width) OR ((cy(height)+offy+screen.wborbottom)>screen.height) winfont.name:='topaz.font' winfont.ysize:=8 fontx:=fonty:=winfont.ysize ENDIF ENDIF ENDPROC PROC cx(value) RETURN ((fontx*value)+4/8) ENDPROC PROC cy(value) RETURN ((fonty*value)+4/8) ENDPROC PROC openlibs() HANDLE IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN Raise(ER_NOGT) IF (diskfontbase:=OpenLibrary('diskfont.library',37))=NIL THEN Raise(ER_NODF) IF (reqtoolsbase:=OpenLibrary('reqtools.library',37))=NIL THEN Raise(ER_NORQ) Raise(ER_NONE) EXCEPT RETURN exception ENDPROC PROC closelibs() IF gadtoolsbase THEN CloseLibrary(gadtoolsbase) IF diskfontbase THEN CloseLibrary(diskfontbase) IF reqtoolsbase THEN CloseLibrary(reqtoolsbase) ENDPROC PROC setupscreen() HANDLE DEF font winfont:=scrfont:=['topaz.font',8,0,1]:textattr IF (font:=OpenDiskFont(winfont))=NIL THEN Raise(ER_FONT) IF (screen:=LockPubScreen('Workbench'))=NIL THEN Raise(ER_SCREEN) IF (visual:=GetVisualInfoA(screen,NIL))=NIL THEN Raise(ER_VISUAL) rp:=screen.rastport offx:=screen.wborleft offy:=screen.wbortop+rp.txheight+1 IF font THEN CloseFont(font) computefont(NIL,NIL) Raise(ER_NONE) EXCEPT RETURN exception ENDPROC PROC setdownscreen() IF visual THEN FreeVisualInfo(visual) IF screen THEN UnlockPubScreen(NIL,screen) ENDPROC PROC init_project0_wnd() HANDLE computefont(327,43) IF (project0_glist:=CreateContext({project0_glist}))=NIL THEN Raise(ER_CONTEXT) IF (commstring:=CreateGadgetA(STRING_KIND,project0_glist,[offx+cx(3),offy+cy(15),cx(269),cy(13),'',winfont,0,0,visual,0]:newgadget,[GTST_MAXCHARS,256,TAG_DONE]))=NIL THEN Raise(ER_GADGET) IF (loadcommand:=CreateGadgetA(BUTTON_KIND,commstring,[offx+cx(275),offy+cy(15),cx(50),cy(13),'Load',winfont,1,16,visual,NIL]:newgadget,[TAG_DONE]))=NIL THEN Raise(ER_GADGET) IF (cornerlines:=CreateGadgetA(CYCLE_KIND,loadcommand,[offx+cx(3),offy+cy(1),cx(322),cy(13),'Corner & Lines',winfont,2,1,visual,NIL]:newgadget,[GTCY_LABELS,['Left upper corner','Right upper corner','Right down corner','Left down corner','Left middle line','Right middle line','Info','Help',NIL],TAG_DONE]))=NIL THEN Raise(ER_GADGET) IF (save:=CreateGadgetA(BUTTON_KIND,cornerlines,[offx+cx(3),offy+cy(29),cx(158),cy(13),'Save + Hide',winfont,3,16,visual,NIL]:newgadget,[TAG_DONE]))=NIL THEN Raise(ER_GADGET) IF (cancel:=CreateGadgetA(BUTTON_KIND,save,[offx+cx(164),offy+cy(29),cx(161),cy(13),'Cancel',winfont,4,16,visual,NIL]:newgadget,[TAG_DONE]))=NIL THEN Raise(ER_GADGET) Raise(ER_NONE) EXCEPT RETURN exception ENDPROC PROC w4m_project0_wnd() DEF id, n:PTR TO menuitem Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s0,TAG_DONE]) REPEAT wait4message(project0_window) SELECT class CASE IDCMP_GADGETUP id:=iadd.gadgetid handle_project0_gadgets(id) CASE IDCMP_CLOSEWINDOW checkquit:=TRUE ENDSELECT UNTIL checkquit=TRUE ENDPROC PROC open_project0_wnd() HANDLE DEF wl=145, wt=96, ww=327, wh=43 computefont(ww,wh) IF (wl+ww+offx+screen.wborright)>screen.width THEN wl:=screen.width-ww IF (wt+wh+offy+screen.wborbottom)>screen.height THEN wt:=screen.height-wh IF (project0_font:=OpenDiskFont(winfont))=NIL THEN Raise(ER_FONT) IF (project0_window:=OpenWindowTagList(NIL, [WA_LEFT,wl, WA_TOP,wt, WA_WIDTH,offx+screen.wborright+cx(ww), WA_HEIGHT,offy+screen.wborbottom+cy(wh), WA_IDCMP,IDCMP_GADGETUP+IDCMP_CLOSEWINDOW, WA_FLAGS,WFLG_DEPTHGADGET+WFLG_DRAGBAR+WFLG_CLOSEGADGET+WFLG_NEWLOOKMENUS, WA_GADGETS,project0_glist, WA_TITLE,'PickMouse V1.2: settings...', WA_SCREENTITLE,'Settings of PickMouse V1.2', TAG_DONE]))=NIL THEN Raise(ER_WINDOW) Raise(ER_NONE) EXCEPT RETURN exception ENDPROC PROC close_project0_wnd() IF project0_window THEN CloseWindow(project0_window) IF project0_glist THEN FreeGadgets(project0_glist) IF project0_font THEN CloseFont(project0_font) ENDPROC PROC wait4message(win:PTR TO window) DEF mes:PTR TO intuimessage REPEAT class:=0 IF mes:=Gt_GetIMsg(win.userport) class:=mes.class code:=mes.code iadd:=mes.iaddress Gt_ReplyIMsg(mes) ELSE WaitPort(win.userport) ENDIF UNTIL class ENDPROC PROC main() HANDLE pm() EXCEPT SELECT exception CASE ER_NOCFG; WriteF('Could not open config file!\n') ENDSELECT ENDPROC PROC okno() HANDLE DEF err IF (err:=setupscreen())<>ER_NONE THEN Raise(err) IF (err:=init_project0_wnd())<>ER_NONE THEN Raise(err) IF (err:=open_project0_wnd())<>ER_NONE THEN Raise(err) w4m_project0_wnd() Raise(ER_NONE) EXCEPT close_project0_wnd() setdownscreen() SELECT exception CASE ER_SCREEN; WriteF('Could not lock screen!\n') CASE ER_VISUAL; WriteF('Could not get visual!\n') CASE ER_CONTEXT; WriteF('Could not get context!\n') CASE ER_MENUS; WriteF('Could not create menus!\n') CASE ER_GADGET; WriteF('Could not create gadget!\n') CASE ER_WINDOW; WriteF('Could not open window!\n') CASE ER_FONT; WriteF('Could not open font!\n') ENDSELECT ENDPROC PROC pm() HANDLE DEF err ver:='$VER: PickMouse V1.2 © 1998 by MIKESOFTWARE!' IF readconfig()=FALSE s7:='REQS' s6:='20' s0:='Init me, please!' s1:='Init me, please!' s2:='Init me, please!' s3:='Init me, please!' s4:='Init me, please!' s5:='Init me, please!' ENDIF IF (err:=openlibs())<>ER_NONE THEN Raise(err) ibase:=intuitionbase REPEAT x:=ibase.mousex y:=ibase.mousey z:=Mouse() SELECT z CASE 2 IF x<=1 IF y<=1 StrCopy(sa,s0,ALL) IF okokno(co)=TRUE Execute(s0,0,0) ENDIF REPEAT;UNTIL Mouse()=0 ELSEIF y>=510 StrCopy(sa,s3,ALL) IF okokno(co)=TRUE Execute(s3,0,0) ENDIF REPEAT;UNTIL Mouse()=0 ELSE StrCopy(sa,s4,ALL) IF okokno(co)=TRUE Execute(s4,0,0) ENDIF REPEAT;UNTIL Mouse()=0 ENDIF ELSEIF x>=639 IF y<=1 StrCopy(sa,s1,ALL) IF okokno(co)=TRUE Execute(s1,0,0) ENDIF REPEAT;UNTIL Mouse()=0 ELSEIF y>=510 StrCopy(sa,s2,ALL) IF okokno(co)=TRUE Execute(s2,0,0) ENDIF REPEAT;UNTIL Mouse()=0 ELSE StrCopy(sa,s5,ALL) IF okokno(co)=TRUE Execute(s5,0,0) ENDIF REPEAT;UNTIL Mouse()=0 ENDIF ELSE IF y>=510 doconfig() ENDIF REPEAT;UNTIL Mouse()=0 ENDIF CASE 3 actscreen:=ibase.activescreen taglist:=[RT_SCREEN,actscreen,RTEZ_REQTITLE,'Question from PM V1.2:',RT_UNDERSCORE,TRUE,0] IF (RtEZRequestA(' Really quit? ','YES|NO',0,0,taglist))=1 quit:=TRUE ELSE quit:=FALSE ENDIF ENDSELECT value,read:=Val(s6,read=NIL) Delay(value) UNTIL quit=TRUE informace() EXCEPT closelibs() SELECT exception CASE ER_NODF; WriteF('Could not open diskfont.library v37+!\n') CASE ER_NOGT; WriteF('Could not open gadtools.library v37+!\n') CASE ER_NORQ; WriteF('Could not open reqtools.library v37+!\n') ENDSELECT ENDPROC PROC readconfig() DEF err IF cfile:=Open('s:pm.cfg',OLDFILE) ReadStr(cfile,s0) ReadStr(cfile,s1) ReadStr(cfile,s2) ReadStr(cfile,s3) ReadStr(cfile,s4) ReadStr(cfile,s5) ReadStr(cfile,s6) ReadStr(cfile,s7) Close(cfile) err:=-1 ELSE err:=0 ENDIF ENDPROC err PROC okokno(co) DEF st[256]:STRING,i IF StrCmp(s7,'REQS',4)=TRUE actscreen:=ibase.activescreen taglist:=[RT_SCREEN,actscreen,RTEZ_REQTITLE,'Execute',RT_UNDERSCORE,TRUE,0] len:=0 IF StrLen(sa)<=0 RtEZRequestA('Sorry, command not installed!','Hmmm...',0,0,taglist) ELSE FOR i:=0 TO 256 DO st[i]:=0 StrCopy(st,sa,ALL) StringF(st,'Execute \q\s\q ?',st) IF RtEZRequestA(st,'Yes|No',0,0,taglist)=1 THEN co:=TRUE ELSE co:=FALSE ENDIF ELSE co:=TRUE ENDIF ENDPROC co PROC doconfig() okno() saveconfig() ENDPROC PROC saveconfig() IF saven=1 DeleteFile('s:pm.cfg') IF cfile:=Open('s:pm.cfg',NEWFILE) len:=StrLen(s0) Write(cfile,s0,len) Write(cfile,'\n',1) len:=StrLen(s1) Write(cfile,s1,len) Write(cfile,'\n',1) len:=StrLen(s2) Write(cfile,s2,len) Write(cfile,'\n',1) len:=StrLen(s3) Write(cfile,s3,len) Write(cfile,'\n',1) len:=StrLen(s4) Write(cfile,s4,len) Write(cfile,'\n',1) len:=StrLen(s5) Write(cfile,s5,len) Write(cfile,'\n',1) back: IF RtGetLongA({num},'Enter delay:',0,taglist)<>0 StringF(s6,'\d\n',num) Write(cfile,s6,StrLen(s6)) ELSE JUMP back ENDIF IF RtEZRequestA('REQS?','Yes|No',0,0,taglist)=1 THEN Write(cfile,'REQS\n',5) ELSE Write(cfile,'NOREQS\n',7) Close(cfile) ENDIF ENDIF readconfig() ENDPROC PROC handle_project0_gadgets(id) DEF i SELECT id CASE GA_COMMSTRING checkquit:=FALSE strinfo:=commstring.specialinfo txt:=strinfo.buffer SELECT mcode CASE 0 AstrCopy(s0,txt,ALL) CASE 1 AstrCopy(s1,txt,ALL) CASE 2 AstrCopy(s2,txt,ALL) CASE 3 AstrCopy(s3,txt,ALL) CASE 4 AstrCopy(s4,txt,ALL) CASE 5 AstrCopy(s5,txt,ALL) ENDSELECT CASE GA_LOADCOMMAND getfile() checkquit:=FALSE SELECT mcode CASE 0 AstrCopy(s0,ttt,ALL) Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s0,TAG_DONE]) CASE 1 AstrCopy(s1,ttt,ALL) Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s1,TAG_DONE]) CASE 2 AstrCopy(s2,ttt,ALL) Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s2,TAG_DONE]) CASE 3 AstrCopy(s3,ttt,ALL) Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s3,TAG_DONE]) CASE 4 AstrCopy(s4,ttt,ALL) Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s4,TAG_DONE]) CASE 5 AstrCopy(s5,ttt,ALL) Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s5,TAG_DONE]) ENDSELECT CASE GA_CORNERLINES checkquit:=FALSE mcode:=code SELECT mcode CASE 0 Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s0,TAG_DONE]) CASE 1 Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s1,TAG_DONE]) CASE 2 Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s2,TAG_DONE]) CASE 3 Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s3,TAG_DONE]) CASE 4 Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s4,TAG_DONE]) CASE 5 Gt_SetGadgetAttrsA(commstring,project0_window,0,[GTST_STRING,s5,TAG_DONE]) CASE 6 informace() CASE 7 help() ENDSELECT CASE GA_SAVE saven:=1 checkquit:=TRUE CASE GA_CANCEL saven:=0 checkquit:=TRUE ENDSELECT ENDPROC PROC getfile() DEF i FOR i:=0 TO 256 DO ttt[i]:=0 IF aslbase:=OpenLibrary('asl.library',37) IF req:=AllocFileRequest() IF RequestFile(req) tt1:=req.drawer len:=StrLen(tt1) IF tt1[len-1]=$3a THEN StringF(ttt,'\s\s',req.drawer,req.file) ELSE StringF(ttt,'\s/\s',req.drawer,req.file) ELSE WriteF('Error?\n') ENDIF FreeFileRequest(req) ELSE WriteF('Could not open filerequester!\n') ENDIF CloseLibrary(aslbase) ELSE WriteF('Could not open asl.library!\n') ENDIF ENDPROC ttt PROC informace() reqinfo('PickMouse V1.2 (18.3.1998) - Freeware:\n\n© 1998 by MIKESOFT!\n\n'+ 'Contacts: mikesoft@hotmail.com\n\n'+ 'Thanks to: Nico Francois for Reqtools!\n'+ '--------------------------------------\n'+ 'My address:\n'+ '===========\n\n'+ 'Milan Kajnar, dipl.tech.\n'+ 'Manesova 978, Jesenik 790 01, (CZ)\n'+ '----------------------------------\n','OK',0) ENDPROC PROC help() reqinfo('HELP PAGE of PickMouse V1.2:\n'+ '----------------------------\n'+ '\n'+ 'This small utility is launcher of your\n'+ 'prefered programs in all types of\n'+ 'screens.\n'+ 'For launching of your programs are used\n'+ 'all corners on screen + middles of left\n'+ '& right border.\n'+ 'See:\n'+ ' 1 2\n'+ '\n'+ ' 5 6\n'+ '\n'+ ' 4 CFG 3\n'+ '\n'+ 'It is very easy, just move mouse to some\n'+ 'numbered place and pick right mouse\n'+ 'button. CFG is configuration...\n'+ 'Do you want quit - just use both mouse!\n'+ 'That is all!\n'+ ' Bye!\n'+ ' MIKE','OK',0) ENDPROC PROC reqinfo(body,gadgets,args) actwind:=ibase.activewindow ENDPROC EasyRequestArgs(actwind,[20,0,'Info request:',body,gadgets],0,args)