home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 302.lha / ILBMLib / BasicILBM (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1980-12-03  |  11.1 KB  |  268 lines
  1.  'This code was written by Jeff Glatt of dissidents software, and has been
  2.  'placed in the public domain along with the ilbm and requester libraries.
  3.  'This program uses these 2 custom libraries to select an IFF ILBM file and
  4.  'display it. Documentation for the requester library appears on Fish #203.
  5.  
  6.  CLS
  7.  LOCATE 1,8
  8.  PRINT  "Demo AmigaBasic program using the requester and ilbm libraries."
  9.  LOCATE 2,11
  10.  PRINT  "Literally hacked together by Jeff Glatt (dissidents)"
  11.  
  12.  DEFLNG a-Z  'IMPORTANT! All variables are longs (for the library calls)
  13.  
  14.  'requester.bmap, ilbm.bmap, exec.bmap, and intuition.bmap must be in the
  15.  'current directory, or prepend the appropriate path to the lib name.
  16.  LIBRARY "requester.library"
  17.  LIBRARY "ilbm.library"
  18.  LIBRARY "exec.library"
  19.  LIBRARY "intuition.library"
  20.  
  21.  DECLARE FUNCTION AllocMem() LIBRARY
  22.  DECLARE FUNCTION GetMsg()   LIBRARY
  23.  DECLARE FUNCTION WaitPort() LIBRARY
  24.  
  25.  DECLARE FUNCTION DoFileIOWindow() LIBRARY  'These are in the requester lib.
  26.  DECLARE FUNCTION GetFullPathname() LIBRARY 'Other functions in the lib do
  27.  DECLARE FUNCTION GetFileIO() LIBRARY       'not return values, and so do not
  28.  DECLARE FUNCTION AutoFileMessage() LIBRARY 'need declaring
  29.  DECLARE FUNCTION AutoPrompt3() LIBRARY
  30.  DECLARE FUNCTION TypeFilename() LIBRARY
  31.  DECLARE FUNCTION UserEntry() LIBRARY
  32.  DECLARE FUNCTION PromptUserEntry() LIBRARY
  33.  DECLARE FUNCTION GetRawkey() LIBRARY
  34.  DECLARE FUNCTION DecodeRawkey() LIBRARY
  35.  
  36.  DECLARE FUNCTION LoadIFFToWindow() LIBRARY
  37.  DECLARE FUNCTION SaveWindowToIFF() LIBRARY
  38.  
  39.  'First we must get a buffer for the pathname. The FileIO's DoFileIOWindow()
  40.  'will copy the complete pathname there. The complete path looks just like
  41.  'a CLI line:
  42.  
  43.  '  Diskname:TopDrawer/SubDrawer...etc...BottomDrawer/Filename
  44.  
  45.  'Of course, the user may only select a disk or drawer, but no filename, and
  46.  'so the final "/Filename" will not be there. Also, the Filename might not
  47.  'be in any drawers, and so it will appear directly after the diskname. If
  48.  'this format looks weird to you, you need to learn about the CLI.
  49.  'We'll get our buffer from Exec via AllocMem(). 
  50.   
  51.  MEMF.PUBLIC = 1 : MEMF.CLEAR = 65536 : BUFSIZE = 202
  52.  BufferPtr=AllocMem(BUFSIZE,MEMF.PUBLIC+MEMF.CLEAR) 'A buffer to copy the pathname to
  53.  IF BufferPtr = 0 THEN GOTO NoMem1 
  54.  
  55.  'Now we need to get a buffer if we want to allow the user to utilize the
  56.  'extention match feature.
  57.  BUFSIZE2 = 24
  58.  ExtPtr=AllocMem(BUFSIZE2,MEMF.PUBLIC+MEMF.CLEAR)
  59.  IF ExtPtr = 0 THEN GOTO NoMem2 
  60.  
  61.  FileIO=GetFileIO(0)  'Get the address of the FileIO structure
  62.                        'Actually you don't need to pass the 0, but AmigaBasic seems to want something...
  63.  
  64.  IF FileIO = 0 THEN GOTO CloseUp1 '0 means that you don't have a FileIO.
  65.  
  66.  'Set the FileIO's Buffer field to our allocated PathBuffer's address
  67.  POKEL FileIO+248,BufferPtr
  68.  
  69.  POKEL FileIO+222,ExtPtr 'Set the address of the extention string
  70.  
  71.  'Set the title that will displayed in the FileIO window. This can be changed
  72.  'for each call so that you might have the title read "Save File" during a
  73.  'save routine, for example.
  74.  
  75.  WindowTitle$ = "Display ILBM"
  76.  POKEL FileIO+244,SADD(WindowTitle$)
  77.  
  78.  'Set the fore pen, back pen, and draw mode for title bar routines to some
  79.  'defaults. We always need to do this in case the requester is in use by
  80.  'another program and we get automatic title bar file entry. To demo this,
  81.  'run this program twice simultaneously with one of them having the file
  82.  'requester displayed. Note that the title bar entry appears in the 2nd
  83.  'window. This is because only 1 task can be displaying the FileIO requester
  84.  'at a time. Other simultaneous calls get redirected to the title bar entry.
  85.  
  86.  POKE  FileIO+261,1  'JAM2 DrawMode
  87.  POKE  FileIO+262,1  'PenA = Color1
  88.  POKE  FileIO+263,0  'PenB = Color0
  89.  DIM   Pathname$(202)
  90.  
  91.  'Suppress the .info files
  92.  POKE  FileIO+1,128
  93.   
  94.   'Now let's get the ILBMFrame structure (via AllocMem)
  95.  ILBMSIZE = 172
  96.  ILBMFrame=AllocMem(ILBMSIZE,MEMF.PUBLIC+MEMF.CLEAR)
  97.  IF ILBMFrame = 0 THEN GOTO NoMem3 
  98.   
  99. Again:
  100.  CALL ResetTitle(FileIO,WINDOW(7)) 'Maybe we changed it for the error msgs.
  101.   
  102.  Result=DoFileIOWindow(FileIO,0)  'do the FileIO selection on WB screen  
  103.  
  104.  IF Result = -1 THEN GOTO CloseUp2    '-1 means the user selected CANCEL.
  105.  
  106.  '0 means the FileIO window couldn't open (probably due to lack of mem).
  107.  'Too bad! We'll have to get the filename some other way.
  108.  IF Result <> 0 THEN GOTO GotPathname              
  109.  INPUT "Enter Filename >";Pathname$
  110.  ParseString(FileIO,SADD(Pathname$))
  111.  GOTO  PrintName
  112.  
  113. GotPathname:       'We got a selection from the user!
  114.  'Now, our BufferPtr has the complete pathname. Let's copy it to Pathname$.
  115.  
  116.  Pathname$ = ""
  117.  FOR i = 0 TO 202
  118.     value = PEEK(BufferPtr+i)
  119.     IF value = 0 THEN GOTO PrintName
  120.     char$ = CHR$(value)
  121.     Pathname$ = Pathname$+char$    
  122.  NEXT i 
  123.  
  124. PrintName:
  125.  'Now if this is a loadable file, the FileIO has it's size. If it's only a
  126.  'disc name or dir, or the file doesn't exist, then the size = 0.
  127.  
  128.  IF PEEK(FileIO+2) = 0 THEN GOTO DiscOrDir    'Disk or Dir only
  129.  IF PEEKL(FileIO+240) = 0 THEN GOTO NoExist 'Aha! User typed in a Filename that doesn't yet exist
  130.  
  131.  'Let's print out the filename being loaded and set a Wait pointer.
  132.  PRINT "Loading ";Pathname$
  133.  
  134.  CALL SetWaitPointer(WINDOW(7))
  135.  
  136.  'Now, if you want to load into a window that you already opened, then you
  137.  'must store the window and screen addresses in the ILBMFrame's iWindow and
  138.  'iScreen fields. The image will be clipped to fit the size of your window.
  139.  '(i.e. If you try to load a HIRES pic into a LORES window/screen, it will
  140.  'be clipped to fit.) If you want the lib to open a window of the right size
  141.  'when it loads the pic, set these fields to 0. The lib will return the
  142.  'addresses of the window and screen it opened in these fields. Now, the only
  143.  'problem I have is how to do an IDCMP loop in AmigaBasic. I really don't
  144.  'know what I'm doing in Basic, so I'll do it the way that I would in assem-
  145.  'bly.
  146.  
  147.  'Initialize the iUserFlags field for invisible pointer, no title bar.
  148.  POKE  ILBMFrame+1,3
  149.  picWindow&=0
  150.  picScreen&=0
  151.  UseMine=0    'a 1 if we load into an already opened window
  152.  INPUT "Do you want the lib to open a window (y or n)";ans$
  153.  IF ans$ = "y" THEN GOTO setaddress
  154.  SCREEN 2,640,200,5,1            'Open a screen with 5 bitplanes
  155.  WINDOW 2,"Picture",,0           'Open a window to load the picture into
  156.  WINDOW OUTPUT 2
  157.  picWindow&=WINDOW(7)            'Get address of this current output window
  158.  picScreen&=PEEKL(picWindow&+46) 'Get the window's screen
  159.  UseMine=1
  160.  'Initialize the iUserFlags field
  161.  POKE  ILBMFrame+1,0
  162.  
  163. setaddress:
  164.  POKEL ILBMFrame+156,picWindow& 'Set the iWindow and iScreen to 0 before we load.
  165.  POKEL ILBMFrame+160,picScreen& 'This tells the lib to open a window/screen for us.
  166.  Result=LoadIFFToWindow(BufferPtr,ILBMFrame) 'This does it all!
  167.  IF Result <> 0 THEN GOTO iffError  'Oops something went wrong
  168.  
  169.  'Successful load. We should be looking at a picture right now. Let's get
  170.  'the iWindow field in the ILBMFrame. This contains the address of the
  171.  'window that the ilbm lib opened for us. We'll modify the IDCMP to allow
  172.  'MOUSEBUTTONS messages from intuition. Then we'll just wait for the user
  173.  'to click a MOUSEBUTTON before we close down the window/screen with the
  174.  'picture in it.
  175.  
  176.   IF UseMine = 1 THEN GOSUB BasicLoop  'Do an AmigaBasic IDCMP loop
  177.   IF UseMine = 0 THEN GOSUB CustomLoop 'Do my assembly equiv IDCMP loop
  178.     
  179. NoWait:
  180.   IF UseMine = 1 THEN GOTO CloseMine  'Close the window WE opened.
  181.  
  182.  'We must close any window and screen that the lib opened for us.
  183.   picWindow&=PEEKL(ILBMFrame+156)
  184.   picScreen&=PEEKL(ILBMFrame+160)
  185.   IF picWindow& <> 0 THEN CALL CloseWindow(picWindow&)  
  186.   IF picScreen& <> 0 THEN CALL CloseScreen(picScreen&)
  187.   GOTO Query
  188.  
  189. CloseMine: 'I opened them for the image so I'll close my Basic window/screen
  190.   WINDOW CLOSE 2
  191.   SCREEN CLOSE 2
  192.  
  193. Query:
  194.   'Restore the mouse pointer
  195.   CALL ClearPointer(WINDOW(7))
  196.   
  197.  'Note how the lib automatically spaces these messages symmetrically
  198.  Message2$ = "Example program and asm libs by Jeff Glatt" + CHR$(0)
  199.  Message3$ = "Would you like to view another?" + CHR$(0)
  200.  Message$  = "Basic ILBM Viewer" + CHR$(0)
  201.  boolean=AutoPrompt3(SADD(Message$),SADD(Message2$),SADD(Message3$),WINDOW(7))  
  202.  IF boolean=1 THEN GOTO Again
  203.  
  204. CloseUp2: 
  205.  CALL ClearPointer(WINDOW(7))      'Restore the mouse pointer
  206.  CALL ResetTitle(FileIO,WINDOW(7)) 'Maybe we changed it for the error msgs.
  207.  CALL ReleaseFileIO(FileIO)        'Free the FileIO structure
  208.   
  209. NoMem3:
  210.  CALL  FreeMem(ILBMFrame,ILBMSIZE)  'Free the ILBMFrame
  211.   
  212. CloseUp1:
  213.  CALL  FreeMem(ExtPtr,BUFSIZE2)     'Free the extention match buffer
  214.  
  215. NoMem2:
  216.  CALL  FreeMem(BufferPtr,BUFSIZE)   'Free the pathname buffer
  217.  
  218. NoMem1: 
  219.  LIBRARY CLOSE
  220.  END
  221.   
  222.  ' For these 3 errors, let's see how the SetTitle function works. This will
  223.  ' display in the window's title bar string1 followed by string2, but unlike
  224.  ' a requester, returns control back to the program. When we finally call
  225.  ' ResetTitle, the original title is restored. We can call SetTitle without
  226.  ' needing a ResetTitle inbetween and vica versa. Notice how this message
  227.  ' appears in the window and requester title bars. Subsequent calls to these
  228.  ' error routines will change the title bar further. Yet, when we finally
  229.  ' call ResetTitle upon exit, the initial title is restored. As you can see,
  230.  ' these routines are good ror posting error msgs that don't halt the program
  231.  ' (like requesters) but remain visible for as long as they are needed.
  232.  
  233. DiscOrDir:
  234.   Message$ = "Dir only - "+CHR$(0)
  235.  'String2 will be our Pathname
  236.   CALL SetTitle(SADD(Message$),SADD(Pathname$),FileIO,WINDOW(7))
  237.   GOTO Again
  238.  
  239. NoExist:
  240.   Message$ = "This file doesn't exist."+CHR$(0)
  241.   'Note how we indicate that we don't want String2. You must have string1
  242.   'though, even it were just a space.
  243.   CALL SetTitle(SADD(Message$),0,FileIO,WINDOW(7))
  244.   GOTO Again
  245.  
  246. iffError:
  247.  stringAddress=GetIFFPMsg(Result)   'Get the IFFP error msg
  248.  CALL SetTitle(stringAddress,0,FileIO,WINDOW(7))
  249.  GOTO NoWait  
  250.  
  251. CustomLoop:
  252.   picWindow=PEEKL(ILBMFrame+156) 'Here's our window address
  253.   idcmp.flags=8                 'MOUSEBUTTONS
  254.   CALL ModifyIDCMP(picWindow,idcmp.flags)
  255.   port=PEEKL(picWindow+86)       'Get the UserPort of the window
  256. iloop:
  257.   Msg=WaitPort(port)             'Wait for a msg sent by Intuition
  258.   Msg=GetMsg(port)               'Get/Remove the Message            
  259.   Result=PEEKL(Msg+20)           'Get its CLASS
  260.   CALL ReplyMsg(Msg)             'Reply to the Message
  261.   IF Result <> 8 THEN GOTO iloop 'If not MOUSEBUTTONS CLASS, just loop
  262.   RETURN
  263.   
  264. BasicLoop:
  265.   SLEEP
  266.   IF MOUSE(0) = 0 THEN GOTO BasicLoop  
  267.   RETURN
  268.