MODULE IFF_Library ! ======================================================================= ! True BASIC, Inc ! 12 Commerce Avenue ! West Lebanon, New Hampshire 03784-9758 ! (800) 872-2742, (603) 298-8517 ! ======================================================================= ! Author: Paul Castonguay ! ======================================================================= ! ! PURPOSE: To support the reading of IFF images from within True BASIC ! including HAM and Extra-Half_Brite ! ! ! REQUIRED REFERENCE: ! ! LIBRARY "{AmigaTools}IFF*" ! ! To find out more about how libraries are used in True BASIC, refer ! to your True BASIC Reference Manual, or any of a number of texts ! available from True BASIC, Inc. ! ! ! DESCRIPTION: ! ! This MODULE contains ten (so far) routines to help you enhance ! your True BASIC programs by allowing you to import into them ! images that were created using any popular paint program. Although ! True BASIC itself does not formally support the specialized graphic ! modes HAM (Hold and modify) and EHB (Extra Half Brite), this MODULE ! allows you to switch to either of those modes and thus be able to ! display such images. Note however that this is not a generalized ! IFF utility. That is, it is not intended to compete with public ! domain or commercial IFF viewer programs. Rather, it is intended ! simply to allow you to spruce up your BASIC programs by allowing you ! to display images that were created using popular paint programs. ! In fact, we recommend that once your images are imported, that you ! convert them to True BASIC's own BOX KEEP format. This will not only ! allow your program to deal with them more easily, but it will allow ! you to use them to display frame animations. ! ! ! ! LIBRARY ROUTINES ! ---------------- ! ! PUBLIC PRIVATE (*) ! ------------------ -------------------- ! FUNCTION Ask_If_EHB$ FUNCTION Ask_ViewMode$ ! FUNCTION Ask_If_HAM$ SUB Change_Colors ! FUNCTION Ask_If_LACE$ SUB Change_Mode ! FUNCTION Ask_If_Workbench$ SUB Read_BODY ! SUB EHB_ON SUB Read_Unknown ! SUB HAM_ON SUB Read_CRNG ! SUB MODE_OFF SUB Read_CCRT ! SUB Read_IFF_Image SUB Read_CAMG ! SUB Restore_SYS_Colors SUB Read_CMAP ! SUB Save_SYS_Colors SUB Read_BMHD ! SUB Read_FORM ! SUB Open_Communication ! SUB EHB_OFF ! SUB HAM_OFF ! ! C ROUTINES (**) ! -------------------------- ! FUNCTION C___AskScreenFlag ! FUNCTION C___DisplayBody ! FUNCTION C___EHB_OFF ! FUNCTION C___EHB_ON ! FUNCTION C___HAM_OFF ! FUNCTION C___HAM_ON ! FUNCTION C___AskViewMode ! ! ! ! You will find instructions on the use of the PUBLIC routines of this ! LIBRARY in the text which follows. You can view them from True BASIC's ! editor by using its search feature. Search for the word FUNCTION or ! SUBROUTINE, followed by a colon, followed by a single space, and finally, ! followed by the name of the routine you want to use. For example, to ! view instructions on the use of Open_Font, search for the string: ! ! SUBROUTINE: Read_IFF_Image ! ! ! ! (*) PRIVATE routines are not available to the programmer from outside ! a MODULE. Thus they are protected from being used in ways that ! were not intended by their designers. In addition, you need not ! worry about the names of routines within your own programs ! conflicting with those of PRIVATE routines within a MODULE. True ! BASIC protects you from such conflicts. All this is a manifestation ! of the formal principle in computer science called "Information ! Hiding". True BASIC fully supports this principle. ! ! (**) It is not intended that you invoke these directly from your own ! programs. They are invoked for you by various routines within ! this LIBRARY MODULE. ! ! ! ! ! EXCEPTIONS: ! ! ERROR # ERROR STRING OCCURS IN ROUTINE ! ------- ----------------------------- ------------------- ! 900 ... SET MODE required. Read_IFF_Image ! 901 ... Bad ScreenMode$ argument. Read_IFF_Image ! 902 ... Bad Kolor$ argument. Read_IFF_Image ! 903 ... Unknown compression type. Read_IFF_Image ! 904 ... Bad X position argument. Read_IFF_Image ! 905 ... Bad X position argument. Read_IFF_Image ! 906 ... Bad argument to C___DisplayBody(). Read_IFF_Image ! 907 ... Error reading graphic data. Read_IFF_Image ! 908 ... Error invoking C___AskScreenFlag(). Ask_If_Workbench$ ! 909 ... No HAM with GENLOCK_VIDEO set. HAM_ON ! 910 ... No HAM with PFBA set. HAM_ON ! 911 ... No HAM with EXTRA-HALFBRITE set. HAM_ON ! 912 ... No HAM with GENLOCK_AUDIO set. HAM_ON ! 913 ... No HAM with DUALPF set. HAM_ON ! 914 ... No HAM with VP_HIDE set. HAM_ON ! 915 ... No HAM while in HIRES. HAM_ON ! 916 ... Need SET MODE LOW32 or LACELOW32 for HAM. HAM_ON ! 917 ... Not enough memory for HAM. HAM_ON ! 918 ... Error invoking C___HAM_ON. HAM_ON ! 919 ... No EHB with GENLOCK_VIDEO set. EHB_ON ! 920 ... No EHB with PFBA set. EHB_ON ! 921 ... No EHB with GENLOCK_AUDIO set. EHB_ON ! 922 ... No EHB with DUALPF set. EHB_ON ! 923 ... No EHB while in HAM. EHB_ON ! 924 ... No EHB with VP_HIDE set. EHB_ON ! 925 ... No EHB while in HIRES. EHB_ON ! 926 ... Need SET MODE LOW32 or LACELOW32 for EHB. EHB_ON ! 927 ... Not enough memory for EHB. EHB_ON ! 928 ... Error invoking C___EHB_ON. EHB_ON ! 929 ... Error invoking Ask_If_HAM$. MODE_OFF ! 930 ... Error invoking Ask_If_EHB$. MODE_OFF ! 931 ... Error invoking Ask_If_HAM$. Save_SYS_Colors ! 932 ... Error invoking Ask_If_HAM$. Restore_SYS_Colors ! 933 ... File is not IFF. Read_FORM ! 934 ... File is not ILBM. Read_FORM ! 935 ... File is type LIST. Read_FORM ! 936 ... File is type CAT. Read_FORM ! 937 ... Bad BMHD chunk. Read_BMHD ! 938 ... No dual playfield. Change_Mode ! 939 ... Unknown graphic mode. Change_Mode ! 940 ... Error invoking C___AskViewMode(). Ask_ViewMode$ ! 941 ... Error invoking C___HAM_OFF(). HAM_0FF ! 942 ... Error invoking C___EHB_OFF(). EHB_OFF ! ! ! ! ! ***************************** ! *** HOW TO USE ROUTINES *** ! ***************************** ! ! ! ----------------------------------------------------------------------- ! FUNCTION: Ask_If_EHB$ ! ----------------------------------------------------------------------- ! Returns "YES" or "NO" for whether the system currently is, or is ! not, in Extra-Half-Brite mode. This is a FUNCTION that takes no ! arguments. Beware of the common error of using it without a ! DECLARE instruction. If you do, True BASIC will consider the name ! Ask_If_EHB$ to be a variable, and you'll have a heck of a time trying ! to figure out why your code doesn't work as expected. Here is an ! example of how the Ask_If_EHB$ FUNCTION is intended to be used: ! ! ! LIBRARY {AmigaTools}IFF* ! DECLARE FUNCTION Ask_If_EHB$ ! ! SELECT CASE Ask_If_EHB$ ! ! CASE "YES" ! ! ... action intended for EHB mode ... ! ! CASE "NO" ! ! ... action not intended for EHB mode ... ! ! CASE ELSE ! ! ... action to report an error ... ! (you may have forgotten to: DECLARE FUNCTION Ask_If_EHB$) ! ! END IF ! ! ! ----------------------------------------------------------------------- ! FUNCTION: Ask_If_HAM$ ! ----------------------------------------------------------------------- ! Returns "YES" or "NO" for whether the system currently is, or is ! not, in HAM mode. This is a FUNCTION that takes no arguments. ! Beware of the common error of using it without a DECLARE ! instruction. If you do, True BASIC will consider the name ! Ask_If_HAM$ to be a variable, and you'll have a heck of a time trying ! to figure out why your code doesn't work as expected. Here is an ! example of how the Ask_HAM$ FUNCTION is intended to be used: ! ! ! LIBRARY {AmigaTools}IFF* ! DECLARE FUNCTION Ask_If_HAM$ ! ! SELECT CASE Ask_If_HAM$ ! ! CASE "YES" ! ! ... action intended for HAM mode ... ! ! CASE "NO" ! ! ... action not intended for HAM mode ... ! ! CASE ELSE ! ! ... action to report an error ... ! (you may have forgotten to: DECLARE FUNCTION Ask_If_HAM$) ! ! END IF ! ! ! ----------------------------------------------------------------------- ! FUNCTION: Ask_If_LACE$ ! ----------------------------------------------------------------------- ! Returns "YES" or "NO" for whether the system currently is, or is ! not, in interlace mode. This is a FUNCTION that takes no arguments. ! Beware of the common error of using it without a DECLARE ! instruction. If you do, True BASIC will consider the name ! Ask_If_LACE$ to be a variable, and you'll have a heck of a time trying ! to figure out why your code doesn't work as expected. Here is an ! example of how the Ask_If_LACE$ FUNCTION is intended to be used: ! ! ! LIBRARY {AmigaTools}IFF* ! DECLARE FUNCTION Ask_If_LACE$ ! ! SELECT CASE Ask_If_LACE$ ! ! CASE "YES" ! ! ... action intended for LACE mode ... ! ! CASE "NO" ! ! ... action not intended for LACE mode ... ! ! CASE ELSE ! ! ... action to report an error ... ! (you may have forgotten to: DECLARE FUNCTION Ask_If_LACE$) ! ! END IF ! ! ! ----------------------------------------------------------------------- ! FUNCTION: Ask_If_Workbench$ ! ----------------------------------------------------------------------- ! Returns "YES" or "NO" for whether True BASIC currently is, or is ! not, using the Amiga's Workbench screen for its OUTPUT. This is a ! FUNCTION that takes no arguments. Beware of the common error of ! using it without a DECLARE instruction. If you do, True BASIC will ! consider the name Ask_If_Workbench$ to be a variable, and you'll have ! a heck of a time trying to figure out why your code doesn't work as ! expected. Here is an example of how the Ask_If_Workbench$ FUNCTION ! is intended to be used: ! ! ! LIBRARY {AmigaTools}IFF* ! DECLARE FUNCTION Ask_If_Workbench$ ! ! SELECT CASE Ask_If_Workbench$ ! ! CASE "YES" ! ! ... action intended for Workbench screen ... ! ! CASE "NO" ! ! ... action not intended for Workbench screen ... ! ! CASE ELSE ! ! ... action to report an error ... ! (you may have forgotten to: DECLARE FUNCTION Ask_If_Workbench$) ! ! END IF ! ! ! ----------------------------------------------------------------------- ! SUBROUTINE: EHB_ON ! ----------------------------------------------------------------------- ! Switches the Amiga's graphic mode to Extra-Half-Brite, which allows ! you to display 64 colors on screen with some restrictions. ! ! Normally the Amiga displays a maximum of 32 colors, each chosen from ! a pallette of 4096, a method that is called "Color Indirection". ! Color registers, numbered from 0 through 31, are used to allow you to ! do this. To display text or draw graphics in a particular color you ! define an available color register in terms of the relative ! intensities of its red, green, and blue primary colors: ! ! SET COLOR MIX (7) 15/15, 15/15, 0/15 ! ! Here register 7 has been set to yellow. Intensities in True BASIC ! are expressed as a fraction of 1, thus allowing compatibility with ! any future hardware improvements, like 24 bit color for instance. ! At present the Amiga supports only 12 bit color, where each color ! intensity can have one of only 16 different levels, numbered from ! 0 through 15. That should explain my above choice of fractional ! values. ! ! The next step to using a color is to specify the color register, ! that is, to tell the system to use it: ! ! SET COLOR 7 ! PRINT "Call me yellow." ! ! In Extra-Half-Brite mode a second or upper range of color registers, ! 32 through 63 becomes available, each one containing a color of half ! the brightness of its matching register in the lower range, 0 through ! 32. In the above example, color register 39 would contain yellow of ! half the brightness of register 7, which is its matching register in ! the lower range (32 matches with 0, 33 with 1, 32 with 2, ... etc) ! ! SET COLOR 39 ! PRINT "Call me mellow yellow." ! ! True BASIC does not formally support Extra-Half-Brite, however ! this EHB_ON routine sets your Amiga to that mode, thus allowing you ! to dislay images that were created in popular paint programs ! using that mode. ! ! You may remain in EHB mode throughout the duration of your program. ! You may even take advantage of the extra colors yourself, however you ! must be careful to execute a MODE_OFF instruction before your program ! terminates. If you want to run your program in EHB mode, you should ! protect it with an exception handler, in the event that an unexpected ! interuption occurs. Here is how that is done: ! ! ! LIBRARY {AmigaTools}IFF* ! ! WHEN EXCEPTION IN ! ----------- Beginning of protected code -------- ! ! Your program code goes here ! ! ! USE ! ---------------------- Beginning of exception handler -------- ! ! CALL MODE_OFF ! EXIT HANDLER ! ! END WHEN ! ----------------------- End of exception handler -------- ! ! ! If any problems occur while your program is running, execution ! will jump to the above handler, automatically turning off the ! EHB graphic mode before terminating. The EXIT HANDLER is needed ! if you do not want to suppress the error message. For more ! information on True BASIC's error handling feature, see the ! reference manual for the "Regular Edition" of the language, or ! any of a number of texts available from True BASIC, Inc. ! ! If you do make use of the extra colors available in EHB within your ! program, you will notice that the ASK MAX COLOR instruction ! reports a maximum register number of only 31. That's because the ! True BASIC language system is unaware that EHB mode is in effect. ! However, the extra registers are available for your use. Simply ! use them in a SET COLOR instruction and you will see. ! ! ! EXCEPTIONS: ! ! 919 .... No EHB with GENLOCK_VIDEO set. ! 920 .... No EHB with PFBA set. ! 921 .... No EHB with GENLOCK_AUDIO set. ! 922 .... No EHB with DUALPF set. ! 923 .... No EHB while in HAM. ! 924 .... No EHB with VP_HIDE set. ! 925 .... No EHB while in HIRES. ! 926 .... Need SET MODE LOW32 or LACELOW32 for EHB. ! 927 .... Not enough memory for EHB. ! 928 .... Error invoking C___EHB_ON. ! You may be trying to invoke C___EHB_ON without first ! declaring it as a function. ! ! ! ----------------------------------------------------------------------- ! SUBROUTINE: HAM_ON ! ----------------------------------------------------------------------- ! Switches the Amiga's graphic mode to Hold-And-Modify, which allows ! you to display 4096 colors on screen with some restrictions. ! ! Normally the Amiga displays a maximum of 32 colors, each chosen from ! a pallette of 4096, a method that is called "Color Indirection". ! Color registers, numbered from 0 through 31, are used to allow you to ! do this. To display text or draw graphics in a particular color you ! define an available color register in terms of the relative ! intensities of its red, green, and blue primary colors: ! ! SET COLOR MIX (7) 15/15, 15/15, 0/15 ! ! Here register 7 has been set to yellow. Intensities in True BASIC ! are expressed as a fraction of 1, thus allowing compatibility with ! any future hardware improvements, like 24 bit color for instance. ! At present the Amiga supports only 12 bit color, where each color ! intensity can have one of only 16 different levels, numbered from ! 0 through 15. That should explain my above choice of fractional ! values. ! ! The next step to using a color is to specify the color register, ! that is, to tell the system to use it: ! ! SET COLOR 7 ! PRINT "Call me yellow." ! ! HAM allows the dislaying of more colors than you have color registers ! for by using a hardware trick, where the color of an individual pixel ! is specified in a way that is related to its immediate left neighbor. ! When HAM is in effect, the first 16 color registers, 0 through 15, ! work in the normally manner. However the remaining 16 through 63 ! registers cause whatever pixel you illuminate to borrow color ! definition information for two of its primary colors from its ! immediate left neighbor, while supplying for the remaining color an ! intensity related to the register number specified. If you pick ! color registers 16 through 31 the pixel you illuminate borrows the ! red and green intensity values from its left immediate neighbor and ! then adds blue at an intensity equal to the number of the register ! chosen minus sixteen. Thus register number 25 would supply blue at ! intensity 9. In a similar manner register numbers 32 through 47 ! borrow the green and blue, then add red at an intensity equal to the ! register number minus 32. Finally registers 48 through 63 borrow the ! red and blue and add green at an intensity equal to the register ! number minus 48. ! ! If you think the above scheme to color pixels is obscure, you are ! correct. It is so obscure that it will propably be of little use ! from within your BASIC programs, except for importing images that ! were created in that mode using popular paint programs. ! ! True BASIC does not formally support HAM, however this HAM routine ! sets your Amiga to that mode, thus allowing you to dislay images ! that were created using that mode. ! ! You may remain in HAM mode throughout the duration of your program. ! You may even take advantage of the extra colors yourself, however you ! must be careful to execute a MODE_OFF instruction before your ! program terminates. If you want to run your program in EHB mode, ! you should protect it with an exception handler in the event ! that an unexpected interuption occurs. Here is how that is done: ! ! ! LIBRARY {AmigaTools}IFF* ! ! WHEN EXCEPTION IN ! ----------- Beginning of protected code -------- ! ! Your program code goes here ! ! ! USE ! ---------------------- Beginning of exception handler -------- ! ! CALL MODE_OFF ! EXIT HANDLER ! ! END WHEN ! ----------------------- End of exception handler -------- ! ! ! If any problems occur while your program is running, execution ! will jump to the above handler, automatically turning off the ! HAM graphic mode before terminating. The EXIT HANDLER is needed ! if you do not want to suppress the error message. For more ! information on True BASIC's error handling feature, see the ! reference manual for the "Regular Edition" of the language, or ! any of a number of texts available from True BASIC, Inc. ! ! If you do make use of the extra colors available in HAM within your ! program, you will notice that the ASK MAX COLOR instruction ! reports a maximum register number of 31. That's because the ! True BASIC language system is unaware that HAM mode is in effect. ! However, the extra registers are available for your use. Simply ! use them in a SET COLOR instruction and you will see. ! ! EXCEPTIONS: ! ! 909 ... No HAM with GENLOCK_VIDEO set. ! 910 ... No HAM with PFBA set. ! 911 ... No HAM with EXTRA-HALFBRITE set. ! 912 ... No HAM with GENLOCK_AUDIO set. ! 913 ... No HAM with DUALPF set. ! 914 ... No HAM with VP_HIDE set. ! 915 ... No HAM while in HIRES. ! 916 ... Need SET MODE LOW32 or LACELOW32 for HAM. ! 917 ... Not enough memory for HAM. ! 918 ... Error invoking C___HAM_ON. ! You may be trying to invoke C___HAM_ON without first ! declaring it as a function. ! ! ! ----------------------------------------------------------------------- ! SUBROUTINE: Read_IFF_Image ! ----------------------------------------------------------------------- ! Reads an IFF image from disk and displays it to WINDOW #0 of your ! BASIC program. See your True BASIC documentation for an explanation ! of how the OPEN #: SCREEN instruction defines different WINDOWS. If ! you do not specifically OPEN one, then your program is using WINDOW #0 ! and you don't have to worry about this. The position of the top left ! corner of the image is adjustable horizontally to byte boundaries on ! the screen - that is, to horizontal positions that are multiples of ! eight pixels from the left edge of the screen, and vertically to any ! scan line. Coordinates used for positioning are whatever ones are ! in effect in WINDOW #0 of your program, either True BASIC's default, ! Normalized Device Coordinates (NDC), or your own World Coordinates. ! This routine can be told to automatically switch the colors and screen ! resolution to whatever was in effect when the IFF image was created, ! or to not disturb those properties of your program, in which case it ! will render whatever portion of the image it can using your program's ! own color and resolution definitions. Here is the template for using ! this routine from within your True BASIC programs: ! ! ! LIBRARY {AmigaTools}IFF* ! ! LET Filename$ = "Gorilla" ! LET ScreenMode$ = "IFF" ! LET Kolor$ = "IFF" ! LET X = 0 ! LET Y = 1 ! CALL Read_IFF_Image(Filename4, ScreenMode$, Kolor$, X, Y) ! ! ! ScreenMode$: ! ! "IFF" Tells this routine to switch automatically to whatever screen ! resolution was in effect when the IFF image was created. ! ! "" The NULL string. Tells it to leave your program's screen ! resolution alone. ! ! ! Kolor$: ! ! "IFF" Tells this routine to switch automatically to whatever colors ! were in effect when the IFF image was created. ! ! ! "" The NULL string. Tells this routine to leave your ! program's colors alone. ! ! The above example code will cause your program to import the famous ! Gorilla picture that comes with Deluxe Paint, switching your ! program's graphic mode to "LOW32" and your programs color definitions ! to those that were in effect when that image was created. ! ! ! ! PRACTICAL ADVICE: ! ! After importing images into True BASIC they should be converted to ! BOX KEEP format. You can easily do that with the following ! instruction: ! ! BOX KEEP BLeft, BRight, BBottom, BTop IN Image$ ! ! You can then save them to disk, like this: ! ! OPEN #1: NAME "Gorilla.BOX", ACCESS OUTPUT, CREATE NEWOLD, ORGANIZATION BYTE ! ERASE #1 ! WRITE #1: Image$ ! ! CLOSE #1 ! ! Note that the above OPEN instruction must be entered all on one single ! line. Once in BOX KEEP format, the image can be conveniently used ! by your programs, like this: ! ! OPEN #1: NAME "Gorilla.BOX", ORGANIZATION BYTE ! ASK #1: FILESIZE ImageLength ! READ #1, BYTES ImgaeLength: Image$ ! CLOSE #1 ! ! BOX SHOW Image$ AT 0,0 ! ! Note that position information in BOX KEEP format refers to the ! bottom left corner of the image. ! ! By using BOX KEEP format your program can read images without ! immediately rendering them to screen, using them only when they ! are required. Also, BOX KEEP renders images extremely fast, fast ! enough in fact for frame animations, as long as the image size is ! reasonable. Full screen images will flicker if animated in True ! BASIC, but smaller ones can create some very impressive effects. ! Note that this routine is not intended to compete with commercial ! animation programs for the Amiga, but rather, simply to allow you ! to, within reason, spruce up your BASIC programs. ! ! The above simple program requires that you keep track of the ! screen resolution and color definitions of each of your images. ! But of course, you can easily save that information also. Here ! is a possible format, which I like to call "User Format". ! ! OPEN #1: NAME "Gorilla.USR", ACCESS OUTPUT, CREATE NEWOLD, ORGANIZATION BYTE ! ERASE #1 ! WRITE #1: Mode$ & Kolor$ & Image$ ! CLOSE #1 ! ! ... where you have previously assigned resolution and color ! information to the above variables using a format of your choice. ! This method requires that your program know how to interpret that ! information. Another way is to store resolution and color information ! in a separate support file, like this: ! ! ! OPEN #1: NAME "Gorilla.TRU", ACCESS OUTPUT, CREATE NEWOLD, ! ORGANIZATION BYTE ! OPEN #2: NAME "Gorilla.dat", ACCESS OUTPUT, CREATE NEWOLD, ! ORGANIZATION TEXT ! ERASE #1 ! ERASE #1 ! ! ASK MODE Mode$ ! PRINT #2: Mode$ ! ! ASK MAX COLOR MC ! FOR C = 0 TO MC ! ASK COLOR MIX (C) R,G,B ! PRINT #2: R,G,B ! NEXT C ! ! WRITE #1: Image$ ! CLOSE #2 ! CLOSE #1 ! ! ! Do whatever you feel most comfortable with. And remember, when ! saving HAM images you must save only 16 registers, not 32. ! ! ! WARNINGS FOR USING WINDOW #'s ! ! WINDOWS: ! Be warned that this routine switches the active window to Window #0. ! This was necessary in order to perform error checking on the image's ! position information. ! ! ! EXCEPTIONS: ! ! 900 ... SET MODE required. ! IFF images cannot be rendered on the Workbench Screen. ! 901 ... Bad ScreenMode$ argument. ! 902 ... Bad Kolor$ argument. ! 903 ... Unknown compression type. ! 904 ... Bad X position argument. ! 905 ... Bad Y position argument. ! 906 ... Bad argument to C___DisplayBody(). ! 907 ... Error reading graphic data. ! ! ! ----------------------------------------------------------------------- ! SUBROUTINE: MODE_OFF ! ----------------------------------------------------------------------- ! Removes the effect of Hole-And-Modify or Extra-Half-Brite display modes. ! ! ! LIBRARY {AmigaTools}IFF* ! ! CALL MODE_OFF ! ! It is necessary to disable HAM and EHB modes before allowing your ! program to terminate, otherwise your program may not properly ! return resources to the operating system. You can invoke MODE_OFF ! at any time, even if you are not in either HAM or EHB. If your ! program makes use of these modes, you should use True BASIC's exception ! handling feature, placing a MODE_OFF instruction in the handler. ! ! ! LIBRARY {AmigaTools}IFF* ! ! WHEN EXCEPTION IN ! ----------- Beginning of protected code -------- ! ! Your program code goes here ! ! ! USE ! ---------------------- Beginning of exception handler -------- ! ! CALL MODE_OFF ! EXIT HANDLER ! ! END WHEN ! ----------------------- End of exception handler -------- ! ! ! If any problems occur while your program is running, execution ! will jump to the above handler, automatically turning off the ! HAM graphic mode before terminating. The EXIT HANDLER is needed ! if you do not want to suppress the error message. For more ! information on True BASIC's error handling feature, see the ! reference manual for the "Regular Edition" of the language, or ! any of a number of texts available from True BASIC, Inc. ! ! ! ! EXCEPTIONS: ! ! 929 ... Error invoking Ask_If_HAM$. ! 930 ... Error invoking Ask_If_EHB$. ! ! ! ----------------------------------------------------------------------- ! SUBROUTINE: Restore_SYS_Colors ! ----------------------------------------------------------------------- ! To allow you to put into effect color intensity definitions that were ! previously saved using Save_SYS_Colors. ! ! ! LIBRARY {AmigaTools}IFF* ! ! SET MODE OldMode$ ! CALL Restore_SYS_Colors ! ! ! The number of colors restored equals the number of registers that were ! active when the Save_SYS_Colors was invoked. ! ! ! EXCEPTIONS: ! ! 932 ... Error invoking Ask_If_HAM$. ! ! ! ----------------------------------------------------------------------- ! SUBROUTINE: Save_SYS_Colors ! ----------------------------------------------------------------------- ! To allow you to save the color intensity definitions that are in effect ! on your system at any time. It is convenient to use this routine ! when you want to display a graphic image that has its own color ! definitions, and then switch back to your current ones. To restore your ! colors after displaying the image, simply invoke the Restore_SYS_Colors ! subroutine. Note that to save your current graphic mode, True BASIC ! already has the ASK MODE statement: ! ! ! LIBRARY {AmigaTools}IFF* ! ! ASK MODE OldMode$ ! CALL Save_SYS_Colors ! ! ! The Save_SYS_Colors will save your color information to a variable ! within the IFF* library, a variable that is not directly accessible ! to your program except through Save_SYS_Colors and Restore_SYS_Colors. ! The number of colors saved equals the number of active registers at ! the time you invoke the Save_SYS_Colors routine. ! ! ! EXCEPTIONS: ! ! 931 ... Error invoking Ask_If_HAM$. ! ! ! ======================================================================= ! ! ! ! ********************** ! *** CODE FOLLOWS *** ! ********************** ! ! ! **************************** ! PRIVATE routine declarations ! **************************** PRIVATE Ask_ViewMode$ PRIVATE Change_Colors PRIVATE Change_Mode PRIVATE EHB_OFF PRIVATE HAM_OFF PRIVATE Open_Communication PRIVATE Read_BMHD PRIVATE Read_BODY PRIVATE Read_CAMG PRIVATE Read_CCRT PRIVATE Read_CMAP PRIVATE Read_CRNG PRIVATE Read_FORM PRIVATE Read_Unknown ! ******************************************** ! Declare an array to hold the color intensity ! values that are read from the IFF file. ! ******************************************** OPTION BASE 1 SHARE IFFColors(64, 3) SHARE SYSColors(0 TO 64, 3) ! ************************************* ! Declare variables to be SHARED by all ! program units within this MODULE ! ************************************* SHARE Filename$ ! File name of image on disk SHARE Form_Length ! Length of IFF file read from the FORM ! chunk. Not used by this utility. SHARE Chunk_Type$ ! Used by parsing loop SHARE User_X ! Desired horizontal postion SHARE User_Y ! Desired vertical position SHARE Width ! Screen width of IFF image SHARE Height ! Screen height of IFF image SHARE IFF_X ! Horizontal postion stored in IFF file SHARE IFF_Y ! Vertical position stored in IFF file SHARE Depth ! Screen depth of IFF image SHARE Comp ! Data compression flag SHARE Masking ! Masking flag SHARE pad1 ! Ignore this value SHARE transparentColor ! Use to identify which color is to be ! made transparent. This utility does ! not use it. SHARE xAspect ! Used for porting image to a different ! raster size. This utility does not ! use it. SHARE yAspect ! Used for porting image to a different ! raster size. This utility does not ! use it. SHARE pageWidth ! Raster size that was in effect when ! this image was saved. This utility ! does not use it. SHARE pageHeight ! Raster size that was in effect when ! this image was saved. This utility ! does not use it. SHARE IFF_View_Mode$ ! Screen ViewMode of IFF image SHARE ModeFlag$ ! To flag automatic resolution switching SHARE KolorFlag$ ! To flag automatic color switching SHARE Image_Data$ ! SHARE WBENCHSCREEN ! Flag to test if OUTPUT window is on ! Workbench screen SHARE HIRES ! Flags to test view mode SHARE HAM ! " SHARE DUALPF ! " SHARE EXTRA_HALFBRITE ! " SHARE LACE ! " ! ******************************* ! SHARED variable initializations ! ******************************* LET WBENCHSCREEN = 1 ! LET HIRES = 1 ! These are the True BASIC bit positions LET HAM = 5 ! for the macros of the same name from LET DUALPF = 6 ! the Compiler_Hearers/graphics/view.h LET EXTRA_HALFBRITE = 9 ! file on the SAS/C development system. LET LACE = 14 ! Note that the bit positions are ! reversed. In True BASIC bit 1 is the ! most significant bit, bit 16 is the ! least significant bit of a 16 bit word. ! ----------------------------- ! |\ /| ! | ------------------------- | ! | | PUBLIC ROUTINES FOLLOW | | ! | ------------------------- | ! |/ \| ! ----------------------------- ! ======================================================================= ! SUBROUTINE: Read_IFF_Image ! ======================================================================= ! ! PURPOSE: To read from disk and display to screen graphic images in ! IFF format. ! ! ! SCOPE: PUBLIC ! ! ! PARAMETERS: ! ! ! INPUT: ! ! FileName$ ........ Filename where IFF image is stored ! ! ScreenMode$ ...... Flag for desired screen mode ! ! NULL = Keep current mode. ! IFF = Use mode recorded in image ! ! Kolor$ ........... Flag for desired colors ! ! NULL = Keep current colors. ! IFF = Use colors recorded in image ! ! X ................ Desired horizontal position ! Y ................ Desired vertical position ! ! ! ! SHARED VALUES ! ! INOUT: ! ! FileName$ ...... Filename where IFF image is stored ! Chunk_Type$ .... Four letter chunk identifier read from file ! User_X ......... Desired horizontal postion ! User_Y ......... Desired vertical position ! ModeFlag$ ...... To flag automatic screen switching ! KolorFlag$ ..... To flag automatic color switching ! ! ! ROUTINES INVOKED: ! ! FUNCTION Ask_If_Workbench$ ! SUB Open_Communication ! SUB Read_BMHD ! SUB Read_BODY ! SUB Read_CAMG ! SUB Read_CCRT ! SUB Read_CMAP ! SUB Read_CRNG ! SUB Read_FORM ! SUB Read_Unknown ! ! ! NOTES: ! ! Routine cycles through a parsing loop, ending when the BODY chunk ! is read. ! ! ! EXCEPTIONS: ! ! 900 ... SET MODE required. ! IFF images cannot be rendered on the Workbench Screen. ! 901 ... Bad ScreenMode$ argument. ! 902 ... Bad Kolor$ argument. ! 903 ... Unknown compression type. ! 904 ... Bad X position argument. ! 905 ... Bad Y position argument. ! 906 ... Bad argument to C___DisplayBody(). ! 907 ... Error reading graphic data. ! ======================================================================= SUB Read_IFF_Image(IFF_FileName$, ScreenMode$, Kolor$, X, Y) LIBRARY "C___DisplayBody*" DECLARE FUNCTION Ask_If_Workbench$, C___DisplayBody ! *********************************************************** ! If user does not want automatic screen switching, make sure ! he/she is not trying to use the workbench for image output. ! Also check for legal KolorFlag$ parameters. ! *********************************************************** IF UCASE$(ScreenMode$) = "" THEN IF Ask_If_Workbench$ = "YES" THEN CAUSE EXCEPTION 900, "SET MODE required." END IF ELSEIF UCASE$(ScreenMode$) <> "IFF" THEN CAUSE EXCEPTION 901, "Bad ScreenMode$ argument." END IF IF UCASE$(Kolor$) <> "" AND UCASE$(Kolor$) <> "IFF" THEN CAUSE EXCEPTION 902, "Bad Kolor$ argument." END IF ! ************************************* ! Assign parameters to SHARED variables ! ************************************* LET Filename$ = IFF_FileName$ LET User_X = X LET User_Y = Y LET ModeFlag$ = ScreenMode$ LET KolorFlag$ = Kolor$ ! ******************************** ! Open a channel to the file named ! in the calling program unit. ! ******************************** CALL Open_Communication(#999) ! ***************************************** ! Read the file header, IFF type and length ! ***************************************** CALL Read_FORM(#999) ! ******************* ! Top of parsing loop ! ******************* DO ! ***************** ! Read a chunk type ! ***************** READ #999, BYTES 4 : Chunk_Type$ ! ************************ ! Enter the parsing switch ! ************************ SELECT CASE Chunk_Type$ CASE "BMHD" CALL Read_BMHD(#999) CASE "CMAP" CALL Read_CMAP(#999) CASE "CAMG" CALL Read_CAMG(#999) CASE "CCRT" CALL Read_CCRT(#999) CASE "CRNG" CALL Read_CRNG(#999) CASE "BODY" CALL Read_BODY(#999) EXIT DO ! This is how the parsing loop ends CASE else CALL Read_Unknown(#999) END SELECT LOOP ! ********************** ! Bottom of parsing loop ! ********************** ! ****************************** ! Trap unknown compression types ! ****************************** IF Comp <> 0 AND Comp <> 1 THEN CLOSE #999 CAUSE EXCEPTION 903, "Unknown compression type." END IF ! ************************************************** ! A set Mask flag indicates a mask plane interleaved ! with the bitplanes in the graphic data. Other ! values are not used by this utility. ! ************************************************** IF Masking <> 1 THEN LET Masking = 0 END IF ! *************************************************** ! This routine will automatically switch screen modes ! to that of the IFF image if the ModeFlag$ = IFF. ! *************************************************** IF UCASE$(ModeFlag$) = "IFF" THEN CALL Change_Mode END IF ! ************************************************** ! Test user's flag to see what to do with the colors ! ************************************************** IF UCASE$(KolorFlag$) = "IFF" THEN CALL Change_Colors END IF ! ************************************* ! Get raster and coordinate information ! ************************************* WINDOW #0 ASK WINDOW User_XMIN, User_XMAX, User_YMIN, User_YMAX ASK PIXELS XPIXELS, YPIXELS ! ****************************** ! Trap bad position instructions ! ****************************** IF User_XMIN < User_XMAX THEN IF User_X < User_XMIN OR User_X > User_XMAX THEN CAUSE EXCEPTION 904, "Bad X position argument." END IF ELSE IF User_X > User_XMIN OR User_X < User_XMAX THEN CAUSE EXCEPTION 904, "Bad X position argument." END IF END IF IF User_YMIN < User_YMAX THEN IF User_Y < User_YMIN OR User_Y > User_YMAX THEN CAUSE EXCEPTION 905, "Bad Y position argument." END IF ELSE IF User_Y > User_YMIN OR User_Y < User_YMAX THEN CAUSE EXCEPTION 905, "Bad Y position argument." END IF END IF ! ***************************************************** ! Calculate pixel position of desired position of image ! ***************************************************** LET dx = (User_XMAX-User_XMIN)/(XPIXELS-1) LET dy = (User_YMAX-User_YMIN)/(YPIXELS-1) LET Hor = INT((User_X-User_XMIN)/dx + IFF_X) LET Ver = INT((YPIXELS-1) - (User_Y-User_YMIN)/dy + IFF_Y) ! **************************************** ! Invoke C subroutine to write contents of ! BODY chunk directly to screen memory. ! **************************************** LET Error = C___DisplayBody(Image_Data$, Width, Height, Hor, Ver, Depth, Masking, Comp) ! ********************************** ! Any problems displaying the image? ! ********************************** IF Error = -1 THEN CAUSE EXCEPTION 906, "Bad argument to C___DisplayBody()." ELSEIF Error = -2 THEN CAUSE EXCEPTION 907, "Error reading graphic data." END IF ! ***************************** ! Release BODY data from memory ! ***************************** LET Image_Data$ = "" END SUB ! End of Read_IFF_Image() ! ======================================================================= ! FUNCTION: Ask_If_LACE$ ! ======================================================================= ! ! PURPOSE: To find out if LACE is currently in effect ! ! ! SCOPE: PUBLIC ! ! ! SHARED VARIABLES: LACE ! ! ! RETURN VALUE: "YES" or "NO" ! ! ! TEMPLATE: ! ! DECLARE FUNCTION Ask_If_LACE$ ! ! SELECT CASE Ask_If_LACE$ ! ! CASE "YES" ! ... ! ! CASE "NO" ! ... ! ! CASE ELSE ! ... ERROR. You may be trying to use Ask_If_LACE$ ! without first declaring it as a function. ! ! END SELECT ! ! ! ! ROUTINES INVOKED: Ask_ViewMode$() ! ! ! NOTES: True BASIC's UnPackB performs the required bit-wise test. ! ======================================================================= FUNCTION Ask_If_LACE$ DECLARE FUNCTION Ask_ViewMode$ IF UnPackB(Ask_ViewMode$,LACE,1) = 1 THEN LET Ask_If_LACE$ = "YES" ELSE LET Ask_If_LACE$ = "NO" END IF END FUNCTION ! End of Ask_If_LACE$ ! ======================================================================= ! FUNCTION: Ask_If_Workbench$ ! ======================================================================= ! ! PURPOSE: To find out if True BASIC's current OUTPUT window is on ! the Workbench screen ! ! ! SCOPE: PUBLIC ! ! ! SHARED VARIABLES: WBENCHSCREEN ! ! ! RETURN VALUE: "YES" or "NO" ! ! ! TEMPLATE: ! ! DECLARE FUNCTION Ask_If_Workbench$ ! ! SELECT CASE Ask_If_Workbench$ ! ! CASE "YES" ! ... ! ! CASE "NO" ! ... ! ! CASE ELSE ! ... ERROR. You may be trying to use Ask_If_Workbench$ ! without first declaring it as a function. ! ! END SELECT ! ! ! ! ROUTINES INVOKED: C___AskScreenFlag() ! ! OPERATION: In/OUT parameter of C___AskScreenFlag() must be initialize to ! a length of 16 bits. C___AskScreenFlag() returns the current ! Screen->Flags through that same parameter. This FUNCTION ! then tests it to see if it represents the Workbench. ! ! ! NOTES: True BASIC's UnPackB performs the required bit-wise test. ! ! ! EXCEPTIONS: ! ! 908 ... Error invoking C___AskScreenFlag(). ! ======================================================================= FUNCTION Ask_If_Workbench$ LIBRARY "C___AskScreenFlag*" DECLARE FUNCTION C___AskScreenFlag CALL PackB(Screen_Flag$,1,16,0) LET Error = C___AskScreenFlag(Screen_Flag$) IF Error <> 0 THEN CAUSE EXCEPTION 908, "Error invoking C___AskScreenFlag()." END IF IF UnPackB(Screen_Flag$, 13, 4) = WBENCHSCREEN THEN LET Ask_If_Workbench$ = "YES" ELSE LET Ask_If_Workbench$ = "NO" END IF END FUNCTION ! End of Ask_If_Workbench$ !======================================================================== ! SUBROUTINE: HAM_ON !======================================================================== ! ! PURPOSE: To turn on HAM mode. ! ! This routine invokes C___HAM_ON() which makes required ! adjustments to system structures. ! ! ! SCOPE: PUBLIC ! ! ! TEMPLATE: ! ! CALL HAM_ON ! ! ! ROUTINES INVOKED: C___HAM_ON ! ! ! NOTES: ! ! If you invoke this routine while HAM is already in effect, ! nothing happens. However, if you want your program to be warned ! of that condition, simply add a CAUSE EXCEPTION instruction ! to the appropiate branch of the SELECT CASE below. ! ! I chose to not support some modes because I do not know whether EHB ! is legal in them. If you want to try these out you will have to ! appropiately modify and re-compile the C___HAM_ON routine, which is ! written in C. ! ! ! EXCEPTIONS: ! ! 909 ... No HAM with GENLOCK_VIDEO set. ! 910 ... No HAM with PFBA set. ! 911 ... No HAM with EXTRA-HALFBRITE set. ! 912 ... No HAM with GENLOCK_AUDIO set. ! 913 ... No HAM with DUALPF set. ! 914 ... No HAM with VP_HIDE set. ! 915 ... No HAM while in HIRES. ! 916 ... Need SET MODE LOW32 or LACELOW32 for HAM. ! 917 ... Not enough memory for HAM. ! 918 ... Error invoking C___HAM_ON. ! You may be trying to invoke C___HAM_ON without first ! declaring it as a function. ! ======================================================================= SUB HAM_ON LIBRARY "C___HAM_ON*" DECLARE FUNCTION C___HAM_ON WINDOW #0 ! CLEAR SELECT CASE C___HAM_ON CASE 1 CASE 2 CAUSE EXCEPTION 909, "No HAM with GENLOCK_VIDEO set." CASE 3 CAUSE EXCEPTION 910, "No HAM with PFBA set." CASE 4 CAUSE EXCEPTION 911, "No HAM while in EXTRA_HALFBRITE." CASE 5 CAUSE EXCEPTION 912, "No HAM with GENLOCK_AUDIO set." CASE 6 CAUSE EXCEPTION 913, "No HAM with DUALPF set." CASE 7 ! HAM is already turned on. CASE 8 CAUSE EXCEPTION 914, "No HAM with VP_HIDE set." CASE 9 CAUSE EXCEPTION 915, "No HAM while in HIRES." CASE 10 CAUSE EXCEPTION 916, "Need SET MODE LOW32 or LACELOW32 for HAM." CASE 11 CAUSE EXCEPTION 917, "Not enough memory for HAM." CASE ELSE CAUSE EXCEPTION 918, "Error in HAM_ON SUBROUTINE." END SELECT END SUB ! End of HAM_ON !======================================================================== ! SUBROUTINE: EHB_ON !======================================================================== ! ! PURPOSE: To turn on EHB mode. ! ! This routine invokes C___EHB_ON() which makes the required system ! adjustments. ! ! ! SCOPE: PUBLIC ! ! ! TEMPLATE: ! ! CALL EHB_ON ! ! ! ROUTINES INVOKED: C___EHB_ON ! ! ! NOTES: ! ! If you invoke this routine while EHB is already in effect, ! nothing happens. However, if you want your program to be warned ! of that condition, simply add a CAUSE EXCEPTION instruction ! to the appropiate branch of the SELECT CASE below. ! ! I chose to not support some modes because I do not know whether EHB ! is legal in them. If you want to try these out you will have to ! appropiately modify and re-compile the C___EHB_ON routine, which is ! written in C. ! ! ! EXCEPTIONS: ! ! 919 .... No EHB with GENLOCK_VIDEO set. ! 920 .... No EHB with PFBA set. ! 921 .... No EHB with GENLOCK_AUDIO set. ! 922 .... No EHB with DUALPF set. ! 923 .... No EHB while in HAM. ! 924 .... No EHB with VP_HIDE set. ! 925 .... No EHB while in HIRES. ! 926 .... Need SET MODE LOW32 or LACELOW32 for EHB. ! 927 .... Not enough memory for EHB. ! 928 .... Error invoking C___EHB_ON. ! You may be trying to invoke C___EHB_ON without first ! declaring it as a function. ! ======================================================================= SUB EHB_ON LIBRARY "C___EHB_ON*" DECLARE FUNCTION C___EHB_ON WINDOW #0 ! Make sure you're dealing with the full screen CLEAR SELECT CASE C___EHB_ON CASE 1 ! Success, EHB is now on CASE 2 CAUSE EXCEPTION 919, "No EHB with GENLOCK_VIDEO set." CASE 3 CAUSE EXCEPTION 920, "No EHB with PFBA set." CASE 4 ! EHB is already turned on CASE 5 CAUSE EXCEPTION 921, "No EHB with GENLOCK_AUDIO set." CASE 6 CAUSE EXCEPTION 922, "No EHB with DUALPF set." CASE 7 CAUSE EXCEPTION 923, "No EHB while in HAM." CASE 8 CAUSE EXCEPTION 924, "No EHB with VP_HIDE set." CASE 9 CAUSE EXCEPTION 925, "No EHB while in HIRES." CASE 10 CAUSE EXCEPTION 926, "Need SET MODE LOW32 or LACELOW32 for EHB." CASE 11 CAUSE EXCEPTION 927, "Not enough memory for EHB." CASE ELSE CAUSE EXCEPTION 928, "Error invoking EHB_ON." END SELECT END SUB ! End of EHB_ON !======================================================================== ! FUNCTION: Ask_If_EHB$ !======================================================================== ! ! PURPOSE: To report whether Extra-Half-Brite view mode is in effect. ! ! This routine invokes C___AskIfEHB() which obtains the required ! information from system structures. ! ! ! SCOPE: PUBLIC ! ! ! RETURN VALUE: the string "YES" or "NO" ! ! ! TEMPLATE: ! ! DECLARE FUNCTION Ask_If_EHB$ ! ! SELECT CASE Ask_If_EHB$ ! ! CASE "YES" ! ... ! ! CASE "NO" ! ... ! ! CASE ELSE ! ... ERROR. You may be trying to use Ask_If_EHB$ without ! first declaring it as a function. ! ! END SELECT ! ! ! ROUTINES INVOKED: Ask_ViewMode$ ! ! ! NOTES: True BASIC's UnPackB performs the required bit-wise test. ! ======================================================================= FUNCTION Ask_If_EHB$ DECLARE FUNCTION Ask_ViewMode$ IF UnPackB(Ask_ViewMode$,EXTRA_HALFBRITE,1) = 1 THEN LET Ask_If_EHB$ = "YES" ELSE LET Ask_If_EHB$ = "NO" END IF END FUNCTION ! End of Ask_If_EHB$ ! ======================================================================= ! FUNCTION Ask_If_HAM$ ! ======================================================================= ! ! PURPOSE: To report whether Hold-And-Modify view mode is in effect. ! ! This routine tests if the HAM bit is set for the current screen ! ! ! SCOPE: PUBLIC ! ! ! RETURN VALUE: "YES" or "NO" ! ! ! ROUTINES INVOKED: Ask_ViewMode$ ! ! ! TEMPLATE: ! ! DECLARE FUNCTION Ask_If_HAM$ ! ! SELECT CASE Ask_If_HAM$ ! ! CASE "YES" ! ... ! ! CASE "NO" ! ... ! ! CASE ELSE ! ... ERROR. You may be trying to use Ask_If_HAM$ without ! first declaring it as a function. ! ! END SELECT ! ! ! ROUTINES INVOKED: Ask_ViewMode$ ! ! ! NOTES: True BASIC's UnPackB performs the required bit-wise test. ! ======================================================================= FUNCTION Ask_If_HAM$ DECLARE FUNCTION Ask_ViewMode$ IF UnPackB(Ask_ViewMode$,HAM,1) = 1 THEN LET Ask_If_HAM$ = "YES" ELSE LET Ask_If_HAM$ = "NO" END IF END FUNCTION ! End of Ask_If_HAM$ ! ======================================================================= ! SUBROUTINE MODE_OFF ! ======================================================================= ! ! PURPOSE: To remove either HAM or EHB view modes ! ! ! SCOPE: PUBLIC ! ! ! ROUTINES INVOKED: EHB_OFF ! HAM_OFF ! ! ! TEMPLATE: ! ! CALL MODE_OFF ! ! ! EXCEPTIONS: ! ! 929 ... Error invoking Ask_If_HAM$. ! 930 ... Error invoking Ask_If_EHB$. ! ======================================================================= SUB MODE_OFF DECLARE FUNCTION Ask_If_EHB$, Ask_If_HAM$ SELECT CASE Ask_If_HAM$ CASE "YES" CALL HAM_OFF CASE "NO" CASE ELSE CAUSE EXCEPTION 929, "Error invoking Ask_If_HAM$." END SELECT SELECT CASE Ask_If_EHB$ CASE "YES" CALL EHB_OFF CASE "NO" CASE ELSE CAUSE EXCEPTION 930, "Error invoking Ask_If_EHB$." END SELECT END SUB ! End of MODE_OFF ! ======================================================================= ! SUBROUTINE Save_SYS_Colors ! ======================================================================= ! ! PURPOSE: To temporarily and conveniently save you current color ! color definitions. ! ! ! SCOPE: PUBLIC ! ! ! SHARED VARIABLES: SYSColors(,) ! ! ! ! TEMPLATE: ! ! CALL Save_SYS_Colors ! ! ! NOTES: ! ! If the current mode is HAM only 15 registers are saved. Yup, that's ! it. The rest are pseudo-registers. See the explanation in the ! operational docs for the HAM_ON subroutine. For all other modes ! the ASK MAX COLOR instructions is used to determine the number of ! colors to be saved. ! ! The number of colors saved is stored in element (0,1) of the ! SYSColors() array. The actual color information starts at ! element number 1. For example, the first register, which in the ! Amiga is register #0, is stored in array elements (1,1), (1,2), and ! (1,3). ! ! EXCEPTIONS: ! ! 931 ... Error invoking Ask_If_HAM$. ! ======================================================================= SUB Save_SYS_Colors DECLARE FUNCTION Ask_If_HAM$ SELECT CASE Ask_If_HAM$ CASE "YES" LET SYSColors(0,1) = 15 FOR I = 0 TO 15 ASK COLOR MIX(I) R, G, B LET SYSColors(I+1,1) = R LET SYSColors(I+1,2) = G LET SYSColors(I+1,3) = B NEXT I CASE "NO" ASK MAX COLOR MC LET SYSColors(0,1) = MC FOR I = 0 TO MC ASK COLOR MIX(I) R, G, B LET SYSColors(I+1,1) = R LET SYSColors(I+1,2) = G LET SYSColors(I+1,3) = B NEXT I CASE ELSE CAUSE EXCEPTION 931, "Error invoking Ask_If_HAM$." END SELECT END SUB ! End of Save_SYS_Colors ! ======================================================================= ! SUBROUTINE Restore_SYS_Colors ! ======================================================================= ! ! PURPOSE: To restore colors that have been previously saved using the ! Save_SYS_Colors subroutine. ! ! ! SCOPE: PUBLIC ! ! ! SHARED VARIABLES: SYSColors(,) ! ! ! ! TEMPLATE: ! ! CALL Restore_SYS_Colors ! ! ! NOTES: ! ! Routine restores the lessor of the current number of colors ! that are active in the current display, and the number of colors ! saved in the SYSColors() array. ! ! See above Save_SYS_Colors SUBROUTINE to see how the information ! is stored in the SYSColor() array. ! ! EXCEPTIONS: ! ! 932 ... Error invoking Ask_If_HAM$. ! ======================================================================= SUB Restore_SYS_Colors DECLARE FUNCTION Ask_If_HAM$ ASK MAX COLOR MC SELECT CASE Ask_If_HAM$ CASE "YES" LET MC = MIN(MC,15) FOR I = 0 TO MIN(SYSColors(0,1), MC) SET COLOR MIX(I) SYSColors(I+1,1), SYSColors(I+1,2), SYSColors(I+1,3) NEXT I CASE "NO" FOR I = 0 TO MIN(SYSColors(0,1), MC) SET COLOR MIX(I) SYSColors(I+1,1), SYSColors(I+1,2), SYSColors(I+1,3) NEXT I CASE ELSE CAUSE EXCEPTION 932, "Error invoking Ask_If_HAM$." END SELECT END SUB ! End of Restore_SYS_Colors ! ------------------------------ ! |\ /| ! | -------------------------- | ! | | PRIVATE ROUTINES FOLLOW | | ! | -------------------------- | ! |/ \| ! ------------------------------ ! ======================================================================= ! SUBROUTINE: Open_Communication ! ======================================================================= ! ! PURPOSE: To open a communication channel to the file name passed ! by the calling program unit. ! ! ! SCOPE: PRIVATE ! ! ! PARAMETERS: ! ! IN/OUT: #999 ... Channel number to file containing IFF image ! ! ! SHARED VARIABLES: ! ! FileName$ ! ! ! NOTES: ! ! To read and display an image from an IFF file you must parse ! the file on a byte-by-byte basis. For that reason you must ! ask True BASIC to open the file in BYTE format. ! ======================================================================= SUB Open_Communication(#999) OPEN #999: NAME FileName$, CREATE OLD, ACCESS INPUT, ORGANIZATION BYTE END SUB ! End of Open_Communication() ! ======================================================================= ! SUBROUTINE: Read_FORM ! ======================================================================= ! ! PURPOSE: To read the FORM chunk of the IFF file. FORM is the chunk ! within which all other chunks are placed. It contains ! the word FORM, the size of the IFF file in bytes, and ! finally the type ID, which for images is ILBM, for ! InterLeaved Bit Map. ! ! ! SCOPE: PRIVATE ! ! ! PARAMETERS: ! ! ! INPUT: #999 ... Channel number to file containing IFF image ! ! ! SHARED VARIABLES: ! ! ! OUTPUT: Form_Length ! ! ! NOTES: ! ! The first four bytes of the file must contain the word FORM ! The second four bytes is the length of the IFF file ! The last four bytes must contain the type name ILBM ! ! ! EXCEPTIONS: ! ! 933 ... File is not IFF. ! 934 ... File is not ILBM. ! 935 ... File is type LIST. ! 936 ... File is type CAT. ! ======================================================================= SUB Read_FORM(#999) ! ******************************* ! Read contents of the FORM chunk ! ******************************* READ #999, BYTES 12 : Buffer$ ! ******************************* ! Is there anything in this file? ! ******************************* IF LEN(Buffer$) < 12 THEN CLOSE #999 CAUSE EXCEPTION 933, "File is not IFF." END IF ! ***************************** ! Is this a FORM type IFF file? ! ***************************** IF Buffer$[1:4] = "FORM" THEN ! *************************************************** ! Get the length of the FORM for calling program unit ! *************************************************** LET FORM_Length = Unpackb(Buffer$[5:8], 1, 32) ! ************************************ ! Is this an interleaved bit map file? ! ************************************ IF Buffer$[9:12] <> "ILBM" THEN CLOSE #999 CAUSE EXCEPTION 934, "File is not ILBM." END IF ! ****************************** ! By default, this file is legal ! ****************************** ! ***************************** ! Is this a LIST type IFF file? ! ***************************** ELSEIF Buffer$[1:4] = "LIST" THEN CLOSE #999 CAUSE EXCEPTION 935, "File is type LIST." ! **************************** ! Is this a CAT type IFF file? ! **************************** ELSEIF Buffer$[1:3] = "CAT" THEN CLOSE #999 CAUSE EXCEPTION 936, "File is type CAT." ! ************************************** ! By default, this is not by an IFF file ! ************************************** ELSE CLOSE #999 CAUSE EXCEPTION 933, "File is not IFF." END IF END SUB ! End of Read_FORM() ! =================================================================== ! SUBROUTINE: Read_BMHD ! =================================================================== ! ! PURPOSE: To read and interpret the bit map header chunk, which contains ! information about the image saved in the IFF file. ! ! ! SCOPE: PRIVATE ! ! ! PARAMETERS: ! ! INPUT: #999 .... Channel number to file containing IFF image ! ! ! SHARED VARIABLES: ! ! OUTPUT: ! ! Width ............. Width of the image. ! Height ............ Height of the image. ! IFF_X ............. Horizontal pixel position. ! IFF_Y ............. Vertical pixel position. ! Depth ............. Depth of image, number of bitplanes. ! Masking ........... Masking flag, see note below. ! Comp .............. Compression algorithm used, if any. ! pad1 .............. Ignore this member ! transparentColor .. Used when Masking has a value of 2 to ! identify what color is supposed to be ! made transparent. ! xAspect ........... Used for porting image to a different raster ! yAspect ........... Used for porting image to a different raster ! pageWidth ......... Raster width that was in effect when this ! image was saved. ! pageHeight ........ Raster height that was in effect when this ! image was saved. ! ! ! NOTES: ! ! 1 - Each row of the image is stored in an integral number of ! 16 bit words. The number of words per row is: ! ! words = ((Hor_Pixels+15)/16) ! = Ceiling(Hor_Pixels/16) ! ! 2 - Masking: 0 = opaque rectangular image ! 1 = a mask plane is interleaved with the bitplanes ! in the BODY chunk ! 2 = pixels in the source planes matching TransparentColor ! are to be considered transparent. ! 3 = lassoing image allowed (MacPaint) ! ! EXCEPTIONS: ! ! 937 ... Bad BMHD chunk. ! =================================================================== SUB Read_BMHD(#999) ! ********************* ! Read the chunk length ! ********************* READ #999, BYTES 4: Buffer$ LET Chunk_Length = Unpackb(buffer$, 1, 32) ! ******************************** ! It must be exactly 20 bytes long ! ******************************** IF Chunk_Length <> 20 THEN CLOSE #999 CAUSE EXCEPTION 937, "Bad BMHD chunk." END IF ! ******************************* ! Read contents of the BMHD chunk ! ******************************* READ #999, BYTES 20: Buffer$ ! ************************************ ! Width of image rectangle in IFF file ! ************************************ LET Width = Unpackb(Buffer$[1:2], 1, 16) ! ************************************* ! Height of image rectangle in IFF file ! ************************************* LET Height = Unpackb(Buffer$[3:4], 1, 16) ! *************************************************************** ! Desired horizontal position of image within destination picture ! *************************************************************** LET IFF_X = Unpackb(Buffer$[5:6], 1, 16) ! ************************************************************* ! Desired vertical position of image within destination picture ! ************************************************************* LET IFF_Y = Unpackb(Buffer$[7:8], 1, 16) ! ******************************* ! Number of bitplanes in IFF file ! ******************************* LET Depth = Unpackb(Buffer$[9:9], 1, 8) ! **************** ! Mask in IFF file ! **************** LET Masking = Unpackb(Buffer$[10:10], 1, 8) ! *********** ! Compression ! *********** LET Comp = Unpackb(Buffer$[11:11], 1, 8) ! ***************************** ! For future use - must be zero ! ***************************** LET pad1 = Unpackb(buffer$[12:12], 1, 8) ! *********************************** ! Which bit pattern means transparent ! *********************************** LET transparentColor = Unpackb(Buffer$[13:14], 1, 16) ! ******************************************** ! Width for calculating a pixel's aspect ratio ! ******************************************** LET xAspect = Unpackb(Buffer$[15:15], 1, 8) ! ********************************************* ! Height for calculating a pixel's aspect ratio ! ********************************************* LET yAspect = Unpackb(Buffer$[16:16], 1, 8) ! ********************************************************** ! Width of original screen from which image was saved as IFF ! ********************************************************** LET pageWidth = Unpackb(Buffer$[17:18], 1, 16) ! *********************************************************** ! Height of original screen from which image was saved as IFF ! *********************************************************** LET pageHeight = Unpackb(Buffer$[19:20], 1, 16) END SUB ! End of Read_BMHD ! ======================================================================= ! SUBROUTINE: Read_CMAP ! ======================================================================= ! ! PURPOSE: To read and interpret CMAP chunk, which contains color map ! data ! ! ! SCOPE: PRIVATE ! ! ! PARAMETERS: ! ! INPUT: #999 .... Channel number to file containing IFF image ! ! ! SHARED VARIABLES: ! ! OUTPUT: IFFColors(,) ! ! ! NOTES: ! ! The color data is stored as triplets of red, breen, and blue ! intensity values, one byte per intensity. Each intensity is an ! integer from 0 to 255. Yup, that's 24 bit color. Unfortunately, ! the Amiga is only capable of 12 bit color, so the values in the ! file have to be converted. The number of color registers stored ! equals the number of bytes divided by three. ! ======================================================================= SUB Read_CMAP(#999) ! ********************* ! Read the chunk length ! ********************* READ #999, BYTES 4: Buffer$ LET Chunk_Length = Unpackb(buffer$, 1, 32) ! ******************************* ! Read contents of the CMAP chunk ! ******************************* READ #999, BYTES Chunk_Length: Kolor_data$ ! ********************************** ! Interpret colors from file only if ! calling program wants to use them ! ********************************** IF UCASE$(KolorFlag$) = "IFF" THEN ! ********************************************** ! Put color intensities in array in Point array. ! Intensities in file are in range 0 to 255. ! Calculate intensity range from 0 to 15, ! rounding to the nearest value. Do not load ! more than the Amiga can take. ! ********************************************** FOR I = 1 TO Min(Chunk_Length/3,32) LET IFFColors(i,1) = INT((UnPackB(Kolor_data$, 1+(i-1)*24, 8)+7)/16) LET IFFColors(i,2) = INT((UnPackB(Kolor_data$, 9+(i-1)*24, 8)+7)/16) LET IFFColors(i,3) = INT((UnPackB(Kolor_data$, 17+(i-1)*24, 8)+7)/16) NEXT I END IF ! *********************************************** ! Read the pad byte if there is one in this chunk ! *********************************************** IF MOD(Chunk_Length, 2) = 1 THEN READ #999, BYTES 1: Dummy$ END IF END SUB ! End of Read_CMAP ! ======================================================================= ! SUBROUTINE: Read_CAMG ! ======================================================================= ! ! PURPOSE: To rad CAMG chunk, which identifies information particular ! to the Commodore Amiga ! ! ! SCOPE: PRIVATE ! ! ! PARAMETERS: ! ! INPUT: #999 ... Channel number to file containing IFF image ! ! ! SHARED VARIABLES: ! ! OUTPUT: IFF_View_Mode$ ! ======================================================================= SUB Read_CAMG(#999) ! ********************* ! Read the chunk length ! ********************* READ #999, BYTES 4: Buffer$ LET Chunk_Length = Unpackb(buffer$, 1, 32) ! ******************************* ! Read contents of the CAMG chunk ! ******************************* READ #999, BYTES 4: buffer$ ! ***************************** ! Read view mode for this image ! ***************************** LET IFF_View_Mode$ = buffer$[3:4] END SUB ! End of Read_CAMG ! ======================================================================= ! SUBROUTINE: Read_CRNG ! ======================================================================= ! ! PURPOSE: To read past a CCRT chunk. This represents color cycling ! range and timing information and is used by Commodore's ! Graphicraft program. ! ! ! SCOPE: PRIVATE ! ! ! PARAMETERS: ! ! INPUT: #999 ... Channel number to file containing IFF image ! ! ! NOTES: Chunk is read but not processed ! ======================================================================= SUB Read_CCRT(#999) ! ********************* ! Read the chunk length ! ********************* READ #999, BYTES 4: Buffer$ LET Chunk_Length = Unpackb(Buffer$, 1, 32) ! ******************************* ! Read contents of the CCRT chunk ! ******************************* READ #999, BYTES Chunk_Length: Buffer$ END SUB ! Read_CCRT ! ======================================================================= ! SUBROUTINE: Read_CRNG ! ======================================================================= ! ! PURPOSE: To read past any CRNG chunks. These represent color register ! range information and us used by Deluxe Paint. ! ! ! SCOPE: PRIVATE ! ! ! PARAMETERS: ! ! INPUT: #999 ... Channel number to file containing IFF image ! ! ! NOTES: Chunk is read but not processed ! ======================================================================= SUB Read_CRNG(#999) ! ********************* ! Read the chunk length ! ********************* READ #999, BYTES 4: Buffer$ LET Chunk_Length = Unpackb(buffer$, 1, 32) ! ******************************* ! Read contents of the CRNG chunk ! ******************************* READ #999, BYTES Chunk_Length: Buffer$ ! *********************************************** ! Read the pad byte if there is one in this chunk ! *********************************************** IF MOD(Chunk_Length, 2) = 1 THEN READ #999, BYTES 1: Dummy$ END IF END SUB ! End of Read_CRNG ! ======================================================================= ! SUBROUTINE: Read_Unknown ! ======================================================================= ! ! PURPOSE: To read and discard any chunks that I don't yet know about ! ! ! SCOPE: PRIVATE ! ! ! PARAMETERS: ! ! INPUT: #999 ... Channel number to file containing IFF image ! ! ! NOTES: Chunk is read but not processed ! ======================================================================= SUB Read_Unknown(#999) ! ********************* ! Read the chunk length ! ********************* READ #999, BYTES 4: Buffer$ LET Chunk_Length = Unpackb(buffer$, 1, 32) ! *************************** ! Read contents of this chunk ! *************************** READ #999, BYTES Chunk_Length: Buffer$ ! *********************************************** ! Read the pad byte if there is one in this chunk ! *********************************************** IF MOD(Chunk_Length, 2) = 1 THEN READ #999, BYTES 1: Dummy$ END IF END SUB ! End of Read_Unknown ! ======================================================================= ! SUBROUTINE: Read_BODY ! ======================================================================= ! ! PURPOSE: To read the BODY chunk of the IFF file ! ! ! SCOPE: PRIVATE ! ! ! PARAMETERS: ! ! INPUT: ! ! #999 ... Channel number for disk file. ! ! ! SHARED VARIABLES: ! ! OUTPUT: Image_Data$ ! ! ! NOTES: This routine closes the file channel, which is no longer needed. ! ======================================================================= SUB Read_BODY(#999) ! ********************* ! Read the chunk length ! ********************* READ #999, BYTES 4: Buffer$ ! ************************************ ! Interpret the size of the BODY chunk ! ************************************ LET Chunk_Length = Unpackb(buffer$, 1, 32) ! *************************** ! Read contents of this chunk ! *************************** READ #999, BYTES Chunk_Length: Image_Data$ ! ****************************************** ! Channel to IFF file is not needed any more ! ****************************************** CLOSE #999 END SUB ! End of Read_BODY ! ======================================================================= ! SUBROUTINE: Change_Mode ! ======================================================================= ! ! PURPOSE: To switch graphic mode to whatever was in effect when ! the IFF image was created. ! ! ! SCOPE: PRIVATE ! ! ! SHARED VARIABLES: ! ! DUALPF ! LACE ! HAM ! EXTRA_HALFBRITE ! HIRES ! ! ! ROUTINES INVOKED: ! ! Ask_If_HAM$ ! Ask_If_EHB$ ! Ask_If_LACE$ ! ! ! EXCEPTIONS: ! ! 938 ... No dual playfield. ! 939 ... Unknown graphic mode. ! ======================================================================= SUB Change_Mode DECLARE FUNCTION Ask_If_HAM$, Ask_If_EHB$, Ask_If_LACE$ ! ********************************************* ! Was the image created in Dual Playfield mode? ! Test proper bit position in IFF_View_Mode$. ! This utility does not support dual playfield. ! ********************************************* IF UnPackB(IFF_View_Mode$,DUALPF,1) = 1 THEN CLOSE #999 CAUSE EXCEPTION 938, "No dual playfield." ! *************************************** ! Was the image created in HAM mode? ! Test proper bit position in IFF_View_Mode$. ! *************************************** ELSEIF UnPackB(IFF_View_Mode$,HAM,1) = 1 THEN ! ****************************************** ! If HAM mode is not in effect, switch to it ! ****************************************** IF Ask_If_HAM$ = "NO" THEN ! ****************************** ! Was the image created in LACE? ! ****************************** IF UnPackB(IFF_View_Mode$,LACE,1) = 1 THEN SET MODE "LACELOW32" ELSE SET MODE "LOW32" END IF CALL HAM_ON ! ***************************************** ! If HAM mode is already on, check for LACE ! ***************************************** ELSEIF Ask_If_HAM$ = "YES" THEN ! **************************************************** ! Make sure both screen and image are in the same mode ! **************************************************** IF UnPackB(IFF_View_Mode$,LACE,1) = 1 AND Ask_If_LACE$ = "NO" THEN CALL HAM_OFF SET MODE "LACELOW32" CALL HAM_ON ELSEIF UnPackB(IFF_View_Mode$,LACE,1) = 0 AND Ask_If_LACE$ = "YES" THEN CALL HAM_OFF SET MODE "LOW32" CALL HAM_ON END IF ELSE CLOSE #999 CAUSE EXCEPTION 939, "Unknown graphic mode." END IF ! ********************************************** ! Was the image created in Extra halfBrite mode? ! Test proper bit position in IFF_View_Mode$. ! ********************************************** ELSEIF UnPackB(IFF_View_Mode$,EXTRA_HALFBRITE,1) = 1 THEN ! ****************************************** ! If EHB mode is not in effect, switch to it ! ****************************************** IF Ask_If_EHB$ = "NO" THEN ! ****************************** ! Was the image created in LACE? ! ****************************** IF UnPackB(IFF_View_Mode$,LACE,1) = 1 THEN SET MODE "LACELOW32" ELSE SET MODE "LOW32" END IF CALL EHB_ON ELSEIF Ask_If_EHB$ = "YES" THEN ! **************************************************** ! Make sure both screen and image are in the same mode ! **************************************************** IF UnPackB(IFF_View_Mode$,LACE,1) = 1 AND Ask_If_LACE$ = "NO" THEN CALL EHB_OFF SET MODE "LACELOW32" CALL EHB_ON ELSEIF UnPackB(IFF_View_Mode$,LACE,1) = 0 AND Ask_If_LACE$ = "YES" THEN CALL EHB_OFF SET MODE "LOW32" CALL EHB_ON END IF ELSE CLOSE #999 CAUSE EXCEPTION 939, "Unknown graphic mode." END IF ! *************************************** ! Was the image created in HIRES? ! Test proper bit position in IFF_View_Mode$. ! *************************************** ELSEIF UnPackB(IFF_View_Mode$,HIRES,1) = 1 THEN ! ****************************** ! Was the image created in LACE? ! ****************************** IF UnPackB(IFF_View_Mode$,LACE,1) = 1 THEN SELECT CASE Depth CASE 1 SET MODE "LACEHIGH2" CASE 2 SET MODE "LACEHIGH4" CASE 3 SET MODE "LACEHIGH8" CASE 4 SET MODE "LACEHIGH16" CASE ELSE CLOSE #999 CAUSE EXCEPTION 939, "Unknown graphic mode." END SELECT ELSE SELECT CASE Depth CASE 1 SET MODE "HIGH2" CASE 2 SET MODE "HIGH4" CASE 3 SET MODE "HIGH8" CASE 4 SET MODE "HIGH16" CASE ELSE CLOSE #999 CAUSE EXCEPTION 939, "Unknown graphic mode." END SELECT END IF ELSE ! **************************** ! By default, image is low res ! **************************** ! ****************************** ! Was the image created in LACE? ! ****************************** IF UnPackB(IFF_View_Mode$,LACE,1) = 1 THEN SELECT CASE Depth CASE 1 SET MODE "LACELOW2" CASE 2 SET MODE "LACELOW4" CASE 3 SET MODE "LACELOW8" CASE 4 SET MODE "LACELOW16" CASE 5 SET MODE "LACELOW32" CASE ELSE CLOSE #999 CAUSE EXCEPTION 939, "Unknown graphic mode." END SELECT ELSE LET YPIXELS = 200 SELECT CASE Depth CASE 1 SET MODE "LOW2" CASE 2 SET MODE "LOW4" CASE 3 SET MODE "LOW8" CASE 4 SET MODE "LOW16" CASE 5 SET MODE "LOW32" CASE ELSE CLOSE #999 CAUSE EXCEPTION 939, "Unknown graphic mode." END SELECT END IF ! End of LACE or standard END IF ! End of HIRES or LOW END SUB ! End of Change_Mode ! ======================================================================= ! SUBROUTINE: Change_Colors ! ======================================================================= ! ! PURPOSE: To change current colors to those last read from an IFF ! image file. ! ! ! SCOPE: PRIVATE ! ! ! TEMPLATE: CALL Change_Colors ! ! ! ROUTINES INVOKED: Ask_If_HAM$ ! ! ! NOTES: Changes colors to those stored in SHARED array IFFColors(64,3) ! ! ======================================================================= SUB Change_Colors DECLARE FUNCTION Ask_If_HAM$ ! ************************************** ! Use number of colors in current raster ! ************************************** IF Ask_If_HAM$ = "YES" THEN LET Max_Kolor_Reg = 15 ELSE ASK MAX COLOR Max_Kolor_Reg END IF ! **************************** ! Use colors from the IFF file ! **************************** FOR I = 0 TO Max_Kolor_Reg SET COLOR MIX(I) IFFColors(i+1,1)/15,IFFColors(i+1,2)/15,IFFColors(i+1,3)/15 NEXT I END SUB ! End of Change_Colors ! ======================================================================= ! FUNCTION Ask_ViewMode$ ! ======================================================================= ! ! PURPOSE: To find out the current screen mode ! ! ! SCOPE: PRIVATE ! ! ! RETURN VALUE: The actual value of the Modes member of the current ! screen's ViewPort structure. ! ! TEMPLATE: ! ! DECLARE FUNCTION Ask_ViewMode$ ! ! LET Mode$ = Ask_ViewMode$ ! ! ! ROUTINES INVOKED: C___AskViewMode() ! ! ! OPERATION: In/OUT parameter of C___AskViewMode() must be initialize to ! a length of 16 bits. C___AskViewMode() returns the current ! ViewPort.Modes through that parameter. ! ! EXCEPTIONS: ! ! 940 ... Error invoking C___AskViewMode(). ! ======================================================================= FUNCTION Ask_ViewMode$ LIBRARY "C___AskViewMode*" DECLARE FUNCTION C___AskViewMode LET VMode$ = "" CALL PackB(VMode$,1,16,0) LET Error = C___AskViewMode(VMode$) IF Error <> 0 THEN CAUSE EXCEPTION 940, "Error invoking C___AskViewMode()." END IF LET Ask_ViewMode$ = VMode$ END FUNCTION ! End of Ask_ViewMode$ !======================================================================== ! SUBROUTINE: HAM_OFF !======================================================================== ! ! PURPOSE: To turn off HAM mode. ! ! This routine invokes C___HAM_OFF() which makes required ! adjustments to system structures. ! ! ! SCOPE: PRIVATE ! ! ! TEMPLATE: ! ! CALL HAM_OFF ! ! ! NOTES: ! ! If HAM is not in effect, nothing happens. However, if you want ! your program to be warned of that condition, simply add a CAUSE ! EXCEPTION instruction to the appropiate branch of the SELECT CASE ! below. ! ! ! EXCEPTIONS: ! ! 941 ... Error invoking C___HAM_OFF(). ! You may be trying to invoke C___HAM_OFF without first ! declaring it as a function. ! ======================================================================= SUB HAM_OFF LIBRARY "C___HAM_OFF*" DECLARE FUNCTION C___HAM_OFF WINDOW #0 ! Make sure you're dealing with the full screen CLEAR SELECT CASE C___HAM_OFF CASE 1 ! HAM successfully turned off CASE -1 ! HAM wasn't on CASE ELSE CAUSE EXCEPTION 941, "Error invoking C___HAM_OFF()." END SELECT END SUB ! End of HAM_OFF !======================================================================== ! SUBROUTINE: EHB_OFF !======================================================================== ! ! PURPOSE: To turn off Extra-Half-Brite mode. ! ! This routine invokes C___EHB_ON() which makes the required ! adjustments to system structures. ! ! ! SCOPE: PRIVATE ! ! ! TEMPLATE: ! ! CALL EHB_OFF ! ! ! NOTES: ! ! If EHB is not in effect, nothing happens. However, if you want ! your program to be warned of that condition, simply add a CAUSE ! EXCEPTION instruction to the appropiate branch of the SELECT CASE ! below. ! ! ! EXCEPTIONS: ! ! 942 ... Error invoking C___EHB_OFF(). ! You may be trying to invoke C___EHB_OFF without first ! declaring it as a function. ! ======================================================================= SUB EHB_OFF LIBRARY "C___EHB_OFF*" DECLARE FUNCTION C___EHB_OFF WINDOW #0 ! Make sure you're dealing with the full screen CLEAR SELECT CASE C___EHB_OFF CASE 1 ! EHB successfully turned off CASE -1 ! EHB wasn't on CASE ELSE CAUSE EXCEPTION 942, "Error invoking C___EHB_OFF()." END SELECT END SUB ! End of EHB_OFF END MODULE