home *** CD-ROM | disk | FTP | other *** search
/ Dream 57 / Amiga_Dream_57.iso / Amiga / Programmation / Basic / Blitz / StatsFuncs.lha / StatsFuncs / statements&functions.asc next >
Encoding:
Text File  |  1998-11-08  |  21.4 KB  |  957 lines
  1. ; email - jamesboyd@velvety.demon.co.uk
  2.  
  3. ; DON'T JUST TRY TO RUN THIS!
  4.  
  5. .Info
  6. .
  7.   ; this file contains a whole load of statements and functions
  8.   ; cut 'n' pasted from various source files by james l boyd.
  9.   ; note that NOT ALL OF THESE ARE BY ME!
  10.  
  11.   ; just cut and paste into your programs as you need!
  12.   ; the dotted lines are there to help you cut the right area!
  13.  
  14. ; NOTES
  15.  
  16. ; 1) each call has a demonstration underneath it...
  17.  
  18. ; 2) remember,the function/statement names are case-sensitive.
  19.  
  20. ; 3) also,some of these require you to have
  21. ;    blitzlibs:amigalibs.res resident in
  22. ;    the Compiler Options...
  23.  
  24. ; 4) some of them require a currently used screen,or window...
  25.  
  26. ; you can test each function or statement by uncommenting the
  27. ; function/statement demo you want to try,ONE AT A TIME (you
  28. ; MUST re-comment each one before testing another! - unless
  29. ; you know what you're doing)
  30.  
  31. ;----------------------------------------------------------------
  32.  
  33. .Beginners
  34. .
  35. ; B E G I N N E R S !
  36.  
  37.   ; if you don't know how to use statements and functions,
  38.   ; it's easy!
  39.  
  40.   ; 1) Cut out the function or statement you want to use,from :
  41.  
  42.   ;     Function...
  43.   ;     ------to------
  44.   ;     End Function
  45.  
  46.   ;     or
  47.  
  48.   ;     Statement...
  49.   ;     ------to------
  50.   ;     End Statement
  51.  
  52.   ; 2) Paste it into the TOP of your source code (or anywhere,
  53.   ;    as long as you DON'T TRY AND CALL IT BEFORE THE PROGRAM
  54.   ;    REACHES IT!)
  55.  
  56.   ; 3) Look at the demo for each function/statement to see
  57.   ;    how to use it...
  58.  
  59. ;----------------------------------------------------------------
  60.  
  61. .STATEMENTS
  62. .
  63. ;-----------------------------------------------------------------
  64.  
  65. .BFWindow
  66.  
  67. ; statement : BFWindow{}
  68.  
  69. ; fills a window with a backfill pattern,like this :
  70.  
  71. ;  010101010101010101010101010101010101
  72. ;  101010101010101010101010101010101010
  73. ;  010101010101010101010101010101010101
  74. ;  101010101010101010101010101010101010
  75. ;  010101010101010101010101010101010101
  76. ;  101010101010101010101010101010101010
  77. ;  010101010101010101010101010101010101
  78.  
  79. ; that kind of thing ;) looks all white,like requesters...
  80. ; note that it needs a non-GIMMEZEROZERO window,or it'll be
  81. ; offset (I'm not trying to figure this statement out ;)
  82.  
  83. ; good when used with WFBox {} - see .WFBox...
  84.  
  85. Statement BFWindow{WindoID.w}
  86.  
  87. *Windo.Window = Peek.l(Addr Window(WindoID.w))
  88. USEPATH *Windo
  89.    \RPort\AreaPtrn = ?BackFill                           ;Pattern Address
  90.    \RPort\AreaPtSz = 1                                   ;use 2 arrays form the
  91.                                                          ;Pattern Address
  92.    WLeft.w    = \BorderLeft
  93.    WTop.w     = \BorderTop
  94.    WWidth.w   = \Width - \BorderRight - 1
  95.    WHeight.w  = \Height - \BorderBottom - 1
  96.  
  97. ;Put a BackFill in the Window.
  98.    SetAPen_ \RPort,2
  99.    SetDrMd_ \RPort,1
  100.    BltPattern_ \RPort,0,WLeft,WTop,WWidth,WHeight,0
  101.  
  102.    \RPort\AreaPtrn = 0                                   ;Put it back to 0
  103.    \RPort\AreaPtSz = 0                                   ;Put it back to 0
  104.  
  105. Statement Return
  106. BackFill: Dc.w $5555, $AAAA
  107. End Statement
  108.  
  109. ; demo :
  110.  
  111. ; FindScreen 0
  112. ; Window 0,0,0,640,200,$100f,"",1,2
  113. ; BFWindow{0}
  114. ; MouseWait:End
  115.  
  116. .Draw3dBox
  117.  
  118. ; statement : Draw3dBox{}
  119.  
  120. ; draws a 3d box in a window
  121. ; note that you do need a window to use this!
  122. ; see demo for more...
  123.  
  124. Statement Draw3dBox{ax,ay,Width.l,Height.l,way.b}
  125.             ax2.l = (ax+Width)-1:ay2.l = (ay+Height)-1
  126.             If way=0
  127.                Wline ax2,ay,ax,ay,ax,ay2,2
  128.                Wline ax+1,ay2,ax2,ay2,ax2,ay,1
  129.                Wline ax+1,ay2-1,ax2-1,ay2-1,ax2-1,ay+1,3
  130.             Else
  131.                Wline ax2,ay,ax,ay,ax,ay2,1
  132.                Wline ax2-1,ay+1,ax+1,ay+1,ax+1,ay2-1,3
  133.  
  134.                Wline ax+1,ay2,ax2,ay2,ax2,ay,2
  135.             EndIf
  136. End Statement
  137.  
  138. ; demo :
  139.  
  140. ; FindScreen 0
  141. ; Window 0,0,0,640,200,$140f,"Hello",1,2
  142. ; Draw3dBox{10,10,350,150,1} ; try replacing the 1 with 0 for
  143. ;                              an inverse box...
  144. ; MouseWait:End
  145.  
  146. ;-----------------------------------------------------------------
  147.  
  148. .FlashText
  149.  
  150. ; statement : FlashText{}
  151.  
  152. ; shows flashing text - needs a window!
  153. ; x is the left position,y is the top position,no is the
  154. ; number of times to flash,a$ is the text,speed is the DELAY
  155.  
  156. Statement FlashText{x.w,y.w,no.w,a$,speed.b}
  157.  
  158. For a.b=1 To no-1
  159. WColour 1
  160. WLocate x,y:Print a$
  161. VWait speed
  162. WColour 0
  163. WLocate x,y:Print a$
  164. VWait speed
  165. Next a
  166.  
  167. WColour 1
  168. WLocate x,y:Print a$
  169.  
  170. End Statement
  171.  
  172. ; demo :
  173.  
  174. ; FindScreen 0
  175. ; Window 0,0,0,640,200,$140f,"FlashText Demo",1,2
  176.  
  177. ; FlashText{100,100,10,"Hello,I'm flashing!",2}
  178.  
  179. ; End
  180.  
  181. ;-----------------------------------------------------------------
  182. .
  183. .FUNCTIONS
  184. .
  185. ;-----------------------------------------------------------------
  186.  
  187. .WFBox
  188.  
  189. ; function : WFBox{}
  190.  
  191. ; clears a 0 (standard : grey) colour box over a filled window...
  192. ; make all parameters "-1" (experiment with other if you want,
  193. ; but I never got it figured out)...
  194.  
  195. ; good when used with BFWindow {} - see .BFWindow...
  196.  
  197. Function.b WFBox{WindoID.w,LeftSide.w,BoxWidth.w,TopSide.w,BoxHeight.w}
  198.  
  199. MakeiT.b = False
  200.  
  201. *Windo.Window = Peek.l(Addr Window(WindoID))
  202.  
  203. USEPATH *Windo
  204. ;Look to see if option are on
  205. LeftSide
  206.    If LeftSide < -1                               ;Not in Use
  207.       Function Return MakeiT
  208.    EndIf
  209.  
  210.    If LeftSide = -1
  211.       WLeft.w  = \BorderLeft + 5                  ;then use Init Value
  212.    Else
  213.       WLeft.w  = \BorderLeft + LeftSide             ;New Value
  214.    EndIf
  215.  
  216.    If LeftSide >=  ( \Width - \BorderRight ) - 1   ;Value too high?
  217.       MakeiT = False                               ;Do not do it
  218.       Function Return MakeiT                       ;return the result
  219.    EndIf
  220.  
  221. BoxWidth
  222.    If BoxWidth < -1 OR BoxWidth = 0
  223.       Function Return MakeiT
  224.    EndIf
  225.  
  226.    If BoxWidth = -1
  227.       WWidth.w  = ( \Width - \BorderRight ) - 5
  228.    Else
  229.       WWidth.w  = WLeft + BoxWidth
  230.    EndIf
  231.  
  232.    If WWidth >= \Width - \BorderRight
  233.       Function Return MakeiT
  234.    EndIf
  235.  
  236. TopSide
  237.    If TopSide < -1
  238.       Function Return MakeiT
  239.    EndIf
  240.  
  241.    If TopSide = -1
  242.       WTop.w  = \BorderTop + 5
  243.    Else
  244.       WTop.w  = \BorderTop + TopSide
  245.    EndIf
  246.  
  247.    If TopSide >=  \Height - \BorderBottom
  248.       MakeiT = False
  249.       Function Return MakeiT
  250.   EndIf
  251.  
  252.  
  253. BoxHeight
  254.    If BoxHeight < -1  OR BoxHeight = 0
  255.       Function Return MakeiT
  256.    EndIf
  257.  
  258.    If BoxHeight = -1
  259.       WHeight.w = ( \Height - \BorderBottom ) - 25
  260.    Else
  261.       WHeight.w = WTop + BoxHeight
  262.    EndIf
  263.  
  264.    If WHeight.w >= \Height - \BorderBottom
  265.       MakeiT = False
  266.       Function Return MakeiT
  267.    EndIf
  268.  
  269. Draw_The_Box
  270.    SetAPen_ \RPort,0
  271.    BltPattern_ \RPort,0,WLeft,WTop,WWidth,WHeight,0
  272.    SetAPen_ \RPort,1
  273.    Move_ \RPort,WLeft,WHeight
  274.    Draw_ \RPort,WLeft,WTop
  275.    Draw_ \RPort,WWidth,WTop
  276.    SetAPen_ \RPort,2
  277.    Draw_ \RPort,WWidth,WHeight
  278.    Draw_ \RPort,WLeft,WHeight
  279.    MakeiT = True
  280.  
  281. Function Return MakeiT
  282. End Function
  283.  
  284. ; demo :
  285.  
  286. ; FindScreen 0
  287. ; Window 0,0,0,640,200,$140e,"",1,2
  288.  
  289. ; SetRast_ RastPort(0),2
  290. ; ;WCls 2
  291.  
  292. ;  ; Replace the SetRast_ line with "WCls 2" to see
  293. ;  ; the bug in WCls!Look at the top line of the window...
  294. ;  ; ...it's still grey!
  295.  
  296. ; a.b=WFBox{0,-1,-1,-1,-1} ; a is False if it's failed...
  297.  
  298. ;  ; I don't understand the parameters,but -1 for all is nice!
  299.  
  300. ; MouseWait:End
  301.  
  302. ;----------------------------------------------------------------
  303.  
  304. .StripFile
  305.  
  306. ; function : StripFile{}
  307.  
  308. ; returns the file part of a path & file string,eg from a
  309. ; reqtools file requester or an appicon...
  310.  
  311. Function$ StripFile{p$}
  312.  
  313. *fileptr.l = FilePart_(&p$)
  314. f$=Peek$(*fileptr)
  315.  
  316. Function Return f$
  317. End Function
  318.  
  319. ; demo :
  320.  
  321. ; MaxLen f$=192 ; needed for RTEZLoadFile
  322. ; FindScreen 0  ; same here
  323.  
  324. ; a$=RTEZLoadFile("Select file",f$)
  325. ; If a$="" Then End
  326.  
  327. ; Request "","The file part of "+a$+"|is : "+StripFile{a$},"OK"
  328. ; End
  329.  
  330. ;-----------------------------------------------------------------
  331.  
  332. .LockReq
  333.  
  334. ; function : LockReq{}
  335.  
  336. ; locks calling window,puts up requester - standard Request
  337. ; (reqtype=0) or RTEZRequest (reqtype=1)
  338.  
  339. ; RTEZRequest does lock the window normally,but if the window
  340. ; is closed during the program,then re-opened,sometimes the
  341. ; requesters fail to lock! hence this function ;)
  342.  
  343. ; of course,you need to have a screen in use to call either
  344. ; Request or RTEZRequest...
  345.  
  346. ; tl$=title
  347. ; rq$=body text
  348. ; gd$=gadget text (as normal - separate more than one gadget
  349. ;                  with "|",eg "OK|Cancel" )
  350. ; reqtype=0 for Request,1 for RTEZRequest
  351.  
  352. Function.l LockReq{tl$,rq$,gd$,reqtype.b}
  353.  
  354. lock.l=RTLockWindow (Used Window)
  355.  
  356. If reqtype
  357.   rtrq.l=RTEZRequest (tl$,Replace$(rq$,"|",Chr$(10)),gd$)
  358. Else rtrq.l=Request (tl$,rq$,gd$)
  359. EndIf
  360.  
  361. If lock
  362.   RTUnlockWindow Used Window,lock
  363. EndIf
  364.  
  365. Function Return rtrq
  366. End Function
  367.  
  368. ; demo:
  369.  
  370. ; WBenchToFront_:FindScreen 0
  371. ; Window 0,0,0,640,200,$140f,"LockReq Demo - this window is locked!",1,2
  372. ; CatchDosErrs
  373. ; rt.l=LockReq{"Title","Body text","OK|Quit|Cancel",1}
  374. ; Print "Gadget pressed : ",rt
  375. ; MouseWait:End
  376.  
  377. ;-----------------------------------------------------------------
  378.  
  379. .GTGetStr
  380.  
  381. ; function : GTGetStr{}
  382.  
  383. ; use this to get the contents of a string gadget - works
  384. ; on WBs < 3.0 too!
  385.  
  386. Function.s GTGetStr{lst.w, gdt.w}
  387.  
  388.   *gad.Gadget = GTGadPtr(lst, gdt)
  389.   *si.StringInfo = *gad\SpecialInfo
  390.   a$= Peek$(*si\_Buffer)
  391.   Function Return a$
  392. End Function
  393.  
  394. ; demo :
  395.  
  396. ; FindScreen 0
  397. ; Window 0,0,0,180,60,$140a,"<- Click to End",1,2
  398. ; GTString 0,51,35-WLeftOff,5-WTopOff,100,20,"...and press Enter!",$8,50
  399. ; AttachGTList 0,0
  400.  
  401. ; GTSetString 0,51,"Type here!"
  402.  
  403. ; loop
  404.  
  405. ; Select WaitEvent
  406. ;   Case $200
  407. ;     End
  408. ;   Case $40
  409. ;     r$=GTGetStr{0,51}
  410. ;               ^ ^
  411. ;               | |
  412. ;               | l gadget number
  413. ;               |
  414. ;               l gadget List
  415.  
  416. ;     Request "Info","The gadget says : "+r$,"OK"
  417. ; End Select
  418.  
  419. ; Goto loop
  420.  
  421. ;-----------------------------------------------------------------
  422.  
  423. .GTGetInt
  424.  
  425. ; function : GTGetInt{}
  426.  
  427. ; ; use this to get the contents of an integer gadget - works
  428. ; on WBs < 3.0 too!
  429.  
  430. Function.l GTGetInt{lst.w, gdt.w}
  431.   *gad.Gadget = GTGadPtr(lst, gdt)
  432.   *si.StringInfo = *gad\SpecialInfo
  433.   a.l = *si\LongInt
  434.   Function Return a
  435. End Function
  436.  
  437. ; demo :
  438.  
  439. ; FindScreen 0
  440. ; Window 0,0,0,180,60,$140a,"<- Click to End",1,2
  441. ; GTInteger 0,51,50-WLeftOff,20-WTopOff,70,20,"Enter a number :",$4,0
  442. ; AttachGTList 0,0
  443.  
  444. ; loop
  445.  
  446. ; Select WaitEvent
  447. ;   Case $200
  448. ;     End
  449. ;   Case $40
  450. ;     number.l=GTGetInt{0,51}
  451. ;                       ^ ^
  452. ;                       | |
  453. ;                       | l gadget number
  454. ;                       |
  455. ;                       l gadget list
  456.  
  457. ;     Request "Info","The gadget says : "+Str$(number),"OK"
  458. ; End Select
  459.  
  460. ; Goto loop
  461.  
  462. ;-----------------------------------------------------------------
  463.  
  464. .ProgDir
  465.  
  466. ; function : ProgDir{}
  467.  
  468. ; returns a string with the program's directory.
  469.  
  470. ; IMPORTANT! Only works with compiled executables,as
  471. ; Compiling & Running doesn't use a directory (obviously ;)
  472.  
  473. ; only work with CLI-run programs :(
  474.  
  475. Function$ ProgDir{}
  476.  
  477. lok.l=GetProgramDir_()
  478.  
  479. If lok
  480.   *stringbuffer = AllocMem_(255, 0)
  481.   n.l=NameFromLock_ (lok, *stringbuffer, 255)
  482.  
  483. If n
  484.   lockname$ = Peek$(*stringbuffer)
  485.   Function Return lockname$
  486.   Else Request "Info","Couldn't get directory name!","Oh..."
  487. EndIf
  488.  
  489. UnLock_(lok)
  490.  
  491.   Else Request "Info","Error locking directory!","Oh..."
  492. EndIf
  493.  
  494. End Function
  495.  
  496. ; demo :
  497.  
  498. ; a$=ProgDir{}
  499.  
  500. ; Print a$
  501. ; MouseWait:End
  502.  
  503. ;-----------------------------------------------------------------
  504.  
  505. .CurrentDir
  506.  
  507. ; function : CurrentDir{}
  508.  
  509. ; returns a string with the current directory name
  510. ; only work with CLI-run programs :(
  511.  
  512. Function$ CurrentDir{}
  513.  
  514. *stringbuffer = AllocMem_(255, 0)
  515. suc.l=GetCurrentDirName_(*stringbuffer,255)
  516.  
  517. If suc
  518.   cdirname$=Peek$(*stringbuffer)
  519.   Function Return cdirname$
  520.   Else Request "Info","Couldn't get current directory name!","Oh..."
  521. EndIf
  522.  
  523. End Function
  524.  
  525. ; demo :
  526.  
  527. ; a$=CurrentDir{}
  528.  
  529. ; Print a$
  530. ; MouseWait:End
  531.  
  532. ;-----------------------------------------------------------------
  533.  
  534. .ProgName
  535.  
  536. ; function : ProgName{}
  537.  
  538. ; returns a string with the program's DOS name
  539.  
  540. Function$ ProgName{}
  541.  
  542. *stringbuffer = AllocMem_(255, 0)
  543. suc.l=GetProgramName_(*stringbuffer,255)
  544.  
  545. If suc
  546.   progname$=Peek$(*stringbuffer)
  547.   Function Return progname$
  548.   Else Request "Info","Couldn't get name of program!","Oh..."
  549. EndIf
  550.  
  551. End Function
  552.  
  553. ; demo :
  554.  
  555. ; a$=ProgName{}
  556.  
  557. ; Print "Program name : "+a$
  558. ; MouseWait:End
  559.  
  560. ;-----------------------------------------------------------------
  561.  
  562. .ParentDir
  563.  
  564. Function$ ParentDir{dir$}
  565.  
  566. ; function : ParentDir{}
  567.  
  568. ; returns a string with the parent directory of a given directory...
  569. ; only work from CLI-run programs :(
  570.  
  571. *lok.l=Lock_(&dir$,#ACCESS_READ)
  572.  
  573. If *lok
  574. *newlock.l=ParentDir_(*lok)
  575.  
  576. If *newlock
  577. *stringbuffer = AllocMem_(255, 0)
  578. n.l=NameFromLock_ (*newlock, *stringbuffer, 255)
  579.  
  580. If n
  581.   lockname$=Peek$(*stringbuffer)
  582.   Function Return lockname$
  583. EndIf
  584.  
  585. UnLock_ (*newlock)
  586.  
  587. EndIf
  588.  
  589. UnLock_(*lok)
  590.  
  591. EndIf
  592.  
  593. End Function
  594.  
  595. ; demo :
  596.  
  597. ; d$="Sys:Devs/DosDrivers"
  598. ; Print ParentDir{d$}
  599. ; MouseWait:End
  600.  
  601. ;-----------------------------------------------------------------
  602.  
  603. .SetComment
  604.  
  605. ; function : SetComment{}
  606.  
  607. ; tries to write a file comment to the specified file
  608.  
  609. ; (the comment appears in the Comment section when you look
  610. ; at a file's icon using the Icon/Information menu item
  611. ; from Workbench)
  612.  
  613. ; returns True if it's successful,False if it fails
  614.  
  615. Function SetComment{fname$,comment$}
  616.   a.l=SetComment_ (&fname$,&comment$)
  617. Function Return a
  618. End Function
  619.  
  620. ; demo :
  621.  
  622. ; filename$="ram:t" ; adds a comment to the Ram:T drawer
  623.  
  624. ; If SetComment{filename$,"Hello,I'm a comment!"}=True
  625. ;  Request "","Done it! Now click on the file's icon|and go to the WB Icons/Information menu...","OK"
  626. ;  Else Request "","Failed to write comment!","Doh!"
  627. ; EndIf
  628.  
  629. ; End
  630.  
  631. ;----------------------------------------------------------------
  632.  
  633. .Memory
  634.  
  635. ; function : Memory {}
  636.  
  637. ; returns size of largest block of available memory -
  638. ; use these flags :
  639.  
  640. ; $0      Any type of memory (0)
  641. ; $1      Public             (1)
  642. ; $2      Chip               (2)
  643. ; $4      Fast               (4)
  644. ; $100    Local              (256)
  645. ; $200    DMAable            (512)
  646. ; $400    KickTags           (1024)
  647. ; $20000  Largest chunk      (131072)
  648. ; $80000  Total memory       (524288)
  649.  
  650.  Function.l Memory{flag.l}
  651.   Function Return AvailMem_(flag)
  652.  End Function
  653.  
  654. ; demo :
  655.  
  656. ; NPrint Memory {$100} ; $100 from the table above is Chip mem...
  657. ; MouseWait:End
  658.  
  659. ;----------------------------------------------------------------
  660.  
  661. .CheckLib
  662.  
  663. ; function : CheckLib {}
  664.  
  665. ; checks library versions...
  666. ; throw it at the start of your code,then do...
  667.  
  668. ; getit.l=CheckLib {"some.library",version}
  669.  
  670. ; where "some.library" is the library you need to check for,
  671. ; and version is the version number you need (0 if it doesn't
  672. ; matter)...
  673.  
  674. ; just repeat that call for each library you need...
  675.  
  676. ; use SnoopDos to see if your program requires a particular
  677. ; version,otherwise you can often just use 0...
  678.  
  679. Function CheckLib {lib$,libv.l}
  680.  
  681. opened.b=0
  682.  
  683. *pplib.l=OpenLibrary_(&lib$,libv.l)
  684.  
  685. If *pplib
  686.   opened=1
  687.   CloseLibrary_ *pplib
  688. EndIf
  689.  
  690. Function Return opened ; it didn't want to return *pplib properly!
  691.  
  692. End Function
  693.  
  694. ; demo :
  695.  
  696. ; FindScreen 0
  697.  
  698. ; lib$="reqtools.library" ; library to check for,
  699. ; libv.b=38               ; version number needed.
  700.  
  701. ; If CheckLib {lib$,libv}=0 Then Request "ERROR!","You need "+lib$+" v"+Str$(libv)+"!","Abort":End
  702.  
  703. ; End
  704.  
  705. ;----------------------------------------------------------------
  706.  
  707. .PixelLen
  708.  
  709. ; function : PixelLen${}
  710.  
  711. ; returns the number of pixels in width required to print
  712. ; the requested string
  713.  
  714. Function.w PixelLen{a$}
  715.   rp.l=RastPort(0) ; The rastport of the used window.
  716.   Function Return TextLength_(rp,&a$,Len(a$))
  717. End Function
  718.  
  719. ; demo :
  720.  
  721. ; FindScreen 0
  722.  
  723. ; If Window (0,0,0,640,200,$40f,"",1,2)=0 Then Request "","Window too wide!","END":End
  724.  
  725. ;   a$="Some Pixels"    ; use this text
  726. ;   pix.w=PixelLen{a$}  ; find pixel width of text
  727.  
  728. ;   ; print information :
  729.  
  730. ;   NPrint ""
  731. ;   NPrint "PixelLen {"+Chr$(34)+a$+Chr$(34)+"} returns a value of : ",pix
  732. ;   NPrint ""
  733. ;   Print "     ":WJam 4:NPrint a$
  734. ;   NPrint ""
  735. ;   WJam 0:NPrint "So "+Chr$(34)+a$+Chr$(34)+" is ",pix," pixels wide in this WindowFont."
  736. ;   NPrint "":NPrint "-----------------------------------------------------------------"
  737.  
  738. ;  ; demo part 2 :
  739.  
  740. ;   a$="Lots and lots and lots and lots and lots and lots and lots and lots and lots and lots of text"
  741.  
  742. ;  ; try taking out a couple of "and lots" to make it fit!
  743.  
  744. ;   NPrint "":NPrint a$
  745.  
  746. ;   If PixelLen {a$}>InnerWidth
  747. ;     NPrint "":NPrint "The string above is too wide!"
  748. ;     Else NPrint "":NPrint "Yep,that string fits!"
  749. ;   EndIf
  750.  
  751. ; Repeat
  752. ; VWait 5
  753. ; Until Event=$200
  754. ; End
  755.  
  756. ;----------------------------------------------------------------
  757.  
  758. .StripToDot
  759.  
  760. ; function : StripToDot{}
  761.  
  762. ; I use this in a program to strip file extensions off...
  763. ; eg. doing StripToDot{"reqtools.library"} would return
  764. ; just "reqtools"...
  765.  
  766. Function$ StripToDot{a$}
  767.  
  768.   For a.w=Len(a$) To 1 Step -1
  769.     If Mid$(a$,a,1)="." Then a$=Left$(a$,a-1):Pop For:Goto senditback
  770.     ; if it found a dot,puts result into b$,goes to senditback label below
  771.   Next a
  772.  
  773. senditback
  774.   Function Return a$
  775. End Function
  776.  
  777. ; demo :
  778.  
  779. ; Print "Enter a string with an extension (eg help.txt) : "
  780. ; a$=StripToDot{Edit$(25)}
  781. ; NPrint "":Print "New name : ",a$
  782. ; NPrint "":NPrint "Click the mouse to end..."
  783. ; MouseWait:End
  784.  
  785. ; demo 2 :
  786.  
  787. ; ; I use it along with StripFile{} to just return
  788. ; ; the file part of a path & file (eg "Work:Pics/Amiga.iff"
  789. ; ; will be returned as "Amiga"...
  790.  
  791. ; a$=StripToDot{ StripFile{"Work:Pics/Amiga.iff"} }
  792. ; NPrint a$:MouseWait:End
  793.  
  794. ;----------------------------------------------------------------
  795.  
  796. .Quoted
  797.  
  798. ; function : Quoted{}
  799.  
  800. ; puts quotes around a file name,so that if your user has
  801. ; entered a file name containing spaces,it'll still be OK...
  802.  
  803. ; useful for some file requester returned strings,or appicons...
  804.  
  805. Function$ Quoted{a$}
  806.  
  807. a$=Chr$(34)+a$+Chr$(34)
  808.  
  809.   Function Return a$
  810. End Function
  811.  
  812. ; demo :
  813.  
  814. ; Print "Enter a file name containing spaces : "
  815. ; f$=Edit$(30)
  816. ; NPrint "":NPrint Quoted{f$}
  817. ; ; Execute_ "ppmore "+Quoted{f$},0,0 ; try copying a text file into ram and typing Ram Disk:textfile.txt (or name of your file)
  818. ; MouseWait:End
  819.  
  820. ;----------------------------------------------------------------
  821.  
  822. Request "statements&functions.bb2","You can't just run this!","Oh...":End
  823. ; just in case ;)
  824. .
  825. .USEFUL_STUFF
  826. .
  827. ;----------- BEGINNING of Carl's WBFONT ROUTINE -----------------
  828.  
  829. ; Reading the Workbench font prefs file...
  830.  
  831. ; this is cut straight out of a demo by Carl Read,and requires
  832. ; a little more effort to cut 'n' paste into your programs :
  833.  
  834. ; 1) Put the FindFont{} function at the top of your source,
  835.  
  836. ; 2) Put the "LoadFile" subroutine OUT OF THE MAIN LOOP of
  837. ;    your program,so you don't accidentally run into it!
  838. ;    * * * * * * ^^ That's IMPORTANT!!!!! ^^ * * * * * * *
  839.  
  840. ; 3) Paste in the "ReadFonts" routine to get the Workbench
  841. ;    fonts information (see "demo").
  842.  
  843. ; I've left it uncommented,as it would be a bit of a pain
  844. ; to have to uncomment it all to paste it in ;)
  845.  
  846. ; Over to Carl ;)
  847.  
  848. ; This function searches for a font name in a string and will
  849. ; return a pointer to it (in the string) if found, else it'll
  850. ; return 0.  If found fontName$ will hold the font name and
  851. ; fontSize its size.
  852.  
  853.  Function.l FindFont{fontPrefs$,startPos.l}
  854.   SHARED fontName$,fontSize
  855.   fontName$="":fontSize=0
  856.   fontPointer.l=Instr(fontPrefs$,"FONT",startPos)
  857.   If fontPointer
  858.    For fontName.l=fontPointer+36 To Len(fontPrefs$)
  859.     a$=Mid$(fontPrefs$,fontName,1)
  860.     If Asc(a$)
  861.      fontName$+a$
  862.     Else
  863.      If Exists("sys:fonts/"+fontName$)
  864.       fontSize=Cvi(Mid$(fontPrefs$,fontPointer+32,2))
  865.       fontPointer+36
  866.      EndIf
  867.      fontName=Len(fontPrefs$)
  868.     EndIf
  869.    Next
  870.   EndIf
  871.   Function Return fontPointer
  872.  End Function
  873.  
  874. ;----------------------------------------------------------------
  875.  
  876. ReadFonts
  877.  
  878.  ; Get user-defined fonts if they exist.
  879.  fi$="ENV:sys/font.prefs":fiLen.l=Exists(fi$)
  880.  If fiLen
  881.   ; Load in WB3 (I think) font names. (1 file.)
  882.   Gosub LoadFile
  883.  Else
  884.   ; Load in WB2 (I think) fonts names. (3 files.)
  885.   fi$="ENV:sys/wbfont.prefs":fiLen.l=Exists(fi$)
  886.   If fiLen Then Gosub LoadFile ; Icon font.
  887.   fi$="ENV:sys/sysfont.prefs":fiLen.l=Exists(fi$)
  888.   If fiLen Then Gosub LoadFile ; System font.
  889.   fi$="ENV:sys/screenfont.prefs":fiLen.l=Exists(fi$)
  890.   If fiLen Then Gosub LoadFile ; Screen font.
  891.  EndIf
  892.  
  893.  If fontPrefs$<>""
  894.   fontPointer.l=FindFont{fontPrefs$,1}
  895.   If fontPointer
  896.    iconFont$=fontName$:iconFontSize=fontSize
  897.   EndIf
  898.   If fontPointer
  899.    fontPointer.l=FindFont{fontPrefs$,fontPointer}
  900.    If fontPointer
  901.     systemFont$=fontName$:systemFontSize=fontSize
  902.    EndIf
  903.   EndIf
  904.   If fontPointer
  905.    fontPointer.l=FindFont{fontPrefs$,fontPointer}
  906.    If fontPointer
  907.     screenFont$=fontName$:screenFontSize=fontSize
  908.    EndIf
  909.   EndIf
  910.  EndIf
  911.  
  912. ;----------------------------------------------------------------
  913.  
  914. ; I've left this demo activated,to avoid having to comment
  915. ; out the LoadFile part of this routine below (cos YOU'D have
  916. ; to uncomment it all - see,I care! no,really.... ;)
  917.  
  918. ; demo :
  919.  
  920. ; To load the fonts in use by Workbench :
  921.  
  922.  LoadFont 0,iconFont$,iconFontSize
  923.  LoadFont 1,systemFont$,systemFontSize
  924.  LoadFont 2,screenFont$,screenFontSize
  925.  
  926.  info$="Icon font : "+iconFont$+", Size : "+Str$(iconFontSize)
  927.  info$=info$+"|System font : "+systemFont$+", Size : "+Str$(systemFontSize)
  928.  info$=info$+"|Screen font : "+screenFont$+", Size : "+Str$(screenFontSize)
  929.  
  930.  Request "",info$,"Cool"
  931.  
  932.  End
  933.  
  934. ;----------------------------------------------------------------
  935.  
  936. LoadFile
  937.  
  938. ; this is the subroutine called by the "ReadFonts" routine :
  939.  
  940.  ; This routine adds to the string fontPrefs$ the file fi$ of
  941.  ; length fiLen.
  942.  err=0
  943.  SetErr:err=-1:End SetErr
  944.   If err=0
  945.    If ReadFile(0,fi$)
  946.     FileInput 0
  947.     fontPrefs$+Inkey$(fiLen)
  948.    EndIf
  949.   EndIf
  950.   CloseFile 0
  951.   DefaultInput
  952.  ClrErr
  953. Return
  954.  
  955. ;------------ END of Carl's WBFONT ROUTINE ----------------------
  956.  
  957.