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