/* PictureMenu v2.0 */ /* by */ /* Pawel 2P Pijanowski */ MODULE 'intuition/intuition' MODULE 'intuition/screens' MODULE 'exec/ports' MODULE 'exec/nodes' MODULE 'exec/tasks' MODULE 'graphics/text' MODULE 'diskfont' MODULE 'tools/file' OBJECT picamiga it_frontpen:CHAR it_backpen:CHAR it_drawmode:CHAR it_kludgefill00:CHAR it_leftedge:INT it_topedge:INT it_itextfont it_itext it_nexttext m_char:CHAR m_zero:CHAR ENDOBJECT OBJECT picmenu next adres_miwb adres_itwb mi_nextitem mi_leftedge:INT mi_topedge:INT mi_width:INT mi_height:INT mi_flags:INT mi_mutualexclude mi_itemfill mi_selectfill mi_command:CHAR mi_kludgefill00:CHAR mi_subitem mi_nextselect:INT itwb_frontpen:CHAR itwb_backpen:CHAR itwb_drawmode:CHAR itwb_kludgefill00:CHAR itwb_leftedge:INT itwb_topedge:INT itwb_itextfont itwb_itext itwb_nexttext itm1_frontpen:CHAR itm1_backpen:CHAR itm1_drawmode:CHAR itm1_kludgefill00:CHAR itm1_leftedge:INT itm1_topedge:INT itm1_itextfont itm1_itext itm1_nexttext m1_char:CHAR m1_zero:CHAR itm2_frontpen:CHAR itm2_backpen:CHAR itm2_drawmode:CHAR itm2_kludgefill00:CHAR itm2_leftedge:INT itm2_topedge:INT itm2_itextfont itm2_itext itm2_nexttext m2_char:CHAR m2_zero:CHAR mx:CHAR my:CHAR menutxt[15]:ARRAY OF CHAR itwbs_frontpen:CHAR itwbs_backpen:CHAR itwbs_drawmode:CHAR itwbs_kludgefill00:CHAR itwbs_leftedge:INT itwbs_topedge:INT itwbs_itextfont itwbs_itext itwbs_nexttext ENDOBJECT DEF win:PTR TO window DEF picfont[20]:STRING DEF picsizefont DEF picprefslist DEF picwbscr:PTR TO screen DEF picheightitem DEF picheightbar DEF picdeltax DEF picdeltay DEF magicmenu=TRUE DEF commseq=TRUE DEF wbmenu:PTR TO menu DEF error=FALSE,errormes[30]:STRING DEF m_textattr:textattr DEF m_textattr2:textattr DEF wb_textattr:PTR TO textattr DEF wb_intuitext:PTR TO intuitext DEF wbs_intuitext:PTR TO intuitext DEF m1_intuitext:PTR TO intuitext DEF m2_intuitext:PTR TO intuitext DEF m_image:PTR TO image DEF m_textfont DEF m_textfont2 DEF it_nic:intuitext DEF resetwbmi:PTR TO menuitem PROC main() DEF firsttime=FALSE DEF it:PTR TO intuitext DEF mysz DEF tempstr[100]:STRING DEF lock wbmenu:=0 IF win:=OpenW(0,0,1,1,$200,256,'',NIL,1,NIL) picwbscr:=win.wscreen CloseW(win) load_prefs_file('ENV:PicM_Workbench.prefs') setfont() lock:=LockPubScreen(0) IF error=FALSE REPEAT Forbid() IF firsttime THEN restore() firsttime:=TRUE IF error=FALSE IF wbmenu:=on_off_menu(0,'WORKBENCH',picwbscr) init_item_var() modify_menu() wbmenu:=on_off_menu(wbmenu,'WORKBENCH',picwbscr) Permit() it:=resetwbmi.itemfill IF error=FALSE REPEAT Delay(50) UNTIL (it.leftedge<5) mysz:=Mouse() ENDIF ELSE Permit() seterror('Have you WB screen?') ENDIF ENDIF UNTIL error OR mysz=%1 ENDIF Forbid() IF wbmenu THEN restore() Permit() StrCopy(tempstr,'PictureMenu ',ALL) UnlockPubScreen(0,lock) IF error StrAdd(tempstr,'ERROR... ') StrAdd(tempstr,errormes) ELSE StrAdd(tempstr,'v2.0 (18.08.1996)\n\nPrograming & Gfx: Pawel "2P" Pijanowski\nGfx "keys": Rafal Glebowski') ENDIF request(tempstr,'Quit',NIL) ELSE seterror('OpenWindow()') ENDIF IF diskfontbase THEN CloseLibrary(diskfontbase) IF m_textfont THEN CloseFont(m_textfont) ENDPROC PROC modify_menu() DEF x=1,y=1,height DEF mm:PTR TO menu DEF mi:PTR TO menuitem DEF picleftedge mm:=wbmenu WHILE mm<>0 y:=1 height:=0 mi:=mm.firstitem picleftedge:=mi.leftedge WHILE mi<>0 height,picleftedge:=modify_item(mi,x,y,height,picleftedge) IF (mi.flags AND %10) THEN INC y mi:=mi.nextitem ENDWHILE INC x mm:=mm.nextmenu ENDWHILE mi:=resetwbmi.nextitem resetwbmi.width:=Max(mi.width,resetwbmi.width) ENDPROC PROC modify_item(mi:PTR TO menuitem,x,y,height,picleftedge) DEF actpm:PTR TO picmenu DEF prevpm:PTR TO picmenu DEF ami_it:PTR TO intuitext DEF a2_it:PTR TO intuitext DEF actpicami:PTR TO picamiga actpm:=picprefslist prevpm:=0 wb_intuitext:=mi.itemfill WHILE ((actpm.mx<>x)OR(actpm.my<>y))AND(actpm<>0)AND((StrCmp(wb_intuitext.itext,actpm.menutxt,StrLen(actpm.menutxt))=FALSE)OR(StrLen(actpm.menutxt)=0)) prevpm:=actpm actpm:=actpm.next ENDWHILE IF actpm=0 IF (actpm:=New(SIZEOF picmenu)) IF prevpm=0 THEN picprefslist:=actpm ELSE prevpm.next:=actpm prevpm:=actpm actpm.mx:=x actpm.my:=y actpm.m1_char:=32 actpm.m2_char:=32 ELSE seterror('AllocMem()') ENDIF ENDIF actpm.adres_miwb:=mi actpm.adres_itwb:=mi.itemfill CopyMem(actpm.adres_miwb,(actpm+12),34) CopyMem(actpm.adres_itwb,(actpm+46),20) mi.topedge:=height IF (mi.flags AND %10) wb_intuitext:=mi.itemfill m1_intuitext:=actpm+66 m2_intuitext:=actpm+88 CopyMem(wb_intuitext,m1_intuitext,20) CopyMem(wb_intuitext,m2_intuitext,20) m1_intuitext.itextfont:=m_textattr m2_intuitext.itextfont:=m_textattr m1_intuitext.drawmode:=1 m1_intuitext.backpen:=1 m1_intuitext.frontpen:=0 m2_intuitext.drawmode:=1 m2_intuitext.backpen:=1 m2_intuitext.frontpen:=0 wb_intuitext.drawmode:=0 wb_intuitext.backpen:=0 wb_intuitext.frontpen:=1 IF magicmenu=TRUE THEN mi.flags:=(mi.flags OR HIGHIMAGE) AND (Not(HIGHCOMP)) wb_intuitext.leftedge:=wb_intuitext.leftedge+picdeltax mi.width:=mi.width+picdeltax mi.height:=picheightitem mi.leftedge:=picleftedge wb_intuitext.topedge:=wb_intuitext.topedge+picdeltay IF (x=4) AND (y=1) THEN resetwbmi:=mi height:=height+picheightitem m1_intuitext.topedge:=m1_intuitext.topedge+1 m2_intuitext.topedge:=m2_intuitext.topedge+1 m1_intuitext.itext:=actpm+86 m2_intuitext.itext:=actpm+108 m1_intuitext.nexttext:=it_nic m2_intuitext.nexttext:=it_nic IF ((mi.flags AND %100)=4) AND commseq IF ami_it:=New(SIZEOF picamiga) IF a2_it:=New(SIZEOF picamiga) CopyMem(it_nic,ami_it,20) ami_it.itext:=ami_it+20 ami_it.nexttext:=0 ami_it.itextfont:=m_textattr2 ami_it.leftedge:=mi.leftedge+mi.width-25 ami_it.topedge:=2 actpicami:=ami_it actpicami.m_char:=mi.command actpicami.m_zero:=0 ami_it.drawmode:=1 ami_it.backpen:=1 m1_intuitext.nexttext:=ami_it m2_intuitext.nexttext:=a2_it CopyMem(ami_it,a2_it,20) a2_it.itext:=a2_it+20 actpicami:=a2_it actpicami.m_char:=mi.command+32 actpicami.m_zero:=0 IF mi.command<63 THEN actpicami.m_char:=mi.command+120 ENDIF ENDIF ENDIF mi.flags:=(mi.flags AND $FFFFFFFB) IF magicmenu=FALSE mi.flags:=(mi.flags OR HIGHIMAGE)AND(mi.flags OR HIGHBOX) IF x=1 THEN mi.leftedge:=mi.leftedge+45 wb_intuitext.leftedge:=wb_intuitext.leftedge-30 m1_intuitext.leftedge:=-34 m2_intuitext.leftedge:=-34 ENDIF wbs_intuitext:=actpm+128 CopyMem(wb_intuitext,wbs_intuitext,20) wb_intuitext.nexttext:=m1_intuitext wbs_intuitext.nexttext:=m2_intuitext mi.selectfill:=wbs_intuitext mi.itemfill:=wb_intuitext ELSE height:=height+picheightbar m_image:=mi.itemfill IF magicmenu=TRUE THEN mi.leftedge:=picleftedge+picdeltax ENDIF IF height>(picwbscr.height-picwbscr.barheight-30) height:=0 picleftedge:=actpm.mi_width+40 ENDIF ENDPROC height,picleftedge PROC init_item_var() DEF actmi:PTR TO menuitem actmi:=wbmenu.firstitem CopyMem(actmi.itemfill,it_nic,20) it_nic.itext:='' it_nic.nexttext:=0 wb_intuitext:=actmi.itemfill wb_textattr:=wb_intuitext.itextfont picheightbar:=6 picheightitem:= Max(m_textattr.ysize+4,wb_textattr.ysize) picdeltax:=m_textattr.ysize+16 IF picheightitem=m_textattr.ysize+4 THEN picdeltay:=(picheightitem-wb_textattr.ysize)/2 it_nic.topedge:=it_nic.topedge+picdeltay ENDPROC PROC load_prefs_file(filename) -> inicjuje listë preferencji i zmienne globalne na podstawie DEF prevpm:PTR TO picmenu -> pliku o nazwie (filename) DEF actpm:PTR TO picmenu DEF fh,eof DEF sizestr[20]:STRING DEF tempstr[14]:STRING prevpm:=0 IF fh:=Open(filename,OLDFILE) IF ReadStr(fh,picfont)=-1 THEN seterror('prefs: font') IF ReadStr(fh,sizestr)=-1 THEN seterror('prefs: magicmenu') UpperStr(sizestr) IF StrCmp(sizestr,'NO MAGICMENU',ALL) magicmenu:=FALSE picsizefont:=24 ELSE magicmenu:=TRUE picsizefont:=20 ENDIF IF ReadStr(fh,sizestr)=-1 THEN seterror('prefs: commseq') UpperStr(sizestr) IF (StrCmp(sizestr,'NO COMMSEQ',ALL)) THEN commseq:=FALSE ReadStr(fh,sizestr) REPEAT eof:=ReadStr(fh,sizestr) IF eof<>-1 IF (actpm:=New(SIZEOF picmenu)) IF prevpm=0 THEN picprefslist:=actpm ELSE prevpm.next:=actpm prevpm:=actpm IF StrCmp(sizestr,'#',1) actpm.mx:=readvalue(fh) actpm.my:=readvalue(fh) ELSE StrCopy(tempstr,sizestr,ALL) CopyMem(tempstr,actpm+112,StrLen(tempstr)+1) ENDIF actpm.m1_char:=readvalue(fh) actpm.m2_char:=readvalue(fh) ReadStr(fh,sizestr) ELSE seterror('AllocMem()') ENDIF ENDIF UNTIL (eof=-1) OR error Close(fh) ELSE seterror('Open("ENV:PicM_Workbench.prefs")') ENDIF ENDPROC PROC on_off_menu(mmm,taskname,scr:PTR TO screen) -> przyîâcz/odîâcz strukture Menu (mmm) DEF actwin:PTR TO window -> do wszystkich okien tasku o nazwie (ttt) DEF actnodename[10]:STRING -> (scr) strukrura Screen DEF mojmsgport:PTR TO mp -> dla mmm=0 odîâcza menu od okien DEF mojnode:PTR TO ln DEF mojtask:PTR TO tc DEF actmenu:PTR TO menu actmenu:=mmm actwin:=scr.firstwindow WHILE (actwin<>0) mojmsgport:=actwin.userport mojtask:=mojmsgport.sigtask mojnode:=mojtask.ln StrCopy(actnodename,mojnode.name,ALL) UpperStr(actnodename) IF StrCmp(actnodename,taskname,StrLen(taskname)) IF mmm<>0 SetMenuStrip(actwin,mmm) ELSE actmenu:=actwin.menustrip ClearMenuStrip(actwin) ENDIF ENDIF actwin:=actwin.nextwindow ENDWHILE ENDPROC actmenu -> actmenu struktura Menu PROC readvalue(filehandle) DEF tempstr[20]:STRING DEF value IF ReadStr(filehandle,tempstr)=-1 value:=32 seterror('prefs: item is not complete') ENDIF value:=Val(tempstr) ENDPROC value PROC seterror(tekst) IF error=FALSE THEN StrCopy(errormes,tekst,ALL) error:=TRUE ENDPROC PROC setfont() m_textattr.name:=picfont m_textattr.ysize:=picsizefont m_textattr.style:=0 m_textattr.flags:=FPF_DESIGNED m_textattr2.name:='PicM_WB.font' m_textattr2.ysize:=19 m_textattr2.style:=0 m_textattr2.flags:=FPF_DESIGNED IF diskfontbase=0 THEN diskfontbase:=OpenLibrary('diskfont.library',NIL) IF diskfontbase m_textfont:=OpenDiskFont(m_textattr) IF m_textfont=0 seterror('OpenDiskFont()') ENDIF IF commseq m_textfont2:=OpenDiskFont(m_textattr2) IF m_textfont2=0 seterror('OpenDiskFont(PicM_WB.font/size=19)') ENDIF ENDIF ELSE seterror('OpenLibrary("diskfont.library")') ENDIF ENDPROC PROC restore() DEF actpm:PTR TO picmenu DEF m m:=on_off_menu(0,'WORKBENCH',picwbscr) actpm:=picprefslist WHILE actpm<>0 IF actpm.adres_miwb<>0 CopyMem(actpm+16,actpm.adres_miwb+4,30) CopyMem(actpm+46,actpm.adres_itwb,20) ENDIF actpm:=actpm.next ENDWHILE IF m THEN on_off_menu(m,'WORKBENCH',picwbscr) ENDPROC PROC request(body,gadgets,args) ENDPROC EasyRequestArgs(0,[20,0,0,body,gadgets],0,args)