; $VER: Statements&Functions.asc 1.5 (30.1.1999) James L Boyd ; email - jamesboyd@all-hail.freeserve.co.uk ; Let me know if you find it useful, or if you have any ; corrections or contributions :) ; IMPORTANT!!! Put Blitzlibs:Amigalibs.res into the "Compiler ; Options" window's Resident box before trying any demos!!! .Info . ; FOR AN EASILY READABLE LIST OF STATEMENTS AND FUNCTIONS : ; Use the ShowStats&Funcs program supplied with this file! ; This file contains a whole load of statements and functions ; cut 'n' pasted from various source files by James L Boyd. ; Note that NOT ALL OF THESE ARE BY ME! ; NEW! I've added as many credits as possible. If you wrote ; any of these routines (or know who did), let me know! ; Also, I should point out that some have been modified ; to suit the overall format of this file. ; If anyone recognises any of their own routines here, ; let me know, and I'll put the appropriate credit into ; this file (or remove the function if it's a problem) ! ; Just cut and paste into your programs as you need! ; the dotted lines are there to help you cut the right area! ; Because of the stupid subroutines list at the right of ; the screen (at least in SuperTED 2.24), you can't see ; all of the functions available unless you keep scrolling ; down! .Usage . ; 1) Each call has a demonstration underneath it. ; 2) Remember, the function/statement names are case-sensitive. ; -------------- ; 3) Also, a lot of these require you to have ; blitzlibs:amigalibs.res resident in the Compiler Options ; Residents window. ; 4) Some of them require a currently used screen, or window. ; 5) The easiest way to navigate through this file is to use ; the labels at the right-hand side. However, since Blitz ; stupidly can't scroll to labels further down, get the ; function name you're interested in from the ShowStats&Funcs ; program in the archive, and copy the name into the Find ; facility (Search menu). ; You can test each function or statement by uncommenting the ; function/statement demo you want to try, ONE AT A TIME (you ; MUST re-comment each one before testing another! - unless ; you know what you're doing). ;---------------------------------------------------------------- .STATEMENTS . ;----------------------------------------------------------------- .BFWindow ; Statement : BFWindow { window } ; NEW : Fixed for gimmezerozero windows by Carl Read :) ; Fills a window with a backfill pattern, like this : ; 010101010101010101010101010101010101 ; 101010101010101010101010101010101010 ; 010101010101010101010101010101010101 ; 101010101010101010101010101010101010 ; 010101010101010101010101010101010101 ; 101010101010101010101010101010101010 ; 010101010101010101010101010101010101 ; ...that kind of thing ;) ; Looks all white, like requesters... ; Good when used with WFBox {} - see .WFBox. ; See the end of the statement for how to edit the pattern :) Statement BFWindow{WindoID.w} *Windo.Window = Peek.l(Addr Window(WindoID.w)) USEPATH *Windo \RPort\AreaPtrn = ?BackFill ;Pattern Address \RPort\AreaPtSz = 1 ;use 2 arrays form the ;Pattern Address WLeft.w = \BorderLeft WTop.w = \BorderTop If \Flags AND $400 WLeft - WLeftOff WTop - WTopOff EndIf WWidth.w = \Width - \BorderRight - 1 WHeight.w = \Height - \BorderBottom - 1 ;Put a BackFill in the Window. SetAPen_ \RPort,2 SetDrMd_ \RPort,1 BltPattern_ \RPort,0,WLeft,WTop,WWidth,WHeight,0 \RPort\AreaPtrn = 0 ;Put it back to 0 \RPort\AreaPtSz = 0 ;Put it back to 0 Statement Return BackFill: Dc.w %0101010101010101 ; first line... Dc.w %1010101010101010 ; next line... ; ;%---------------- ...and repeats all down the window... ; These 0's and 1's control the pattern - ; edit them to change the pattern, but : ; BEWARE : Using the wrong number of 0's and 1's WILL ; crash the machine!!!!! ; Use the -'s as a guide :) End Statement ; demo : ; FindScreen 0 ; Window 0,0,0,640,200,$100f,"",1,2 ; BFWindow{0} ; MouseWait:End ;---------------------------------------------------------------- .Draw3dBox ; Statement : Draw3dBox { x, y, width, height, style } ; Draws a 3d box in a window ; note that you do need a window to use this! ; See demo for more. ; **** UPDATED by Nick Clover **** ; Optimised for speed and executable size :) Statement Draw3dBox{ax,ay,Width.l,Height.l,way.b} ax2.l = ax+Width-1:ay2.l = ay+Height-1 SHARED rp.l SetAPen_ rp,2-way:Move_ rp,ax2,ay:Draw_ rp,ax,ay:Draw_ rp,ax,ay2 If way=0 SetAPen_ rp,1:Move_ rp,ax+1,ay2 :Draw_ rp,ax2,ay2 :Draw_ rp,ax2,ay SetAPen_ rp,3:Move_ rp,ax+1,ay2-1:Draw_ rp,ax2-1,ay2-1:Draw_ rp,ax2-1,ay+1 Else SetAPen_ rp,3:Move_ rp,ax2-1,ay+1:Draw_ rp,ax+1,ay+1:Draw_ rp,ax+1,ay2-1 SetAPen_ rp,2:Move_ rp,ax+1,ay2 :Draw_ rp,ax2,ay2 :Draw_ rp,ax2,ay EndIf End Statement ; demo : ; FindScreen 0 ; Window 0,0,0,640,200,$140f,"Click to close...",1,2 ; rp.l=RastPort(0) ; Draw3dBox{10,10,350,150,0} ; try replacing the 0 with 1 for ; an inverse Box... ; MouseWait:End ;----------------------------------------------------------------- .FlashText ; Statement : FlashText { window, x, y, no , text, speed } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; UPDATED by Nick Clover - nick@bauk.freeserve.co.uk ; Now optimised for speed and executable size :) ; Shows flashing text in a window. ; x is the left position, y is the top position, no is the ; number of times to flash, speed is the DELAY ; note that this uses colours 1 and 0 - you'll have to ; alter it for anything else...can't add it as parameters ; due to Blitz's 6-parameter limit in statements! Statement FlashText{win.b,x.w,y.w,no.w,a$,speed.b} rp.l=RastPort(0) strlen=Len(a$) For a=1 To no*2-1 color=1-color SetAPen_ rp,color Move_ rp,x,y Text_ rp,a$,strlen VWait speed Next a SetAPen_ rp,1 Move_ rp,x,y Text_ rp,a$,strlen End Statement ; demo : ; FindScreen 0 ; Window 0,0,0,640,200,$140f,"FlashText Demo",1,2 ; FlashText{0,100,100,5,"Hello,I'm flashing (5 times)!",10} ; End ;----------------------------------------------------------------- .ShowInfo ; Statement : ShowInfo { directory, icon, screen number } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Puts the icon information requester (or replacement like ; SwazInfo/WBInfo) onto the requested screen. ; You supply : ; 1) The directory of the file, ; 2) The file name (IMPORTANT!!! DO NOT add .info onto the end!!!) ; also, the file doesn't have to have its own icon. ; 3) The screen number - therefore, you have to have a screen ; in use, but it can use ANY Intuition screen :) ; NOTE : For some reason, the icon information requester ; still pops up if you give it a non-existent file! Statement ShowInfo {dir$,icon$,skreen.b} *scr.Screen=Peek.l(Addr Screen(skreen)) ; get screen structure for wbinfo_() call *lok.l=Lock_(&dir$,#ACCESS_READ) ; get a lock on the directory for the call If *scr ; make sure we've got a screen structure If *lok ; and a directory lock If WBInfo_(*lok,&icon$,*scr) ; the Icon Info call! Else Request "","Error showing icon information!","Oh..." EndIf UnLock_ *lok ; free our directory lock Else Request "","Couldn't get lock on directory!","Oh..." EndIf Else Request "","Doh!||The programmer has asked for a non-existent screen!","Duh..." EndIf End Statement ; demo : ; WBenchToFront_ : FindScreen 0 ; needed for requester ; ShowInfo {"c:","copy",0} ; End ;----------------------------------------------------------------- .SavePaletteFile ; Statement : SavePaletteFile { bitmap number, filename } ; Author - "Cyanure"? ; Saves the palette from a given bitmap to a file as a ; standard Amiga IFF palette. ; I think you have to use LoadBitMap with the palette ; parameter (or load the palette manually), then call ; this statement. Statement SavePaletteFile {NumberBmap.b,FileName.s} DEFTYPE .b NumberPlanes DEFTYPE .w NumberColors,FSize NumberPlanes=Peek.b(Addr BitMap(NumberBmap)+5) NumberColors=2^NumberPlanes FSize=3*NumberColors+48 ; File size If OpenFile(1,FileName.s)=-1 *pf=AllocMem_(FSize,0) ; Memory for the palette file *pf0=*pf ; Beginning of the palette file address Poke.l *pf,$464f524d ; FORM Poke.l *pf+4,FSize-8 ; Poke.l *pf+8,$494c424d ; ILBM Poke.l *pf+12,$424d4844 ; BMHD Poke.l *pf+16,20 ; Size of the BMHD chunk Poke.l *pf+20,0 ; width and height Poke.l *pf+24,0 ; x and y Poke.l *pf+28,$03020180 ; I don't know why but it works ! Poke.l *pf+32,0 ; transparency and aspect Poke.l *pf+36,0 ; page width and page height Poke.l *pf+40,$434d4150 ; CMAP Poke.l *pf+44,NumberColors*3 ; Size of the CMAP chunk *pf+48 ; Increases the pointer For c=0 To NumberColors-1 Poke.b *pf,AGARed(c) Poke.b *pf+1,AGAGreen(c) Poke.b *pf+2,AGABlue(c) *pf+3 Next c WriteMem 1,*pf0,FSize ; Writes in file #1 FreeMem_ *pf0,FSize CloseFile 1 EndIf End Statement demo : ; NOTE : DO NOT run this demo as it requires specific ; files - you'll have to replace all the filenames with some ; from your own system before running! ; The demo is from the original source by Cyanure. ; WBStartup ; NoCli ; ; I suppose the palette you want to save is one of an open bitmap ; ; So, I open such a bitmap : ; Screen 0,0,0,320,256,8,0,"title",1,2 ; ScreensBitMap 0,0 ; LoadBitMap 0,"art:misc/amilogo.iff",0 ; chooses a bitmap ; LoadPalette 0,"art:misc/amilogo.iff" ; Use Palette 0 ; SavePaletteFile{0,"ram:PaletteStd.col"} ; End ;----------------------------------------------------------------- .WOutline ; Statement : WOutline { x1, y1, x2, y2, hilite, shadow } ; Author : Mark Tiffany ; UPDATED by Nick Clover - nick@bauk.freeserve.co.uk ; Now updated for speed and executable size. ; draws a nice bounding box in a window...useful for fancy ; borders, gadget boxes, etc. ;IMPORTANT NOTE : You must make the call "rp.l=RastPort (window)" ; before calling this function now - this ; is due to Blitz's 6-parameter limit ; in statements :( Statement WOutline{x1.w,y1.w,x2.w,y2.w,hilite.w,shadow.w} SHARED rp.l SetAPen_ rp,hilite Move_ rp,x1,y1:Draw_ rp,x2-1,y1:Draw_ rp,x2-1,y2-1:Draw_ rp,x1,y2-1:Draw_ rp,x1,y1 SetAPen_ rp,shadow Move_ rp,x1+1,y1+1:Draw_ rp,x2,y1+1:Draw_ rp,x2,y2:Draw_ rp,x1+1,y2:Draw_ rp,x1+1,y1+1 End Statement ; demo : ; FindScreen 0 ; Window 0,0,0,640,200,$40f,"",1,2 ; rp.l=RastPort(0) ; ^^^ IMPORTANT!!! MUST call this before WOutline!!! ; WOutline{60,60,170,150,1,2} ; try swapping the 1 and 2 over ; for an inverse box :) ; MouseWait:End ;----------------------------------------------------------------- .WBevel ; Statement : WBevel { x, y, x2, y2, hilite, shadow } ; Author : Mark Tiffany ; UPDATED by Nick Clover - nick@bauk.freeserve.co.uk ; Now updated for speed and executable size. ; draws a nice bevel box in a window...useful for fancy ; borders, gadget boxes, etc. ;IMPORTANT NOTE : You must make the call "rp.l=RastPort (window)" ; before calling this function now - this ; is due to Blitz's 6-parameter limit ; in statements :( Statement WBevel{x1.w,y1.w,x2.w,y2.w,hilite.w,shadow.w} SHARED rp.l SetAPen_ rp,shadow:Move_ rp,x1,y1:Draw_ rp,x2-1,y1:Draw_ rp,x2-1,y2-1:Draw_ rp,x1,y2-1:Draw_ rp,x1,y1 SetAPen_ rp,hilite:Move_ rp,x1+1,y1+1:Draw_ rp,x2,y1+1:Draw_ rp,x2,y2:Draw_ rp,x1+1,y2:Draw_ rp,x1+1,y1+1 SetAPen_ rp,shadow:Move_ rp,x1+2,y2-2:Draw_ rp,x1+2,y1+2:Draw_ rp,x2-2,y1+2 SetAPen_ rp,hilite:Move_ rp,x2-2,y1+2:Draw_ rp,x2-2,y2-2:Draw_ rp,x1+2,y2-2 SetAPen_ rp,shadow:WritePixel_ rp,x2-1,y1+1:WritePixel_ rp,x1+1,y2-1 End Statement ; demo : ; FindScreen 0 ; Window 0,0,0,200,80,$140f,"",1,2 ; rp.l=RastPort(0); IMPORTANT!!! MUST call this first now!!! ; WBevel{10,10,100,50,1,2} ; try swapping the 1 and 2 over ; for an inverse bevel :) ; MouseWait:End .GoNTSC ; Statement : GoNTSC {} ; Blitz's ForceNTSC causes an Enforcer hit - this doesn't :) Statement GoNTSC {} MOVE #0,$dff1dc End Statement ; demo : ; See GoPAL{} ;----------------------------------------------------------------- .GoPAL ; Statement : GoPAL {} ; Blitz's ForcePAL causes an Enforcer hit - this doesn't :) Statement GoPAL {} MOVE #32,$dff1dc End Statement ; demo : ; NOTE that this demo calls GoNTSC {} as well. ; If NTSC ; Request "","Going into PAL mode for two seconds...","OK" ; GoPAL {} ; Delay_100 ; GoNTSC {} ; Else ; Request "","Going into NTSC mode for two seconds...","OK" ; GoNTSC {} ; Delay_100 ; GoPAL {} ; EndIf ; End ;----------------------------------------------------------------- .WindowTitle ; Statement : WindowTitle { window, window title, screen title } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Changes the title of the specified window (and the screen title ; while the window is activated). ; It's safe to supply a wrong window number - no Enforcer ; hits or anything ;) Statement WindowTitle { win.b, windowtitle$, screentitle$ } SetWindowTitles_ Peek.l(Addr Window(win)),&windowtitle$,&screentitle$ End Statement ; demo : ; FindScreen 0 ; Window 0,0,11,640,200,$140f,"I'm gonna change soon!",1,2 ; Delay_ 100 ; WindowTitle {0,"Hello, I've been changed!","Hey, look at me!"} ; MouseWait:End ;----------------------------------------------------------------- .WinCls ; Statement : WinCls { colour } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Same as WCls, but without the "Oops, I've missed the ; top line" bug (see demo). Statement WinCls {col.w} If col>256 Then col=0 ; max value in OS! SetRast_ RastPort (Used Window),col End Statement ; ALTERNATIVE VERSION (only uncomment if the above ; version is commented!) ; Statement : WinCls { window number, colour } ; Statement WinCls { win.b, col.w } ; SetRast_ RastPort (win),col ; End Statement ; this version lets you add the window number - if you ; wanted to clear a load of windows, you'd normally have ; to Activate each one before calling WCls or WinCls{}. ; might come in handy for someone! ; demo : ; FindScreen 0 ; Window 0,0,0,640,200,$140f,"",1,2 ; WCls 1 ; bugged Blitz command :P ; Request "","Oops - look at the top line of the window!||It hasn't turned to colour 1!","Why, you're right..." ; WinCls {0} ; Request "","OK, let's try again!","OK" ; WinCls {1} ; Request "","That's better!","I vow to use WinCls {} from now on!" ; End ;----------------------------------------------------------------- .CleanBorder ; Statement : CleanBorder { window number } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Fixes the window's border's if they've been overdrawn. ; You can check for the borders being messed up by checking ; WaitEvent (or Event) for $4 and then calling this...also, ; if your window gets resized, it can be handy to call this. Statement CleanBorder {win.b} If Peek.l(Addr Window(win)) RefreshWindowFrame_ Peek.l(Addr Window (win)) EndIf End Statement ; demo : ; FindScreen 0 ; Window 0,0,0,400,100,$100f,"",1,2 ; WBox 0,0,400,100,1 ; Delay_25 ; WColour 2,1:WLocate WLeftOff,20:NPrint "Yuk! The borders have been overwritten! " ; Delay_150 ; CleanBorder {0} ; NPrint "...that's better! Click mouse to end..." ; MouseWait:End ;----------------------------------------------------------------- .CtrlC ; Statement : CtrlC {} ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Sets up the program to receive Ctrl-C messages, which are ; sent from either the CLI it's run from, or other programs, ; such as XOpa, or Executive's Commander. ; You MUST call this before calling ReceiveCtrlC {} ! Statement CtrlC {} #SIGBREAKF_CTRL_C=1 ASL 12 End Statement ; demo : see demo for ReceiveCtrlC {} ;----------------------------------------------------------------- .UnlockWindow ; Statement : UnLockWindow { window, lock } ; Unlocks a window locked with the LockWindow {} function. ; IMPORTANT!!!! The "lock" parameter is the value returned ; from LockWindow {} , eg. lock.l=LockWindow {0} ; You supply this value to this statement. Statement UnlockWindow{win.l,lock.l} win=Peek.l(Addr Window(win)) *Exec.Library=Peek.l(4) If *Exec\lib_Version=>39 Delay_ 5 Dim tag.TagItem(0) tag(0)\ti_Tag=#TAG_END SetWindowPointerA_ win,&tag(0) EndIf EndRequest_ lock,win FreeMem_ lock,SizeOf .Requester End Statement ; demo : see demo for LockWindow {} function. ;----------------------------------------------------------------- .HidePointer ; Statement : HidePointer { window } ; Author : Serge Veuglers (I think! - from dark.lha on Aminet) ; Hides the mouse pointer for the specified window. Statement HidePointer {win.w} *wmem.l = ?EmptyPointer SetPointer_ Peek.l(Addr Window(win)), *wmem, 0,0,1,1 Statement Return ; avoids running into next part... ; I have NO IDEA what this next part does, ; but it works, and no Enforcer hits! EmptyPointer: Dcb.w 4,$0 End Statement ;---------------------------------------------------------------- .UsePalette ; Statement : UsePalette { screen, palette } ; Author : Paul Burkey - burkey@bigfoot.com ; Same as Use Palette, but using OS functions (smaller ; executable size). Statement UsePalette{scr.w,pal.w} LoadRGB32_ ViewPort(scr),Peek.l(Addr Palette(pal)) End Statement ; demo : ; FindScreen 0,"Workbench Screen" ; ; WARNING!!! This will screw up your Workbench palette ; ; and I can't be bothered typing stuff to set it back! ; ; You may want to edit this before running ;) ; LoadPalette 0,"Sys:Storage/clickforcolours" ; if Request ("","I'm gonna change the screen colours!","OK|NO!") ; UsePalette {0,0} ; Delay_ 100 ; EndIf ; End ;---------------------------------------------------------------- .ShowPointer ; Statement : ShowPointer { window } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Shows the mouse pointer for the specified window, used ; after calling HidePointer {} statement. Statement ShowPointer {win} ClearPointer_ (Peek.l(Addr Window(win))) End Statement ; demo : ;FindScreen 0 ;Window 0,0,0,350,70,$20140e,"Click "+Chr$(34)+"Pointer Off"+Chr$(34)+"!",1,2 ;GTButton 0,50,10,0,150,30,"Pointer Off",0 ;GTButton 0,51,170,0,150,30,"Pointer On",0 ;AttachGTList 0,0 ;loop ;Select WaitEvent ; Case $40 ; Select GadgetHit ; Case 50 ; HidePointer{0} ; WTitle "Click outside to see pointer!" ; Case 51 ; ShowPointer{0} ; WTitle "Click "+Chr$(34)+"Pointer Off"+Chr$(34)+"!" ; End Select ; Case $200 ; End ;End Select ;Goto loop ;End ;----------------------------------------------------------------- . .FUNCTIONS . ;----------------------------------------------------------------- .CompareDates ; Function : CompareDates { file 1, file 2 } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Compares modification dates of two files, returning : ; -2 - if one or both of the files doesn't exist ; -1 - if first file is older than second file ; 0 - if files are same age ; 1 - if first file is newer than second file Function.b CompareDates {f1$,f2$} Dim dy.l(1),mn.l(1),sc.l(1) For a.b=1 To 2 If a=1 Then f$=f1$ Else f$=f2$ lock.l=Lock_(&f$,#ACCESS_READ) If lock DEFTYPE .FileInfoBlock fib If Examine_(lock, fib) <> 0 *date.DateStamp=&fib\fib_Date dy(a-1)=*date\ds_Days mn(a-1)=*date\ds_Minute sc(a-1)=*date\ds_Tick Else dy(a-1)=-1 ; failed, can't compare EndIf UnLock_ lock Else dy(a-1)=-1 ; file doesn't exist, can't compare EndIf Next a ; compare result.b=0 If dy(0)=-1 OR dy(1)=-1 result=-2 Else ; check days, if same, check mins, if same, check secs... If dy(0)=dy(1) If mn(0)=mn(1) If sc(0)=sc(1) result=0 ; same age! Else If sc(0)>sc(1) Then result=1 Else result=-1 EndIf Else If mn(0)>mn(1) Then result=1 Else result=-1 EndIf Else If dy(0)>dy(1) Then result=1 Else result=-1 EndIf EndIf Function Return result End Function ; demo : ; f1$="SYS:Utilities/Multiview" ; f2$="SYS:Utilities/more" ; result.b=CompareDates {f1$,f2$} ; Select result ; Case -2 ; NPrint "One (or both) of the files doesn't exist!" ; Case -1 ; NPrint f1$," is older than ",f2$,"." ; Case 0 ; NPrint f1$," is the same age as ",f2$,"." ; Case 1 ; NPrint f1$," is newer than ",f2$,"." ; End Select ; MouseWait:End ;----------------------------------------------------------------- .FileTime ; Function : FileTime { filename } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns a string containing the time the file was created. ; Useful with FileDate. Function.s FileTime {f$} lock.l=Lock_(&f$,#ACCESS_READ) If lock DEFTYPE .FileInfoBlock fib If Examine_(lock, fib) <> 0 *date.DateStamp=&fib\fib_Date time.l=*date\ds_Minute ; minutes past midnight hrs.w=time/60 mns.w=time-(hrs*60) time$+Right$("0"+Str$(hrs),2)+":" ; hours time$+Right$("0"+Str$(mns),2)+":" ; minutes time$+Right$("0"+Str$(*date\ds_Tick/50),2) ; seconds Else time$="" EndIf UnLock_ lock Else time$="" EndIf Function Return time$ End Function ; demo : ; FindScreen 0 ; f$="SYS:Utilities/Multiview" ; Request "","File modification time for :||"+f$+" :||"+FileTime{f$},"OK" ; End ;----------------------------------------------------------------- .FileDate ; Function : FileDate { filename } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns "Last modified" date of a file as a string. ; See manual for Date$ and DateFormat entries (page 119 for ; Blitz 2) for formatting options. Function.s FileDate {f$} lock.l=Lock_(&f$,#ACCESS_READ) If lock DEFTYPE .FileInfoBlock fib If Examine_(lock, fib) <> 0 *date.DateStamp=&fib\fib_Date dt$=Date$(*date\ds_Days) Else dt$="" EndIf UnLock_ lock Else dt$="" EndIf Function Return dt$ End Function ; demo : ; f$="SYS:Utilities/Multiview" ; d$=FileDate{f$} ; Request "","Last modification date of :||"+f$+" :||"+d$+".","OK" ; End ;----------------------------------------------------------------- .Exist ; Function : Exist { filename } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; NOTE : This function replaces the IsThere {} function, ; since IsThere {} only told you if the file was there. ; Full replacement for Exists(), but uses OS functions to return ; file size. ; Return values : ; 0 - can't get a lock (read : file isn't there) ; -1 - file is a directory or disk (same as Exists returns) ; -2 - got lock but couldn't get size (Examine_ failed - rare!) ; This will reduce the size of an executable as well as the fact ; that Exists keeps a file locked until the program ends, ; meaning you can't delete it or perform some other operations ; on it : ; eg. This won't delete the file : ; If Exists("SYS:multiview") ; DeleteFile_ "sys:multiview" ; uh-uh - file's ; EndIf ; locked by Exists! ; But this will : ; If Exist {"SYS:multiview"} ; DeleteFile_ "sys:multiview" ; EndIf Function.l Exist {f$} lock.l=Lock_(&f$,#ACCESS_READ) If lock DEFTYPE .FileInfoBlock fib If Examine_(lock, fib) <> 0 If fib\fib_DirEntryType < 0 size=Peek.l(&fib\fib_Size) ; file Else size=-1 ; drawer EndIf Else size=-2 ; failed to examine file! rare occurence! EndIf UnLock_ lock Else size=0 ; failed to lock file (doesn't exist basically)... EndIf Function Return size End Function ; demo : ; f$="SYS:Utilities/Multiview" ; bytes.l=Exist {f$} ; Request "","Size of :||"+f$+"||is "+Str$(bytes)+" bytes.","OK" ; End ;----------------------------------------------------------------- .SetComment ; Function : SetComment { filename, comment } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Tries to write a file comment to the specified file. ; (The comment appears in the Comment section when you look ; at a file's icon using the Icon/Information menu item ; from Workbench.) ; Returns True (-1) if it's successful,False (0) if it fails. Function.l SetComment{fname$,comment$} a.l=SetComment_ (&fname$,&comment$) Function Return a End Function ; demo : ; filename$="ram:t" ; adds a comment to the Ram:T drawer ; If SetComment{filename$,"Hello,I'm a comment!"}=-1 ; Request "","Done it! Now click on the file's icon|and go to the WB Icons/Information menu...","OK" ; Else Request "","Failed to write comment!","Doh!" ; EndIf ; End ;----------------------------------------------------------------- .ReadComment ; Function : ReadComment { filename } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Reads the file comment of the file/drawer you specify. ; Note that you can check for Lock_ and Examine_ failures ; by uncommenting the appropriate lines in the function itself, ; otherwise it just returns "". Function.s ReadComment {f$} lock.l=Lock_(&f$,#ACCESS_READ) If lock DEFTYPE .FileInfoBlock fib If Examine_(lock, fib) <> 0 comment$=Peek$(&fib\fib_Comment) ; Else comment$="Failed to examine file" ; ^ Uncomment if you want to check for failure instead of returning "" EndIf UnLock_ lock ; Else comment$="Lock failure" ; ^ Uncomment if you want to check for failure instead of returning "" EndIf Function Return comment$ End Function ; demo : ; WARNING!!! Demo uses the SetComment {} function above! ; After running, click on the file and choose Information ; from the Workbench menus. ; fl$="RAM:T/" ; file to set/read comment on... ; If SetComment {fl$,"Hello, I'm a comment!"} ; comment$=ReadComment {fl$} ; Request "","Comment for file : ||"+fl$+"||"+Chr$(34)+comment$+Chr$(34),"OK" ; Else Request "","Failed to set comment!","Doh!" ; EndIf ; End ;----------------------------------------------------------------- .WindowW ; Function : WindowW { window } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns width of specified window. Function WindowW {win.b} *win.Window=Peek.l(Addr Window(win)) If *win Function Return *win\Width Else Function Return 0 EndIf End Function ; demo : ; FindScreen 0 ; Window 0,0,0,640,200,$20140f,"",1,2 ; NPrint WindowW {0} ; MouseWait:End ;----------------------------------------------------------------- .WindowH ; Function : WindowH { window } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns height of specified window. Function WindowH {win.b} *win.Window=Peek.l(Addr Window(win)) If *win Function Return *win\Height Else Function Return 0 EndIf End Function ; demo : ; FindScreen 0 ; Window 0,0,0,640,200,$20140f,"",1,2 ; NPrint WindowH {0} ; MouseWait:End ;----------------------------------------------------------------- .WindowFlags ; Function : WindowFlags { window } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns a value containing the window's flag settings. ; Use "If WindowFlags {window} AND *flag*" to check for ; a particular flag, eg. to check window 0 has a drag bar, ; use "If WindowFlags {0} AND $2 Then BeepScreen 0", etc. ; The flags are listed on page 177 of the Blitz Basic 2.1 ; manual (or press Right Amiga + HELP with the cursor on the ; Window command). Function.l WindowFlags {w.b} *win.Window=Peek.l(Addr Window(w)) If *win Function Return *win\Flags Else Function Return 0 EndIf End Function ; demo : ; FindScreen 0 ; Window 0,0,0,640,200,$140f,"",1,2 ; If WindowFlags {0} AND $2 Then BeepScreen 0 ; check for drag bar ; Request "","Window's flag settings :||$"+Hex$(WindowFlags {0}),"OK" ; End ;----------------------------------------------------------------- .WinMouseX ; Function : WinMouseX {} ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns X position of mouse relative to top-left of ; CURRENTLY USED window (same as WMouseX, but smaller exec ; size will result). Function.w WinMouseX {} *win.Window=Peek.l(Addr Window(Used Window)) If *win Function Return *win\_MouseX Else Function Return 0 EndIf End Function ; demo : see demo for WinMouseY{} ;----------------------------------------------------------------- .WinMouseY ; Function : WinMouseY {} ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns Y position of mouse relative to top-left of ; CURRENTLY USED window (same as WMouseY, but smaller exec ; size will result). Function.w WinMouseY {} *win.Window=Peek.l(Addr Window(Used Window)) If *win Function Return *win\_MouseY Else Function Return 0 EndIf End Function ; demo : ; FindScreen 0 ; Window 0,0,0,640,200,$140f,"",1,2 ; Repeat ; VWait ; WTitle "X : "+Str$(WinMouseX {})+" / Y : "+Str$(WinMouseY {}) ; Until Event=$200 ; End ;----------------------------------------------------------------- .SoundTime ; Function : SoundTime { sound number } ; Author : Curt Esser - camge@ix.netcom.com ; Returns number of vblanks taken to play the given ; sound at the default rate. Function.w SoundTime {snd.w} If NTSC=-1 vrate.b=60 Else vrate.b=50 EndIf period.w=Peek.w(Addr Sound (snd)+4) ;get the period from sound object l.l=Peek.w(Addr Sound (snd)+6) ;get the length from sound object If l<0 Then l+64000 ;correct for unsigned value if needed lngth.l=l*2 ;convert to true length of sample frequency.f = 3579440/period ;convert to true frequency delay.w=lngth/(frequency/vrate) ;convert to playing time in VBlanks delay+5 ;add a bit of padding for short samples Function Return delay End Function ; demo : ; ; IMPORTANT!!! Alter filename below to a sample on your disk! ; LoadSound 0,"sys:storage/goodjob.iff" ; NPrint "" ; NPrint "Playing sample..." ; NPrint "" ; Sound 0,15 ; VWait SoundTime{0} ; wait until sample has finished before printing info : ; NPrint "Sound 0 uses ",SoundTime{0}," vblanks..." ; MouseWait:End ;----------------------------------------------------------------- .LockWindow ; Function : LockWindow { window } ; Locks the specified window, puts up busy pointer. ; Unlocked with the UnLockWindow {} statement. ; IMPORTANT!!! You should store the result as a long ; variable, as in the demo - this is needed for the ; UnLockWindow {} statement! Function.l LockWindow {win.l} lock.l=AllocMem_(SizeOf .Requester,1) If lock win=Peek.l(Addr Window(win)) InitRequester_(lock) If Request_(lock,win) *Exec.Library=Peek.l(4) If *Exec\lib_Version=>39 Dim tag.TagItem(1) tag(0)\ti_Tag=#WA_BusyPointer,-1 tag(1)\ti_Tag=#TAG_END SetWindowPointerA_ win,&tag(0) EndIf Else FreeMem_ lock,SizeOf .Requester lock=0 EndIf EndIf Function Return lock End Function ; FindScreen 0 ; Window 0,0,0,640,100,$40f,"Delayed for 2 seconds",1,2 ; GTButton 0,0,0,0,200,10,"Click me!",0 ; AttachGTList 0,0 ; lock.l=LockWindow {0} ; Delay_ 100 ; If lock Then UnlockWindow {0,lock} ; Delay_ 100 ; End ;----------------------------------------------------------------- .WBVersion ; Function : WBVersion {} ; Author : Andreas Falkenhahn - Andreas.Falkenhahn@gmx.de ; Returns version/revision number of user's Workbench. Function WBVersion {} *buf.b=AllocVec_(8,$10001) ver$="Workbench" GetVar_ &ver$,*buf,7,0 Function Return Val(Peek$(*buf)) ; -> version is stored in *buf FreeVec_ *buf End Function ; demo : ; NPrint "Workbench : ",WBVersion {} ; MouseWait:End ;----------------------------------------------------------------- .KSVersion ; Function : KSVersion {} ; Author : Andreas Falkenhahn - Andreas.Falkenhahn@gmx.de ; Returns version/revision number of user's Kickstart. Function KSVersion {} *buf.b=AllocVec_(8,$10001) ver$="Kickstart" GetVar_ &ver$,*buf,7,0 Function Return Val(Peek$(*buf)) ; -> version is stored in *buf FreeVec_ *buf End Function ; demo : ; NPrint "Kickstart : ",KSVersion {} ; MouseWait:End ;----------------------------------------------------------------- .TimerWait ; Function : TimerWait { seconds, microseconds } ; Author : taken from Andrea Doimo's BlitzFAQ website... ; - various authors contributed, so unknown... ; Sets up the timer.device to wait for set amount of ; time in seconds and microseconds (1/1,000,000 secs). ; So a half-second wait would be TimerWait {0,500000}, ; 1.2 seconds would be TimerWait {1,200000}, etc. ; Returned values : ; 0 = No error ; 1 = Failed to open timer.device ; 2 = Failed to open message port ; 3 = Failed to create a timer request ; There's not much you can do if it fails, so just ; use ** If TimerWait {s,m}=0 Then Print "Fail" ** ; or ** dummy.b=TimerWait {s,m} ** or whatever. ; I don't think much can fail though. Function.b TimerWait {sec.l, mic.l} *TimerMP.MsgPort = CreateMsgPort_() If *TimerMP *TimerIO.timerequest = CreateIORequest_ (*TimerMP,SizeOf .timerequest) If *TimerIO err = OpenDevice_ ("timer.device",#UNIT_MICROHZ,*TimerIO,0) If err Then Function Return 1 *TimerIO\tr_node\io_Command = #TR_ADDREQUEST *TimerIO\tr_time\tv_secs = sec *TimerIO\tr_time\tv_micro = mic SendIO_ *TimerIO WaitPort_ *TimerMP Repeat *TimerMsg.Message = GetMsg_(*TimerMP) Until *TimerMsg = 0 CloseDevice_ (*TimerIO) DeleteIORequest_ (*TimerIO) DeleteMsgPort_ (*TimerMP) Function Return 0 Else Function Return 3 EndIf Else Function Return 2 EndIf End Function ; demo : ; NPrint "Counting to five..." ; NPrint "" ; For a=1 To 5 ; ; Wait one second each time : ; If TimerWait {1,0}<>0 Then Request "","Failed!","OK" ; NPrint " ",a ; Next a ; dummy.b=TimerWait {1,0} ; pause for a second... ; End ;----------------------------------------------------------------- .ReceiveCtrlC ; Function : ReceiveCtrlC {} ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Captures Ctrl-C messages sent to the program from either ; the CLI it's run from, or other programs, such as XOpa, ; or Executive's Commander. ; Put it into all loops you want to break. ; You MUST call the CtrlC {} statement first to set things up! Function ReceiveCtrlC {} If #SIGBREAKF_CTRL_C <> 1 ASL 12 Request "","Programmer Error!||Haven't called CtrlC {} !","END":End EndIf If (SetSignal_(0,#SIGBREAKF_CTRL_C) & #SIGBREAKF_CTRL_C) Function Return -1 Else Function Return 0 EndIf End Function ; demo : ; FindScreen 0 ; Window 0,0,0,640,100,$140f,"Hit close gadget or send a Ctrl-C to quit...",1,2 ; CtrlC {} ; set up Ctrl-C reception... ; Repeat ; If ReceiveCtrlC {} Then Request "","Ctrl-C received!","END":End ; VWait ; Until Event=$200 ; End ;----------------------------------------------------------------- .WindowFillScreen ; Function : WindowFillScreen { window number, flags, title } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; A basic function to open a full-screen window, just below the ; title bar, on the CURRENTLY USED screen - should work for ; ANY screen size though. ; You may want to edit parts of the function to suit your ; program, eg DPen, BPen, GadgetList and BitMap parameters ; aren't supplied to this function. Function WindowFillScreen {win.b,flags.l,title$} *sc.Screen=Peek.l(Addr Screen(Used Screen)) If *sc If Peek.l(Addr Window(win)) Function Return 0 Else Window win,0,*sc.Screen\BarHeight+1,*sc.Screen\Width,*sc.Screen\Height-(*sc.Screen\BarHeight+1),flags,title$,1,2 If Peek.l(Addr Window(win))=0 Function Return 0 Else Function Return -1 EndIf EndIf Else Function Return 0 EndIf End Function ; demo : ; WbToScreen 0 ; ; Screen 0,28 ; uncomment to test on another screen... ; If WindowFillScreen {0,$140f,"Hello"}=0 ; Request "","Failed to open window!","OK":End ; EndIf ; Request "","Ta-daaa!||A nice full-screen window!","Amazing..." ; End ;----------------------------------------------------------------- .ScreenMouseX ; Function : ScreenMouseX {} ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns X position of mouse relative to top-left of ; CURRENTLY USED screen (same as SMouseX, but smaller exec ; size will result). Function ScreenMouseX {} *scr.Screen=Peek.l(Addr Screen(Used Screen)) If *scr Function Return *scr\_MouseX Else Function Return 0 EndIf End Function ; demo : see demo for ScreenMouseY{} ;----------------------------------------------------------------- .ScreenMouseY ; Function : ScreenMouseY {} ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns Y position of mouse relative to top-left of ; CURRENTLY USED screen (same as SMouseY, but smaller exec ; size will result). Function ScreenMouseY {} *scr.Screen=Peek.l(Addr Screen(Used Screen)) If *scr Function Return *scr\_MouseY Else Function Return 0 EndIf End Function ; demo : ; NOTE : Uses ScreenMouseX {} too. ; FindScreen 0 ; Window 0,50,50,500,100,$140f,"",1,2 ; While Event<>$200 ; VWait ; WTitle "X : "+Str$(ScreenMouseX{})+" / Y : "+Str$(ScreenMouseY{}) ; Wend ; End ;----------------------------------------------------------------- .WBColours ; Function : WBColours {} ; Returns number of colours in Workbench screen. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk Function.w WBColours {} Function Return 2^WBDepth End Function ; demo : ; NPrint WBColours{} ; MouseWait:End ;----------------------------------------------------------------- .IsScreenActive ; Function : IsScreenActive { screen number } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns True (-1) if screen is active, False (0) if not. ; NOTE : Active DOES NOT necessarily mean the frontmost screen! Function IsScreenActive {scr.b} If Peek.l(Addr Screen(scr)) = ActiveScreen Function Return -1 Else Function Return 0 EndIf End Function ; demo : ; FindScreen 0 ; If IsScreenActive {0} ; Request "","IsScreenActive returned True...","OK" ; Else Request "","IsScreenActive returned False...","OK" ; EndIf ; End ;----------------------------------------------------------------- .ScreenH ; Function : ScreenH { screen number } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Replacement for ScreenHeight, saving around 7k from exec size. ; Returns the height of the specified screen. ; Use ScreenH {Used Screen} if that's convenient to you :) Function ScreenH {sc.b} *SC.Screen=Peek.l(Addr Screen(sc)) If *SC Function Return *SC\Height Else Function Return 0 EndIf End Function ; demo : ; FindScreen 0,"Workbench Screen" ; Request "","Your Workbench screen is "+Str$(ScreenH {0})+" pixels high.","Correct!" ; End ;----------------------------------------------------------------- .ScreenW ; Function : ScreenW { screen number } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Replacement for ScreenWidth, saving around 7k from exec size. ; Returns the width of the specified screen. ; Use ScreenW {Used Screen} if that's convenient to you :) Function ScreenW {sc.b} *SC.Screen=Peek.l(Addr Screen(sc)) If *SC Function Return *SC\Width Else Function Return 0 EndIf End Function ; demo : ; FindScreen 0,"Workbench Screen" ; Request "","Your Workbench screen is "+Str$(ScreenW {0})+" pixels wide.","Correct!" ; End ;----------------------------------------------------------------- .SetProgName ; Function : SetProgName { new program name } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; CLI only :( ; This function gives your CLI program a new DOS name. ; If you look in XOpa, SnoopDOS or similar, you'll see ; that even if you run your program named "MadeUp", it can ; appear in the system with another name completely. ; Useful if your user renames the program file. Function SetProgName {name$} If SetProgramName_ (&name$) Function Return -1 Else Function Return 0 EndIf End Function ; demo : ; If SetProgName {"I'm a little Test Program!"}=0 ; Request "","Failed to set new program name!","OK" ; Else Request "","New program name set!|Go look in XOpa or a similar program!","OK" ; EndIf ; End ;----------------------------------------------------------------- .Name ; Function : Name { old file name, new name for file } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; This function tries to rename a file to the new name, ; returning True (-1) for success, False (0) for failure. Function.b Name {old$,new$} If Rename_ (&old$,&new$) Function Return -1 Else Function Return 0 EndIf End Function ; demo : ; ; IMPORTANT!!! Change the path/file to ones on your system! ; ; Choose unimportant ones to save too much hassle! ; If Name {"Stuff:temp/pic.iff","Stuff:temp/pix.iff"}=0 ; Request "","Couldn't rename file!","OK" ; EndIf ; End ;----------------------------------------------------------------- .Unhook ; Function : Unhook { device: } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; "Unplugs" the specified drive. ; IMPORTANT!!! This function can be very dangerous if you ; don't know what you're doing!!! ; Don't call it on the disk's name, call it on the ; DEVICE name (if you don't know what that means, don't ; mess with it!)...using the disk name will "busy" the disk, ; but won't be able to "reconnect" it (see Hookup{} function) ; because the OS asks you to insert the disk (whereas it won't ; ask for the device). Function.b Unhook {device$} If DeviceName$(device$)=device$ Then Function Return 0 If Inhibit_(&device$, -1) Function Return -1 Else Function Return 0 EndIf End Function ; demo : ; The demo's in the Hookup {} demo section... ;----------------------------------------------------------------- .Hookup ; Function : Hookup { device: } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; "Reconnects" the specified drive, disconnected with ; Unhook {}. ; IMPORTANT!!! This function can be very dangerous if you ; don't know what you're doing!!! ; Don't call it on the disk's name, call it on the ; DEVICE name (if you don't know what that means, don't ; mess with it!)...see Unhook{} function. Function.b Hookup {device$} If Inhibit_(&device$, 0) Function Return -1 Else Function Return 0 EndIf End Function ; demo : ; WARNING!!! Do NOT test until you've saved all work!!! ; NoCli ; dr$="SYS:" ; r$="WARNING!!!||This demo will make your "+dr$+" partition BUSY for a while!||Click on Cancel to Abort!||Click on OK " ; r$+"if all work is saved...||You'll have to reboot if it fails to reconnect the drive!" ; If Request ("",r$,"OK|Cancel")=0 Then End ; If Unhook {dr$} ; Request "","Go and try to access the "+dr$+" drive before|you click on OK...","OK" ; If Hookup {dr$}=0 Then Request "","* Failed! *||Uh-oh...I'd better re-boot!","Reboot":ColdReboot_ ; EndIf ; End ;----------------------------------------------------------------- .GetArg ; Function : GetArg {} ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; CLI only :( ; returns the parameters supplied to a CLI-run program, like ; Par$()...only difference is, that's all you get - the whole ; argument string...could be useful as an exec-size saving ; function if your program only takes one argument (eg a file- ; name, which you could use this for). Function.s GetArg{} *ptr = GetArgStr_() If FromCLI Function Return Peek.s(*ptr) Else Function Return "" EndIf End Function ; demo : ; NOTE - You'll have to compile this into an executable ; and run it from the CLI as " blah-de-blah". ; Print GetArg{} ; End ;----------------------------------------------------------------- .OpenShell ; Function : OpenShell { x, y, width, height, title, flag(s) } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; This function opens a full CLI window for your user to ; do their stuff (deleting/copying files, anything a normal shell ; can do). ; Program flow is halted until the user closes the shell window, ; either by clicking on the close gadget (if available) or by ; typing "endcli". ; See the error codes and demo to check whether the shell ; function was a success. ; You don't really need to check as much as in the demo; ; just check if OpenShell{}=-1 (successful). ; Note that the width and height aren't too important - the ; window will be made to fit the screen if you give parameters ; which are too large. ; I didn't check the freeing of the console memory (Close_()), ; as there's not much you can do if it doesn't free it! Function.b OpenShell {x.w,y.w,w.w,h.w,title$,flag$} win$="CON:"+Str$(x)+"/"+Str$(y)+"/"+Str$(w)+"/"+Str$(h)+"/"+title$+"/"+UCase$(flag$) ; Error codes returned : ; ---------------------- ; -1 = Success. ; 0 = Failed to setup console. ; 1 = Failed to create shell from console. ; 2 = Failed to create shell, failed to close console. ; 3 = Succeeded in creating shell, failed to close console. ; What it checks for : ; -------------------- ; Did it create the console window? ; Did it turn the console window into a shell? ; Did it close the console? ; Combinations of these... ; Possible Flags : ; ---------------- ; (Some of these won't do anything - they are for use on ; non-Shell console windows, eg. information consoles.) ; Flags are separated by a slash / and can be combined... ; ALT - adds a zoom gadget and sets the "zoomed" size : ; Format : ALTx/y/width/height (NOTE - no space ; between ALT and the first number!) ; eg. ALT20/20/300/100 ; Others (these descriptions are pretty much the same as ; Blitz window flags) : ; CLOSE/BACKDROP/INACTIVE/NOBORDER/NOCLOSE/NODEPTH/NODRAG ; NOSIZE/SCREEN/SIMPLE (Default)/SMART/WAIT/AUTO ; NOTES : NOBORDER leaves the right-hand border and part ; of the top for some reason! ; SCREEN - supply the name of the screen to open the window ; on, after the SCREEN keyword...eg. CLOSE/SCREEN MadeupScreen/SMART ; SIMPLE - default : text resizes to fit in shrunken/ ; expanded window. ; SMART - text doesn't resize. ; WAIT - will only close via close gadget or Ctrl-\ ; No use in a Shell window. *fh.l=Open_(&win$,#MODE_READWRITE) If *fh If Execute_ ("",*fh,0)=0 ; failure to create shell : If Close_ (*fh)=0 Function Return 2 ; failed to create shell AND close console Else Function Return 1 ; failed to create shell from console EndIf Else If Close_ (*fh)=0 Function Return 3 ; succeeded in creating shell, failed to close console Else Function Return -1 ; TOTAL SUCCESS :) EndIf EndIf Else Function Return 0 ; failed to setup console EndIf End Function ; demo : ; result.b=OpenShell{0,50,640,100,"Hello, I'm a CLI!","CLOSE/ALT30/30/100/100"} ; Select result ; Case -1 ; error$="Shell function was a success!" ; Case 0 ; error$="Failed to setup console window!" ; Case 1 ; error$="Failed to create shell from console!" ; Case 2 ; error$="Opened console|Failed to create shell|Can't close console!" ; Case 3 ; error$="Succeeded in creating shell|Couldn't close shell window!" ; End Select ; Request "",error$,"OK" ; End ;----------------------------------------------------------------- .Del ; Function : Del { file } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Deletes a file, returning True (-1) for success, False (0) ; for failure to delete. Function.b Del {f$} If DeleteFile_ (&f$) Function Return -1 Else Function Return 0 EndIf End Function ; demo : ; NOTE : Change the filename before running this demo! ; If Del {"RAM:MadeUpFile.iff"} ; Request "","Deleted!","OK" ; Else Request "","Couldn't delete file!","OK" ; EndIf ; End ;----------------------------------------------------------------- .OSAssign ; Function : OSAssign { assign name, path, type } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; This function creates an assign and returns True if ; successful, false if not. ; The parameters are the assign name (eg. "MyAss:"), the ; path which this assign refers to (eg. "Work:Gfx/Pics"), ; and the type of assign - True (-1) for Path, or False (0) ; for a Late assign. ; Path assigns are activated immediately, Late assigns ; only activate when you try to use them (saves clogging ; up file/path requesters for a start :) ; I've called it OSAssign to avoid confusion with the BSS command ; Assign. ; Also, the function checks for the existence of the path ; you specify, since you CAN assign a name to a non-existent ; drawer! It returns False (0) if the path doesn't exist. Function.b OSAssign {name$,path$,PathOrLate.b} If Exists(path$) Select PathOrLate Case 0 ; LATE assign...starts when accessed. If AssignLate_(&name$,&path$) Function Return -1 Else Function Return 0 EndIf Case -1 ; PATH assign...starts immediately. If AssignPath_(&name$,&path$) Function Return -1 Else Function Return 0 EndIf Default Function Return 0 End Select Else Function Return 0 EndIf End Function ; demo : ; NOTE : To remove the assign after testing, go to the CLI and ; type "assign MyAss: REMOVE" (without the quotes!). ; If OSAssign {"MyAss","SYS:C/",-1} ; -1=path assign... ; Request "","Success! MyAss: is assigned to the SYS:C/ drawer!","OK" ; Else Request "","Couldn't assign MyAss: !","OK" ; EndIf ; End ;----------------------------------------------------------------- .Value ; Function : Value { number string } ; Author : Curt Esser - camge@ix.netcom.com ; This function returns correct values ; for very large numbers - Blitz doesn't! Function.l Value {input$} valu.l=0 chars.w=StrToLong_(&input$,&valu) Function Return valu End Function ; demo : ; test$="1087504386" ; NPrint "Blitz's Val : ",Val(test$) ; NPrint "Value{} function : ",Value{test$} ; MouseWait ; End ;---------------------------------------------------------------- .ScreenOpened ; Function : ScreenOpened { screen } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns False (0) if the specified screen doesn't exist. Function ScreenOpened {sc.b} If Peek.l(Addr Screen(sc)) Function Return -1 Else Function Return 0 EndIf End Function ; demo : ; If ScreenOpened{0}=0 Then Request "","Failed to open screen!","Abort!":End ; Window 0,0,0,640,200,$140f,"",1,2 ; MouseWait:End ;----------------------------------------------------------------- .WindowOpened ; Function : WindowOpened { window } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Although it's possible to do this : ; If Window (0,0,0,640,200,$140f,"",1,2)=0 Then End ; That apparently doesn't work on some people's setups, ; hence this function...returns False (0) if the window isn't ; open. Function WindowOpened {win.b} If Peek.l(Addr Window(win)) Function Return -1 Else Function Return 0 EndIf End Function ; demo : ; Screen 0,10 ; Window 0,0,0,641,200,$140f,"",1,2 ; If WindowOpened {0}=0 Then Request "","Failed to open window!","Abort!":End ; MouseWait:End ;----------------------------------------------------------------- .RTReq ; Function : RTReq { title, body text, gadget } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; UPDATE - Curt Esser reported a silly bug in the OpenLibrary_ ; call - FIXED. ; Checks for reqtools.library v38 and uses a reqtools ; requester if it's available, defaulting to the standard ; requester if it's not. ; I never made it use the reqtools positioning parameters, ; as these get patched by the user's own prefs settings ; anyway. Function.b RTReq {title$,body$,gadget$} lib$="reqtools.library" *lib.l=OpenLibrary_(&lib$,38) If *lib CloseLibrary_ *lib body$=Replace$(body$,"|",Chr$(10)) rt.b=RTEZRequest (title$,body$,gadget$) Else rt.b=Request (title$,body$,gadget$) EndIf Function Return rt End Function ; demo : ; If RTReq{"Hello","If you've got reqtools v38+,|I'll be a reqtools requester,|otherwise just a normal one!","OK|Cancel"} ; result.l=RTReq{"Result","You hit OK!","Yep..."} ; Else result.l=RTReq{"Result","You hit Cancel!","Sure did!"} ; EndIf ; End ;----------------------------------------------------------------- .TitleBarHeight ; Function : TitleBarHeight { screen } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns the height of the title bar of the specified ; screen, or false if the screen doesn't exist! Function.w TitleBarHeight{scr.b} If Peek.l(Addr Screen(scr)) *scr.Screen=Peek.l(Addr Screen(scr)) ; get screen info... Function Return *scr\BarHeight+1 Else Function Return 0 EndIf End Function ; demo : ; FindScreen 0 ; Print TitleBarHeight{0} ; MouseWait:End ;----------------------------------------------------------------- .CentreWindowX ; Function : CentreWindowX { width of window } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns x position for window of width "width.w". ; Use it with CentreWindowY {} to centre a window ; both ways in the CURRENTLY USED screen. Function.w CentreWindowX {width.w} x.w=(ScreenWidth/2)-(width/2) Function Return x End Function ; demo : ; See demo for CentreWindowY {} ! ;----------------------------------------------------------------- .CentreWindowY ; Function : CentreWindowY { height of window } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns y position for window of height "height.w". ; Use it with CentreWindowX {} to centre a window ; both ways in the CURRENTLY USED screen. Function.w CentreWindowY {height.w} y.w=(ScreenHeight/2)-(height/2) Function Return y End Function ; demo : ; FindScreen 0 ; w=400:h=180 ; Window 0,CentreWindowX {w},CentreWindowY {h},w,h,$140f,"I'm in the middle!",1,2 ; MouseWait:End ;----------------------------------------------------------------- .ChipSet ; Function : ChipSet {} ; Returns a string according to chipset in the ; Amiga it's run on (OCS/ECS/AGA/AA(!)/Unknown). Function.s ChipSet {} chip.w=Lisa Select chip Case $00 chip$="OCS" Case $F7 chip$="ECS" Case $F8 chip$="AGA" Case $F9 chip$="AA (Prototype)" Default chip$="unknown" End Select Function Return chip$ End Function ; demo : ; Request "","This is an "+ChipSet{}+" Amiga!","OK" ; End ;----------------------------------------------------------------- .WFBox ; Function : WFBox { window, left, width, top, height } ; Clears a False (standard : grey) colour box over a ; filled window. ; Make all parameters "-1" (experiment with other if you want, ; but I never got it figured out). ; Good when used with BFWindow {} - see .BFWindow... Function.b WFBox{WindoID.w,LeftSide.w,BoxWidth.w,TopSide.w,BoxHeight.w} MakeiT.b = 0 *Windo.Window = Peek.l(Addr Window(WindoID)) USEPATH *Windo ;Look to see if option are on LeftSide If LeftSide < -1 ;Not in Use Function Return MakeiT EndIf If LeftSide = -1 WLeft.w = \BorderLeft + 5 ;then use Init Value Else WLeft.w = \BorderLeft + LeftSide ;New Value EndIf If LeftSide >= ( \Width - \BorderRight ) - 1 ;Value too high? MakeiT = 0 ;Do not do it Function Return MakeiT ;return the result EndIf BoxWidth If BoxWidth < -1 OR BoxWidth = 0 Function Return MakeiT EndIf If BoxWidth = -1 WWidth.w = ( \Width - \BorderRight ) - 5 Else WWidth.w = WLeft + BoxWidth EndIf If WWidth >= \Width - \BorderRight Function Return MakeiT EndIf TopSide If TopSide < -1 Function Return MakeiT EndIf If TopSide = -1 WTop.w = \BorderTop + 5 Else WTop.w = \BorderTop + TopSide EndIf If TopSide >= \Height - \BorderBottom MakeiT = 0 Function Return MakeiT EndIf BoxHeight If BoxHeight < -1 OR BoxHeight = 0 Function Return MakeiT EndIf If BoxHeight = -1 WHeight.w = ( \Height - \BorderBottom ) - 25 Else WHeight.w = WTop + BoxHeight EndIf If WHeight.w >= \Height - \BorderBottom MakeiT = 0 Function Return MakeiT EndIf Draw_The_Box SetAPen_ \RPort,0 BltPattern_ \RPort,0,WLeft,WTop,WWidth,WHeight,0 SetAPen_ \RPort,1 Move_ \RPort,WLeft,WHeight Draw_ \RPort,WLeft,WTop Draw_ \RPort,WWidth,WTop SetAPen_ \RPort,2 Draw_ \RPort,WWidth,WHeight Draw_ \RPort,WLeft,WHeight MakeiT = -1 Function Return MakeiT End Function ; demo : ; FindScreen 0 ; Window 0,0,0,640,200,$140e,"",1,2 ; SetRast_ RastPort(0),2 ; ;WCls 2 ; ; Replace the SetRast_ line with "WCls 2" to see ; ; the bug in WCls!Look at the top line of the window. ; ; ...it's still grey! ; a.b=WFBox{0,-1,-1,-1,-1} ; a is 0 if it's failed... ; ; I don't understand the parameters, but -1 for all is nice! ; MouseWait:End ;---------------------------------------------------------------- .StripFile ; Function : StripFile { path & file name } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns the file part of a path & file string,eg from a ; reqtools file requester or an appicon. Function.s StripFile{p$} *fileptr.l = FilePart_(&p$) f$=Peek$(*fileptr) Function Return f$ End Function ; demo : ; MaxLen f$=192 ; needed for RTEZLoadFile ; FindScreen 0 ; same here ; a$=RTEZLoadFile("Select file",f$) ; If a$="" Then End ; Request "","The file part of "+a$+"|is : "+StripFile{a$},"OK" ; End ;----------------------------------------------------------------- .LockReq ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Function : LockReq { title, body, gadget, type } ; Locks calling window,puts up requester - standard Request ; (reqtype=0) or RTEZRequest (reqtype=1) ; RTEZRequest does lock the window normally, but if the window ; is closed during the program (eg. during iconify), then ; re-opened,sometimes the requesters fail to lock! hence this ; function ;) ; Of course,you need to have a screen in use to call either ; Request or RTEZRequest. ; tl$=title ; rq$=body text ; gd$=gadget text (as normal - separate more than one gadget ; with "|",eg "OK|Cancel" ) ; reqtype=0 for Request,1 for RTEZRequest Function.b LockReq{tl$,rq$,gd$,reqtype.b} lock.l=RTLockWindow (Used Window) If reqtype rtrq.b=RTEZRequest (tl$,Replace$(rq$,"|",Chr$(10)),gd$) Else rtrq.b=Request (tl$,rq$,gd$) EndIf If lock RTUnlockWindow Used Window,lock EndIf Function Return rtrq End Function ; demo: ; WBenchToFront_:FindScreen 0 ; Window 0,0,0,640,200,$140f,"LockReq Demo - this window is locked!",1,2 ; CatchDosErrs ; rt.b=LockReq{"Title","Body text","OK|Quit|Cancel",1} ; NPrint "Gadget pressed : ",rt ; NPrint "" ; NPrint "Press mouse button..." ; MouseWait:End ;----------------------------------------------------------------- .ProgsDir ; Function : ProgsDir {} ; Author : Nick Clover - nick@bauk.freeserve.co.uk ; Returns a string with the program's directory. ; IMPORTANT! Only works with compiled executables,as ; Compiling & Running doesn't use a directory (obviously ;) ; **** REPLACEMENT by Nick Clover **** ; Now returns program directory when run from WB as well! ; Cool :) ; UPDATE - renamed to ProgsDir, to keep in line with ProgsName, ; because ProgDir is a Blitz Support Suite command. Function.s ProgsDir{} MaxLen path$=200 NameFromLock_ GetProgramDir_(),&path$,200 path$=Peek$(&path$) Function Return path$ End Function ; demo : ; note that this returns a name only from executables! ; you'll just get a blank string if you run it from Blitz! ; Request "","Path : "+ProgsDir{},"OK" ; End ;----------------------------------------------------------------- .CurrentDir ; Function : CurrentDir {} ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns a string with the current directory name ; only works with CLI-run programs :( Function.s CurrentDir{} *stringbuffer = AllocMem_(255, 0) suc.l=GetCurrentDirName_(*stringbuffer,255) If suc cdirname$=Peek$(*stringbuffer) Function Return cdirname$ Else Request "Info","Couldn't get current directory name!","Oh..." EndIf End Function ; demo : ; a$=CurrentDir{} ; Print a$ ; MouseWait:End ;----------------------------------------------------------------- .ProgsName ; Function : ProgsName {} ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; UPDATED by Nick Clover - nick@bauk.freeserve.co.uk ; Now works when run from WB as well! Means your user can ; rename the program if they wish and you can still find ; your icon's tooltypes or whatever :) ; UPDATED - Curt Esser reported that the name clashes ; with a command in the Blitz Support Suite. ; Now ProgsName instead of ProgName. ; Returns a string with the program's DOS name Function.s ProgsName{} If FromCLI=-1 *stringbuffer = AllocMem_(255, 0) suc.l=GetProgramName_(*stringbuffer,255) If suc pname$=Peek$(*stringbuffer) EndIf Else pname$=Peek$(Peek.l(FindTask_(0)+$B0)+4) EndIf Function Return pname$ End Function ; demo : ; note that this returns a name only from executables! ; you'll just get a blank string if you run it from Blitz! ; a$=ProgsName{} ; Request "","Program name : "+a$,"OK" ; End ;----------------------------------------------------------------- .ParentDir ; Function : ParentDir { directory } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns a string with the parent directory of a given ; directory. ; Only works from CLI-run programs :( Function.s ParentDir{dir$} *lok.l=Lock_(&dir$,#ACCESS_READ) If *lok *newlock.l=ParentDir_(*lok) If *newlock *stringbuffer = AllocMem_(255, 0) n.l=NameFromLock_ (*newlock, *stringbuffer, 255) If n lockname$=Peek$(*stringbuffer) Function Return lockname$ EndIf UnLock_ (*newlock) EndIf UnLock_(*lok) EndIf End Function ; demo : ; d$="Sys:Devs/DosDrivers" ; Print ParentDir{d$} ; MouseWait:End ;---------------------------------------------------------------- .Memory ; Function : Memory { type } ; Author : Carl Read - carl@cybercraft.co.nz ; Returns size of largest block of available memory - ; use these flags (mostly just use $0, $1, $2, $4, $8000) : ; $0 Any type of memory (0) ; $1 Public (1) ; $2 Chip (2) ; $4 Fast (4) ; $100 Local (256) ; $200 DMAable (512) ; $400 KickTags (1024) ; $20000 Largest chunk (131072) ; $80000 Total memory (524288) ; Note that you can add them together, eg. to check for ; largest single block of Chip RAM, you'd use $2|$20000... ; Oh, and you can replace the numbers with the Blitz ; constants - I've just forgotten them all and can't ; be bothered looking ;) Function.l Memory{flag.l} Function Return AvailMem_(flag) End Function ; demo : ; NPrint Memory {$2} ; $100 from the table above is Chip mem... ; MouseWait:End ;---------------------------------------------------------------- .CheckLib ; Function : CheckLib { library, version } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; copied from suggestion by Paul Burkey ;) ; Checks library versions. ; Throw it at the start of your code,then do : ; getit.l=CheckLib {"some.library",version} ; ...where "some.library" is the library you need to check for, ; and version is the version number you need (0 if it doesn't ; matter)... ; It returns True (-1) for success, False (0) for fail...duh... ;) ; NOTE : Don't use subversions for the version number - ; you can only use integers, eg for madeup.library v2.21 ; you would call : ; x = CheckLib {"madeup.library",2} ; Just repeat that call for each library you need. ; Use SnoopDos to see if your program requires a particular ; version,otherwise you can usually just use 0. Function.b CheckLib {lib$,libv.w} *lib.l=OpenLibrary_(&lib$,libv) If *lib CloseLibrary_ *lib Function Return -1 Else Function Return 0 EndIf End Function ; demo : ; lib$="reqtools.library" ; library to check for, ; libv.b=38 ; version number needed. ; If CheckLib {lib$,libv}=0 Then Request "ERROR!","You need "+lib$+" v"+Str$(libv)+"!","Abort":End ; End ;---------------------------------------------------------------- .PixelLen ; Function : PixelLen { text } ; Returns the number of pixels in width required to print ; the requested string. Function.w PixelLen{a$} rp.l=RastPort(0) ; The rastport of the used window. Function Return TextLength_(rp,&a$,Len(a$)) End Function ; demo : ; FindScreen 0 ; If Window (0,0,0,640,200,$40f,"",1,2)=0 Then Request "","Window too wide!","END":End ; ; if the above function fails on your system, just use : ; ; Window 0,0,0,640,200,$40f,"",1,2 ...instead! ; a$="Some Pixels" ; use this text ; pix.w=PixelLen{a$} ; find pixel width of text ; ; print information : ; NPrint "" ; NPrint "PixelLen {"+Chr$(34)+a$+Chr$(34)+"} returns a value of : ",pix ; NPrint "" ; Print " ":WJam 4:NPrint a$ ; NPrint "" ; WJam 0:NPrint "So "+Chr$(34)+a$+Chr$(34)+" is ",pix," pixels wide in this WindowFont." ; NPrint "":NPrint "-----------------------------------------------------------------" ; demo 2 : ; a$="Lots and lots and lots and lots and lots and lots and lots and lots and lots and lots of text" ; ; try taking out a couple of "and lots" to make it fit! ; NPrint "":NPrint a$ ; If PixelLen {a$}>InnerWidth ; NPrint "":NPrint "The string above is too wide!" ; Else NPrint "":NPrint "Yep,that string fits!" ; EndIf ; Repeat ; VWait 5 ; Until Event=$200 ; End ;---------------------------------------------------------------- .StripToDot ; Function : StripToDot { filename } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; I use this in a program to strip file extensions off. ; eg. doing StripToDot{"reqtools.library"} would return ; just "reqtools". ; NOTE : some files will have more than one dot (period) ! Function.s StripToDot{a$} For a.w=Len(a$) To 1 Step -1 If Mid$(a$,a,1)="." Then a$=Left$(a$,a-1):Pop For:Goto senditback ; if it found a dot,puts result into b$,goes to senditback label below Next a senditback Function Return a$ End Function ; demo : ; Print "Enter a string with an extension (eg help.txt) : " ; a$=StripToDot{Edit$(25)} ; NPrint "":Print "New name : ",a$ ; NPrint "":NPrint "Click the mouse to end..." ; MouseWait:End ; demo 2 : ; ; I use it along with StripFile{} to just return ; ; the file part of a path & file (eg "Work:Pics/Amiga.iff" ; ; will be returned as "Amiga". ; a$=StripToDot{ StripFile{"Work:Pics/Amiga.iff"} } ; NPrint a$:MouseWait:End ;---------------------------------------------------------------- .Quoted ; Function : Quoted { text } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Puts quotes around a file name,so that if your user has ; entered a file name containing spaces,it'll still be OK. ; Useful for some file requester returned strings,or appicons. Function.s Quoted{a$} a$=Chr$(34)+a$+Chr$(34) Function Return a$ End Function ; demo : ; Print "Enter a file name containing spaces : " ; f$=Edit$(30) ; NPrint "":NPrint Quoted{f$} ; MouseWait:End ;---------------------------------------------------------------- .CreateDir ; Function : CreateDir { new directory } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Tries to create a new directory. You have to supply the full ; path name of the directory you want to create. ; Returns False (0) for a failure (try doing Exists() on the ; directory you're trying to create - it may already exist. Function.l CreateDir{dir$} *lock.l = CreateDir_(&dir$) If *lock UnLock_ *lock EndIf Function Return *lock End Function ; demo : ; If CreateDir{"Ram:Test"} ; NPrint "New drawer created!" ; Else NPrint "Failed to create new drawer..." ; If Exists ("Ram:Test") Then NPrint "Drawer already exists!" ; EndIf ; End ;---------------------------------------------------------------- .CenterString ; Function : CenterString { text, window } ; Returns cursor x position to use for centering a string ; in a given window, using that window's current font ; Returns True (-1) if the string won't fit. Function.w CenterString{text$,windownum.w} Use Window (windownum) *rp.l=RastPort (windownum) ;find the window's rastport strln.w=Len(text$) ;we need the character count too pixels.w=TextLength_ (*rp,&text$,strln) ;pixel width of the string winspace.w=InnerWidth ;available printing width If pixels-1 ; WLocate x,WTopOff:Print test$ ; Else Request "","String won't fit!","OK" ; EndIf ; MouseWait:End ;---------------------------------------------------------------- .SaveSound ; Function : SaveSound { sound number, filename } ; Author : Curt Esser - camge@ix.netcom.com ; AT LAST! Blitz Basic gets a sample SAVE routine! ; Full credit to Curt Esser for this excellent routine! ; Right, who's gonna make an IFF sample editor?! ; Come on, we've got LoopSound, InitSound, SoundData, PeekSound, ; etc, so it shouldn't be too hard to make it! (I'm too lazy ;) ; UPDATE - demo fixed by Curt - it never checked for a failure ; properly before! Function.b SaveSound{samplenumber.w,saveIFF$} If Peek.l(Addr Sound(samplenumber)) ;make sure sample exists ; Now we read the necessary information into our variables sndstart.l=Peek.l(Addr Sound(samplenumber)) ;start of sample data slen.l=(Peek.w(Addr Sound (samplenumber)+6) AND $FFFF)*2 ;bytes of sample data ; -- the total disk file length less 8 bytes for "FORM" + length: tlen.l=slen+40 ; -- the looping information: loop.l=Peek.l(Addr Sound (samplenumber)+8) ;start of looping part lpln.l=(Peek.w(Addr Sound (samplenumber)+12) AND $FFFF)*2 ;length of loop ones.l=loop-sndstart ;length of 1 shot part cycl.l=32 ;seems to be standard? ; -- the frequency: per.l=(Peek.w(Addr Sound(samplenumber)+4) AND $FFFF) ;the sample period persec.w= 3579440/per ;the actual frequency If WriteFile (0,saveIFF$) error=-1 FileOutput 0 Print "FORM" ;start of IFF header WriteMem 0,&tlen,4 ;total bytes following the header Print "8SVXVHDR" ;8svx sample ID, and start of Voice Header temp.l=20 WriteMem 0,&temp,4 ;bytes in Voice Header chunk WriteMem 0,&ones,4 ;data bytes in 1 shot part temp.l=0 WriteMem 0,&lpln,4 ;for looping (length of loop) WriteMem 0,&cycl,4 ;" " " WriteMem 0,&persec,2 ;frequency of the sample tempb.b=1 WriteMem 0,&tempb,1 ;octaves WriteMem 0,&temp,1 ;compression (we use 0 = not compressed) temp.l=65536 ;volume (full volume) WriteMem 0,&temp,4 Print "BODY" ;start of Body chunk WriteMem 0,&slen,4 ;bytes of actual sample data WriteMem 0,sndstart,slen ;OK, finally! Write the data CloseFile 0 Use Window 0 Else ;DOS error - could not save the file! error=1 EndIf Else error=0 ;sorry, that sample doesn't exist! EndIf Function Return error End Function ; demo : ; ; DO NOT run this demo until you've replaced the sample ; ; names given! ; LoadSound 0,"ram:test.iff"} ; Delay_ 100 ; shouldn't be needed, but just in case...! ; ok.b=SaveSound {0,"ram:copy_of_test.iff"} ; Select ok ;if ok<>-1 an error occurred! ; Case 0 ; Request "","You don't have a sample loaded ","Doh!" ; Case 1 ; Request "","Disk error - sample not saved","OH NO!" ; End Select ; End ;---------------------------------------------------------------- .SendArexx ; Function : SendARexx { arexx command } ; Author : Dave Newton ; Sends a given ARexx command to a given port. ; I'm not gonna pretend to understand ARexx fully, but ; as far as I'm aware, this returns either the "reply ; message" from the port you sent the command to, ; or if an error occurred, an error string. ; Supposedly returns even if you supply a non-existent ; port, so should work just nicely :) ; The demo is from the original source. Function.s SendARexx{comm$} *rport.MsgPort=CreateMsgPort(""):okay$="ERROR:-1" If *rport<>0 *rmsg.RexxMsg=CreateRexxMsg(*rport,"","") If *rmsg<>0 Forbid_ ;must forbid as rexx port could go without replying!!!! If FindPort_("REXX")<>0 SendRexxCommand *rmsg,comm$,#RXCOMM|#RXFF_RESULT|#RXFF_NOIO|#RXFF_STRING Permit_:WaitPort_ *rport:*rmsg=GetMsg_(*rport) ;give os multitasking back as soon as possible If (*rmsg\rm_Result1=0)&(*rmsg\rm_Result2<>0) okay$=Peek$(*rmsg\rm_Result2) Else okay$="ERROR:"+Str$(*rmsg\rm_Result1)+"-"+Str$(*rmsg\rm_Result2) EndIf ClearRexxMsg *rmsg:DeleteRexxMsg *rmsg EndIf Else Permit_ ;give task switching back if no rexx port EndIf DeleteMsgPort *rport EndIf Function Return okay$ End Function ; demo : ; ; NOTE : this demo checks for Multiview's port, ; ; and sends a message to open a new file...so run ; ; multiview first! ; ; You should get a file requester, which loads ; ; a file into the open copy of multiview. ; ; If there's more than one copy of multiview running, ; ; other copies will have names like Multiview.2, Multiview.3, ; ; and so on. ; a$=SendARexx{"Address Multiview.1 OPEN"} ; Print a$ ; ; I don't understand the error codes - this works, but returns ; ; a$ as "Error 0-0" ! ; End ;---------------------------------------------------------------- .ASLFileRequest ; Function : ASLFileRequest { title, path, file, pattern } ; Author : Paul Burkey - burkey@bigfoot.com ; This function uses OS functions to call up the ASL file ; requester. ; You MUST have a screen in use! ; You can configure the size by altering the top,left, ; width and height variables within the function. ; IMPORTANT NOTE!!! You won't see anything different if you're ; using a patch like RTPatch or MCP's Reqtools Patch function! Function.s ASLFileRequest{title$,pathname$,filename$,pat$} *scr.Screen=Peek.l(Addr Screen(Used Screen)) top.w=0 left.w=0 width.w=ScreenWidth/2 ; remove /2 for full-screen requester! ;) height.w=ScreenHeight Dim Tags.TagItem(10) Tags(0)\ti_Tag=#ASLFR_Screen,*scr Tags(1)\ti_Tag=#ASLFR_InitialPattern,&pat$ Tags(2)\ti_Tag=#ASLFR_TitleText,&title$ Tags(3)\ti_Tag=#ASLFR_InitialFile,&filename$ Tags(4)\ti_Tag=#ASLFR_InitialDrawer,&pathname$ Tags(5)\ti_Tag=#ASLFR_InitialLeftEdge,left Tags(6)\ti_Tag=#ASLFR_InitialTopEdge,top Tags(7)\ti_Tag=#ASLFR_InitialWidth,width Tags(8)\ti_Tag=#ASLFR_InitialHeight,height Tags(9)\ti_Tag=#TAG_END,0 *filereq.FileRequester=AllocAslRequest_(#ASL_FileRequest,&Tags(0)) If *filereq ok.l=AslRequest_(*filereq,&Tags(0)) If ok f$=Peek.s(*filereq\fr_Drawer) If f$<>"" Then If Right$(f$,1)<>":" AND Right$(f$,1)<>"/" Then f$=f$+"/" f$=f$+Peek.s(*filereq\fr_File) EndIf FreeAslRequest_(*filereq) EndIf Function Return f$ End Function ; demo : ; FindScreen 0 ; NPrint "You selected: ",ASLFileRequest{"Choose File","s:","shell-startup",""} ; MouseWait ; End ;---------------------------------------------------------------- .Planes2Cols ; Function : Planes2Cols { number of bitplanes } ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk ; Returns the number of colours available ; in the number of bitplanes given. Function.w Planes2Cols {planes.b} colours.w=2^planes Function Return colours End Function ; demo : ; Print "An 8-plane bitmap has ",Planes2Cols {8}," colours." ; MouseWait:End ; demo 2 : ; ; WARNING!!! DO NOT RUN! ; ; This is an example of how it could be used... ; cols.w=Planes2Cols {ILBMDepth} ; how many colours in currently ; ; examined picture? ;---------------------------------------------------------------- .CheckPic ; Function : CheckPic { picture file } ; Author : Curt Esser - camge@ix.netcom.com ; This function tests a picture file and returns a string ; telling you what kind of file it is. ; Handy for avoiding crashes when your user tries to load ; a non-IFF image! ; The returned string will be one of the following : ; "OK" = normal ILBM pic ; "GIF" = GIF pic ; "JPEG" = Jpeg pic ; "HAM" = ILBM/Ham pic ; "ANIM" = Animation ; "24bit" = -1 Colour picture ; "????" = Unrecognized file type ; "NF" = File not found Function.s CheckPic {picpath$} error$="" If ReadFile(0,picpath$) ; read file header FileInput 0 header$ = Inkey$(2000) ; read 2000 bytes CloseFile 0 PopInput If Left$(header$,4)<> "FORM" OR Mid$(header$,9,4) <> "ILBM" ; ^ Checks if it's IFF...if it's not an IFF, do this : If Left$(header$,3)="GIF" Then error$="GIF " If Mid$(header$,7,4)="JFIF" Then error$="JPEG" If Mid$(header$,9,4)="ANIM" Then error$="ANIM" If error$="" Then error$="????" Else ; valid IFF header found! x.w=Instr(header$,"CAMG") ; check if it's a HAM pic If x<>0 a$=Left$(Right$(Hex$(Peek.l(&header$+x+7) AND $88A4),3),1) If a$="8" Then error$="HAM " EndIf x=Instr(header$,"CMAP") ;check for 24 bit pic! If x=0 Then error$="24bit" EndIf If error$="" Then error$="OK" ; yep, it's an IFF file! Else ; couldn't even find the file! error$="NF" EndIf Function Return error$ End Function ; demo : ; ; WARNING!!! You should insert the name of a file on YOUR ; ; system before running this, in the CheckPic{} ; ; part... ; Request "","File format : "+CheckPic{"art:jpegs/santa.jpg"},"OK" ; End ;---------------------------------------------------------------- .PicSafe ; Function : PicSafe { picture file, type, safety } ; Author : Curt Esser - camge@ix.netcom.com ; Checks if there's enough chip memory to load a shape ; or bitmap. ; The function returns a long value : ; 1) True (-1) if you can go ahead and load it ; 2) The number of bytes needed if there's not enough ; See demos... ; The loadtype.b parameter should be : ; 1) 0 if you're testing a bitmap ; 2) 1 if you're testing a shape... ; The safety.l parameter allows you to leave a certain ; amount of memory (bytes) as a safety margin (I'd use ; at least 50000 normally)...this is the bare minimum of ; chip mem to leave available after loading the picture. Function.l PicSafe{picpath$,loadtype.b,safety.l} ILBMInfo picpath$ ;read the pictures size information picDepth.w=ILBMDepth picDepth + loadtype ;a shape needs an extra bitplane picHeight.w=ILBMHeight picWidth.w=ILBMWidth planemem.l=picHeight*picWidth/8 ;bytes needed for 1 bitplane of this pic totalmem.l=planemem*picDepth ;total bytes needed for loading If AvailMem_ (131074)>totalmem+safety Then ok.l=-1 Else ok=totalmem ; you can replace 131074 with #MEMF_CHIP|#MEMF_LARGEST ; if you have Blitzlibs:amigalibs.res in Compiler Options... Function Return ok End Function ; demo : ; ; WARNING!!! You should insert the name of a file on YOUR ; ; system before trying to run this! ; result.l=PicSafe{"art:misc/santa.iff",0,50000} ; ; the above call uses 0 to check a bitmap, and 50000 bytes ; ; of safety memory. ; If result=-1 ; Request "","OK to load picture!","OK" ; Else Request "","Not enough chip memory to load picture!|Needs "+Str$(a)+" bytes!","Abort!" ; EndIf ; End ; demo 2 : ; ; DON'T RUN THIS!!! Just an alternative way of using it. ; pic$="art:misc/santa.iff" ; If PicSafe{pic$}=-1 Then LoadBitMap 0,pic$,0 ; MouseWait:End ;---------------------------------------------------------------- .SoundSafe ; Function : SoundSafe { sound file, safety } ; checks a sound sample : ; 1) To see if it's really an IFF sample ; 2) To check there's enough memory to load it ; The safety.l parameter is the number of bytes of safety ; margin to add on...ie the bare minimum of chip mem to leave ; available after loading the sound. I'd use about 50000 ; normally. ; Returns a long value depending on the results : ; 1) True (-1) if it's OK to load the sample ; 2) the number of bytes needed if chip memory's too low ; 3) False (0) if it's not an IFF sample ; 4) 1 if it's not found...bit hacky, but pretty safe! ; see demos... Function.l SoundSafe {soundpath$,safety.l} If ReadFile(0,soundpath$) ; check file header FileInput 0 header$ = Inkey$(12) ; read 12 bytes CloseFile 0 PopInput If Left$(header$,4)="FORM" AND Right$(header$,4)="8SVX" ;valid sample, now check chip memory chipmem.l=FileSize(soundpath$) ; memory needed If AvailMem_ (131074)>chipmem+safety Then ok.l=-1 Else ok=chipmem Else ok=0 ; not an IFF sample! EndIf Else ok=1 ; not found! EndIf Function Return ok End Function ; demo : ; ; NOTE that you need to change the filename to one on your ; ; own system! ; result.l=SoundSafe{"sys:storage/goodjob.iff",50000} ; ; the above call uses 50000 bytes of safety margin. ; Select result ; Case -1 ; message$="OK to load sound!" ; Case 0 ; message$="Not an IFF sample!" ; Case 1 ; message$="Not found!" ; Default ; message$="Not enough memory - need "+Str$(result)+" bytes!" ; End Select ; Request "",message$,"OK" ; End ; demo 2 : ; ; quick call! NOTE - change the filename to one ; ; on your system! ; If SoundSafe{"sys:storage/goodjob.iff",50000}=-1 ; LoadSound 0,"sys:storage/goodjob.iff" ; Else End ; EndIf ; MouseWait:End ;---------------------------------------------------------------- Request "statements&functions.bb2","You can't just run this!","Oh...":End ; just in case ;) . .USEFUL_STUFF . ;----------- BEGINNING of Carl's WBFONT ROUTINE ----------------- ; Reading the Workbench font prefs file... ; Author : Carl Read - carl@cybercraft.co.nz ; This is cut straight out of a demo by Carl Read,and requires ; a little more effort to cut 'n' paste into your programs : ; 1) Put the FindFont{} function at the top of your source, ; 2) Put the "LoadFile" subroutine OUT OF THE MAIN LOOP of ; your program,so you don't accidentally run into it! ; * * * * * * ^^ That's IMPORTANT!!!!! ^^ * * * * * * * ; 3) Paste in the "ReadFonts" routine to get the Workbench ; fonts information (see "demo"). ; I've left it uncommented,as it would be a bit of a pain ; to have to uncomment it all to paste it in ;) ; Over to Carl ;) ; This function searches for a font name in a string and will ; return a pointer to it (in the string) if found, else it'll ; return False (0). If found fontName$ will hold the font ; name and fontSize its size. Function.l FindFont{fontPrefs$,startPos.l} SHARED fontName$,fontSize fontName$="":fontSize=0 fontPointer.l=Instr(fontPrefs$,"FONT",startPos) If fontPointer For fontName.l=fontPointer+36 To Len(fontPrefs$) a$=Mid$(fontPrefs$,fontName,1) If Asc(a$) fontName$+a$ Else If Exists("FONTS:"+fontName$) fontSize=Cvi(Mid$(fontPrefs$,fontPointer+32,2)) fontPointer+36 EndIf fontName=Len(fontPrefs$) EndIf Next EndIf Function Return fontPointer End Function ;---------------------------------------------------------------- ReadFonts ; Get user-defined fonts if they exist. fi$="ENV:sys/font.prefs":fiLen.l=Exists(fi$) If fiLen ; Load in WB3 (I think) font names. (1 file.) Gosub LoadFile Else ; Load in WB2 (I think) fonts names. (3 files.) fi$="ENV:sys/wbfont.prefs":fiLen.l=Exists(fi$) If fiLen Then Gosub LoadFile ; Icon font. fi$="ENV:sys/sysfont.prefs":fiLen.l=Exists(fi$) If fiLen Then Gosub LoadFile ; System font. fi$="ENV:sys/screenfont.prefs":fiLen.l=Exists(fi$) If fiLen Then Gosub LoadFile ; Screen font. EndIf If fontPrefs$<>"" fontPointer.l=FindFont{fontPrefs$,1} If fontPointer iconFont$=fontName$:iconFontSize=fontSize EndIf If fontPointer fontPointer.l=FindFont{fontPrefs$,fontPointer} If fontPointer systemFont$=fontName$:systemFontSize=fontSize EndIf EndIf If fontPointer fontPointer.l=FindFont{fontPrefs$,fontPointer} If fontPointer screenFont$=fontName$:screenFontSize=fontSize EndIf EndIf EndIf ;---------------------------------------------------------------- ; I've left this demo activated,to avoid having to comment ; out the LoadFile part of this routine below (cos YOU'D have ; to uncomment it all - see,I care! no,really.... ;) ; demo : ; To load the fonts in use by Workbench : LoadFont 0,iconFont$,iconFontSize LoadFont 1,systemFont$,systemFontSize LoadFont 2,screenFont$,screenFontSize info$="Icon font : "+iconFont$+", Size : "+Str$(iconFontSize) info$=info$+"|System font : "+systemFont$+", Size : "+Str$(systemFontSize) info$=info$+"|Screen font : "+screenFont$+", Size : "+Str$(screenFontSize) Request "",info$,"Cool" End ;---------------------------------------------------------------- LoadFile ; this is the subroutine called by the "ReadFonts" routine : ; This routine adds to the string fontPrefs$ the file fi$ of ; length fiLen. err=0 SetErr:err=-1:End SetErr If err=0 If ReadFile(0,fi$) FileInput 0 fontPrefs$+Inkey$(fiLen) EndIf EndIf CloseFile 0 DefaultInput ClrErr Return ;------------ END of Carl's WBFONT ROUTINE ---------------------- ; End of file :)