home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 058.lha / IFFtoPAT (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1986-11-20  |  8.6 KB  |  372 lines
  1. ConvertIFFtoPAT:
  2. REM ****
  3. REM ****  A PROGRAM TO CONVERT IFF FILES TO 'TRACER.PAT'-TYPE PATTERNS
  4. REM ****  COPYRIGHT (C) 1987,   ARTHUR E. BLUME
  5. REM ****
  6. Title:
  7. PRINT:PRINT TAB(17);:COLOR 3,2
  8. PRINT " *** RAY-TRACE CONVERSION PROGRAM *** ":COLOR 1,0:PRINT
  9. Instructions:
  10. PRINT "  This program converts IFF files to .PAT files suitable for
  11. PRINT "use with TRACER.ARC."
  12. PRINT "  See 'IFFtoPAT.doc' for more instructions.":PRINT
  13. Filenames:
  14. LINE INPUT "Input filename: ";ILBMname$
  15. LINE INPUT "Output filename <.PAT>: ";OUTPAT$
  16. IF UCASE$(RIGHT$(OUTPAT$,4))<>".PAT" THEN
  17.   OUTPAT$=OUTPAT$+".PAT":PRINT "<"OUTPAT$">"
  18. END IF
  19.  
  20. SetUpScreen:
  21. SCREEN 1,320,200,5,1
  22. WINDOW 2,,,16,1
  23. WINDOW OUTPUT 2
  24. FOR P=0 TO 15:PF=P/15:PALETTE P,PF,PF,PF:PALETTE P+16,PF,PF,PF:NEXT
  25.  
  26. PleaseWait:
  27. WINDOW 3,,(0,94)-(311,100),0,1:WINDOW OUTPUT 3:PALETTE 1,1,0,0
  28. IF LEN(ILBMname$)>15 THEN PF$=LEFT$(ILBMname$,12)+"..." :ELSE PF$=ILBMname$
  29. T$="Loading "+PF$+" ; please wait.":TS=(39-(23+LEN(PF$)))/2
  30. PRINT TAB(TS);:PRINT "Loading ";:COLOR 0,1:PRINT PF$;
  31. COLOR 1,0:PRINT " ; please wait.";
  32. FOR T=0 TO 10000:NEXT:WINDOW CLOSE 3
  33. WINDOW OUTPUT 2:PALETTE 1,0.066,0.066,0.066
  34. LoadFile:
  35. GOSUB PictureLoad
  36. IF loaderror$<>"" THEN STOP
  37.  
  38. UseMouse:
  39. WINDOW OUTPUT 2
  40. FOR P=0 TO 15:PF=P/15:PALETTE P,PF,PF,PF:PALETTE P+16,PF,PF,PF:NEXT
  41. WINDOW 3,,(0,94)-(311,106),0,1:WINDOW OUTPUT 3:PALETTE 1,1,0,0
  42. T$="Use mouse to select area for pattern.":PRINT TAB((39-LEN(T$))/2);T$
  43. T$="< Click mouse to continue >":PRINT TAB((39-LEN(T$))/2);T$;
  44. CM0:IF MOUSE(0)<>0 THEN CM0
  45. TM1:IF MOUSE(0)=0 THEN TM1
  46. WINDOW CLOSE 3:WINDOW OUTPUT 2:PALETTE 1,0.066,0.066,0.066
  47.  
  48. ScreenSelect:
  49. WINDOW OUTPUT 2
  50. InvertVideo:CALL SetDrMd&(WINDOW(8),3) ' inverse drawing
  51. CM1:IF MOUSE(0)<>0 THEN CM1
  52. PollMouse:
  53. M=MOUSE(0) ' poll mouse
  54. IF M>0 THEN X1=MOUSE(3):Y1=MOUSE(4):GOTO OtherCorner
  55. GOTO PollMouse
  56.  
  57. OtherCorner:
  58. CM2:IF MOUSE(0)<>0 THEN CM2
  59. ' find the other corner
  60. LastMX=0:LastMY=0 ' initialize coordinates
  61. StartFlag=1 ' flag to show if box has been drawn
  62. PollMouse2:
  63. M=MOUSE(0) ' poll mouse
  64. IF ABS(M)>0 THEN X2=MOUSE(3):Y2=MOUSE(4):GOTO SortOutCoordinates
  65. MX=MOUSE(1):MY=MOUSE(2) ' get mouse coordinates
  66. IF MX=LastMX AND MY=LastMY THEN PollMouse2 ' don't move box
  67. IF StartFlag=1 THEN StartFlag=0:GOTO DrawRect ' nothing to erase
  68. EraseRect:LINE (X1,Y1)-(LastMX,LastMY),1,B
  69. DrawRect:LINE (X1,Y1)-(MX,MY),1,B
  70. LastMX=MX:LastMY=MY
  71. GOTO PollMouse2 ' loop
  72.  
  73. SortOutCoordinates:
  74. IF X1>X2 THEN SWAP X1,X2
  75. IF Y1>Y2 THEN SWAP Y1,Y2
  76. EraseBox:LINE (X1,Y1)-(MX,MY),1,B
  77. GOTO SaveFile
  78.  
  79. SaveFile:
  80. CALL SetDrMd&(WINDOW(8),0) ' normal drawing
  81. LIBRARY CLOSE
  82. WINDOW OUTPUT 2
  83. OPEN "O",#1,OUTPAT$
  84. FOR Y=Y1 TO Y2
  85. L$="":FOR X=X1 TO X2
  86. P=POINT(X,Y):IF P>15 THEN P=P-16
  87. L$=L$+CHR$(64+P*4)
  88. NEXT
  89. PRINT #1,L$
  90. LINE (X1,Y)-(X2,Y),15
  91. NEXT
  92. CLOSE
  93.  
  94. SCREEN CLOSE 1
  95. WINDOW OUTPUT 1
  96. PRINT "Pattern saved: <"OUTPAT$"> ..."
  97. END
  98.  
  99. PictureLoad:
  100.  
  101. REM ***  LOADS AN .ILBM PICTURE INTO THE CURRENT WINDOW
  102. REM ***  FILENAME:  ILBMname$
  103.  
  104. REM -  LoadILBM-SaveACBM
  105. REM -  by Carolyn Scheppner  CBM  04/86
  106.  
  107. Main:
  108.  
  109. DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
  110.  
  111. REM - Functions from dos.library                   
  112. DECLARE FUNCTION xOpen&  LIBRARY
  113. DECLARE FUNCTION xRead&  LIBRARY
  114. DECLARE FUNCTION xWrite& LIBRARY
  115. DECLARE FUNCTION IoErr&  LIBRARY
  116. REM - xClose returns no value
  117.  
  118. REM - Functions from exec.library
  119. DECLARE FUNCTION AllocMem&() LIBRARY
  120. REM - FreeMem returns no value
  121.  
  122. LIBRARY "dos.library"
  123. LIBRARY "exec.library"
  124. LIBRARY "graphics.library"
  125.  
  126. REM - Load the IFF ILBM pic
  127. loaderror$ = ""
  128. GOSUB LoadILBM
  129. IF loaderror$ <> "" THEN GOTO Mcleanup
  130.  
  131. Mcleanup:
  132. WINDOW OUTPUT 1
  133.  
  134. Mcleanup2:
  135. PRINT loaderror$
  136. RETURN
  137. END
  138.  
  139. LoadILBM:
  140. REM - Requires the following variables
  141. REM - to have been initialized:
  142. REM -    ILBMname$ (IFF filename)
  143.  
  144. REM - init variables
  145. f$ = ILBMname$
  146. fHandle& = 0
  147. mybuf& = 0
  148. foundBMHD = 0
  149. foundCMAP = 0
  150. foundCAMG = 0
  151. foundCCRT = 0
  152. foundBODY = 0
  153.  
  154. REM - From include/libraries/dos.h
  155. REM - MODE_NEWFILE = 1006 
  156. REM - MODE_OLDFILE = 1005
  157.  
  158. filename$ = f$ + CHR$(0)
  159. fHandle& = xOpen&(SADD(filename$),1005)
  160. IF fHandle& = 0 THEN
  161.    loaderror$ = "Can't open/find pic file"
  162.    GOTO Lcleanup
  163. END IF
  164.  
  165. REM - Alloc ram for work buffers
  166. ClearPublic& = 65537
  167. mybufsize& = 360
  168. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  169. IF mybuf& = 0 THEN
  170.    loaderror$ = "Can't alloc buffer"
  171.    GOTO Lcleanup
  172. END IF
  173.  
  174. inbuf& = mybuf&
  175. cbuf& = mybuf& + 120
  176. ctab& = mybuf& + 240
  177.  
  178. REM - Should read  FORMnnnnILBM
  179. rLen& = xRead&(fHandle&,inbuf&,12)
  180. tt$ = ""
  181. FOR kk = 8 TO 11
  182.    tt% = PEEK(inbuf& + kk)
  183.    tt$ = tt$ + CHR$(tt%)
  184. NEXT
  185.  
  186. IF tt$ <> "ILBM" THEN 
  187.    loaderror$ = "Not standard ILBM pic file"
  188.    GOTO Lcleanup
  189. END IF
  190.  
  191. REM - Read ILBM chunks
  192.  
  193. ChunkLoop:
  194. REM - Get Chunk name/length
  195.  rLen& = xRead&(fHandle&,inbuf&,8)
  196.  icLen& = PEEKL(inbuf& + 4)
  197.  tt$ = ""
  198.  FOR kk = 0 TO 3
  199.     tt% = PEEK(inbuf& + kk)
  200.     tt$ = tt$ + CHR$(tt%)
  201.  NEXT   
  202.     
  203. IF tt$ = "BMHD" THEN  'BitMap header 
  204.    foundBMHD = 1
  205.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  206.    iWidth%  = PEEKW(inbuf&)
  207.    iHeight% = PEEKW(inbuf& + 2)
  208.    iDepth%  = PEEK(inbuf& + 8)  
  209.    iCompr%  = PEEK(inbuf& + 10)
  210.    scrWidth%  = PEEKW(inbuf& + 16)
  211.    scrHeight% = PEEKW(inbuf& + 18)
  212.  
  213.    iRowBytes% = iWidth% /8
  214.    scrRowBytes% = scrWidth% / 8
  215.    nColors%  = 2^(iDepth%)
  216.  
  217.    REM - Enough free ram to display ?
  218.    AvailRam& = FRE(-1)
  219.    NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
  220.    IF AvailRam& < NeededRam& THEN
  221.       loaderror$ = "Not enough free ram"
  222.       GOTO Lcleanup
  223.    END IF
  224.  
  225.    kk = 1
  226.    IF scrWidth% > 320 THEN kk = kk + 1
  227.    IF scrHeight% > 200  THEN kk = kk + 2
  228.    REM - Get addresses of structures
  229.    GOSUB GetScrAddrs
  230.  
  231.    REM - Black out screen
  232.    REM CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  233.  
  234.  
  235. ELSEIF tt$ = "CMAP" THEN  'ColorMap
  236.    foundCMAP = 1
  237.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  238.  
  239.    REM - Build Color Table
  240.    FOR kk = 0 TO nColors% - 1
  241.       red% = PEEK(cbuf&+(kk*3))
  242.       gre% = PEEK(cbuf&+(kk*3)+1)
  243.       blu% = PEEK(cbuf&+(kk*3)+2)
  244.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  245.       POKEW(ctab&+(2*kk)),regTemp%
  246.    NEXT
  247.  
  248. ELSEIF tt$ = "CAMG" THEN  'Amiga ViewPort Modes
  249.    foundCAMG = 1
  250.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  251.    camgModes& = PEEKL(inbuf&)
  252.  
  253. ELSEIF tt$ = "CCRT" THEN 'Graphicraft color cycle info
  254.    foundCCRT = 1
  255.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  256.    ccrtDir%    = PEEKW(inbuf&)
  257.    ccrtStart%  = PEEK(inbuf& + 2)
  258.    ccrtEnd%    = PEEK(inbuf& + 3)
  259.    ccrtSecs&   = PEEKL(inbuf& + 4)
  260.    ccrtMics&   = PEEKL(inbuf& + 8)
  261.  
  262. ELSEIF tt$ = "BODY" THEN  'BitMap 
  263.    foundBODY = 1
  264.   
  265.    IF iCompr% = 0 THEN  'no compression
  266.       FOR rr = 0 TO iHeight% -1
  267.          FOR pp = 0 TO iDepth% -1
  268.             scrRow& = bPlane&(pp)+(rr*scrRowBytes%)
  269.             rLen& = xRead&(fHandle&,scrRow&,iRowBytes%)   
  270.          NEXT
  271.       NEXT
  272.  
  273.    ELSEIF iCompr% = 1 THEN  'cmpByteRun1
  274.       FOR rr = 0 TO iHeight% -1
  275.          FOR pp = 0 TO iDepth% -1
  276.             scrRow& = bPlane&(pp)+(rr*scrRowBytes%)
  277.             bCnt% = 0
  278.             
  279.             WHILE (bCnt% < iRowBytes%)
  280.                rLen& = xRead&(fHandle&,inbuf&,1)
  281.                inCode% = PEEK(inbuf&)
  282.                IF inCode% < 128 THEN
  283.                   rLen& = xRead&(fHandle&,scrRow& + bCnt%, inCode%+1)
  284.                   bCnt% = bCnt% + inCode% + 1
  285.                ELSEIF inCode% > 128 THEN
  286.                   rLen& = xRead&(fHandle&,inbuf&,1)   
  287.                   inByte% = PEEK(inbuf&)
  288.                   FOR kk = bCnt% TO bCnt% + 257 - inCode%
  289.                      POKE(scrRow&+kk),inByte%
  290.                   NEXT   
  291.                   bCnt% = bCnt% + 257 - inCode%
  292.                END IF
  293.             WEND
  294.          NEXT
  295.       NEXT
  296.          
  297.    ELSE
  298.       loaderror$ = "Unknown compression algorithm"
  299.       GOTO Lcleanup
  300.    END IF
  301.  
  302. ELSE 
  303.    REM - Reading unknown chunk  
  304.    FOR kk = 1 TO icLen&
  305.       rLen& = xRead&(fHandle&,inbuf&,1)
  306.    NEXT
  307.    REM - If odd length, read 1 more byte
  308.    IF (icLen& OR 1) = icLen& THEN 
  309.       rLen& = xRead&(fHandle&,inbuf&,1)
  310.    END IF
  311.       
  312. END IF
  313.  
  314. REM - Done if got all chunks 
  315. IF foundBMHD AND foundCMAP AND foundBODY THEN
  316.    GOTO GoodLoad
  317. END IF
  318.  
  319. REM - Good read, get next chunk
  320. IF rLen& > 0 THEN GOTO ChunkLoop
  321.  
  322. IF rLen& < 0 THEN  'Read error
  323.    loaderror$ = "Read error"
  324.    GOTO Lcleanup
  325. END IF   
  326.  
  327. REM - rLen& = 0 means EOF
  328. IF (foundBMHD=0) OR (foundBODY=0) OR (foundCMAP=0) THEN
  329.    loaderror$ = "Needed ILBM chunks not found"
  330.    GOTO Lcleanup
  331. END IF
  332.  
  333. GoodLoad:
  334. loaderror$ = ""
  335.  
  336. REM  Load proper Colors
  337. IF foundCMAP THEN 
  338.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  339. END IF
  340.  
  341. Lcleanup:
  342. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  343. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  344.  
  345. RETURN
  346.  
  347.  
  348. GetScrAddrs:
  349. REM - Get addresses of screen structures
  350.    sWindow&   = WINDOW(7)
  351.    sScreen&   = PEEKL(sWindow& + 46)
  352.    sViewPort& = sScreen& + 44
  353.    sRastPort& = sScreen& + 84
  354.    sColorMap& = PEEKL(sViewPort& + 4)
  355.    colorTab&  = PEEKL(sColorMap& + 4)
  356.    sBitMap&   = PEEKL(sRastPort& + 4)
  357.  
  358.    REM - Get screen parameters
  359.    scrWidth%  = PEEKW(sScreen& + 12)
  360.    scrHeight% = PEEKW(sScreen& + 14)
  361.    scrDepth%  = PEEK(sBitMap& + 5)
  362.    nColors%   = 2^scrDepth%
  363.  
  364.    REM - Get addresses of Bit Planes 
  365.    FOR kk = 0 TO scrDepth% - 1
  366.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  367.    NEXT
  368. RETURN
  369.  
  370. END
  371.  
  372.