home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 201.lha / tc (.txt) < prev    next >
AmigaBASIC Source Code  |  1988-12-27  |  6KB  |  308 lines
  1. CLEAR ,40000
  2. InitalizeParms:
  3.    OPEN "com1:300,N,8,1" AS 1
  4.    speak$ = TRANSLATE$ ("Welcome")
  5.    SAY (speak$)
  6.  
  7. Main:
  8.  
  9.  
  10.  
  11. DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
  12.  
  13. REM - Functions from dos.library                   
  14. DECLARE FUNCTION xOpen&  LIBRARY
  15. DECLARE FUNCTION xRead&  LIBRARY
  16. DECLARE FUNCTION xWrite& LIBRARY
  17. REM - xClose returns no value
  18.  
  19. REM - Functions from exec.library
  20. DECLARE FUNCTION AllocMem&() LIBRARY
  21. REM - FreeMem returns no value
  22.  
  23. PRINT:PRINT "Looking for bmaps ... ";
  24. LIBRARY "dos.library"
  25. LIBRARY "exec.library"
  26. LIBRARY "graphics.library"
  27. PRINT "found them."
  28.  
  29. ACBMname$="Title"
  30. IF (ACBMname$ = "") GOTO Mcleanup2
  31. PRINT
  32.  
  33. REM - Load the ACBM pic
  34. loadError$ = ""
  35. GOSUB LoadACBM
  36. IF loadError$ <> "" THEN GOTO Mcleanup
  37.  
  38. REM - Demo Graphicraft color cycling
  39. IF foundCCRT AND ccrtDir% THEN
  40.    REM - Save colors
  41.    FOR kk = 0 TO nColors% -1
  42.       cTabSave%(kk) = PEEKW(colorTab&+(kk*2))   
  43.       cTabWork%(kk) = cTabSave%(kk)
  44.    NEXT
  45.    
  46.    REM - Cycle colors
  47.    FOR kk = 0 TO 80
  48.       IF ccrtDir% = 1 THEN
  49.          GOSUB Fcycle
  50.       ELSE   
  51.          GOSUB Bcycle
  52.       END IF
  53.  
  54.       CALL LoadRGB4&(sViewPort&,VARPTR(cTabWork%(0)),nColors%)
  55.       REM - Delays approximated
  56.       FOR de1 = 0 TO ccrtSecs& * 3000
  57.          FOR de2 = 0 TO ccrtMics& / 500
  58.          NEXT
  59.       NEXT
  60.    NEXT
  61.  
  62.    REM - Restore colors
  63.    CALL LoadRGB4&(sViewPort&,VARPTR(cTabSave%(0)),nColors%)
  64. END IF
  65.  
  66. Mcleanup:
  67. FOR n = 1 TO 2000
  68. NEXT
  69.  
  70.  
  71. Mcleanup2:
  72. LIBRARY CLOSE
  73. IF loadError$ <> "" THEN PRINT loadError$
  74. CHAIN"loader"
  75. END
  76.  
  77.  
  78. Bcycle:  'Backward color cycle
  79. cTemp% = cTabWork%(ccrtEnd%)
  80. FOR jj = ccrtEnd%-1 TO ccrtStart% STEP -1
  81.    cTabWork%(jj+1) = cTabWork%(jj)
  82. NEXT
  83. cTabWork%(ccrtStart%) = cTemp%
  84. RETURN
  85.  
  86. Fcycle:  'Forward color cycle
  87. cTemp% = cTabWork%(ccrtStart%)
  88. FOR jj = ccrtStart%+1 TO ccrtEnd%
  89.    cTabWork%(jj-1) = cTabWork%(jj)
  90. NEXT
  91. cTabWork%(ccrtEnd%) = cTemp%
  92. RETURN
  93.  
  94.  
  95. LoadACBM:
  96. REM - Requires the following variables
  97. REM - to have been initialized:
  98. REM -    ACBMname$ (ACBM filespec)
  99.  
  100. REM - init variables
  101. f$ = ACBMname$
  102. fHandle& = 0
  103. mybuf& = 0
  104. foundBMHD = 0
  105. foundCMAP = 0
  106. foundCAMG = 0
  107. foundCCRT = 0
  108. foundABIT = 0
  109.  
  110. REM - From include/libraries/dos.h
  111. REM - MODE_NEWFILE = 1006 
  112. REM - MODE_OLDFILE = 1005
  113.  
  114. filename$ = f$ + CHR$(0)
  115. fHandle& = xOpen&(SADD(filename$),1005)
  116. IF fHandle& = 0 THEN
  117.    loadError$ = "Can't open/find pic file"
  118.    GOTO Lcleanup
  119. END IF
  120.  
  121.  
  122. REM - Alloc ram for work buffers
  123. ClearPublic& = 65537
  124. mybufsize& = 360
  125. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  126. IF mybuf& = 0 THEN
  127.    loadError$ = "Can't alloc buffer"
  128.    GOTO Lcleanup
  129. END IF
  130.  
  131. inbuf& = mybuf&
  132. cbuf& = mybuf& + 120
  133. ctab& = mybuf& + 240
  134.  
  135.  
  136. REM - Should read  FORMnnnnACBM
  137. rLen& = xRead&(fHandle&,inbuf&,12)
  138. tt$ = ""
  139. FOR kk = 8 TO 11
  140.    tt% = PEEK(inbuf& + kk)
  141.    tt$ = tt$ + CHR$(tt%)
  142. NEXT
  143.  
  144. IF tt$ <> "ACBM" THEN 
  145.    loadError$ = "Not an ACBM pic file"
  146.    GOTO Lcleanup
  147. END IF
  148.  
  149. REM - Read ACBM chunks
  150.  
  151. ChunkLoop:
  152. REM - Get Chunk name/length
  153.  rLen& = xRead&(fHandle&,inbuf&,8)
  154.  icLen& = PEEKL(inbuf& + 4)
  155.  tt$ = ""
  156.  FOR kk = 0 TO 3
  157.     tt% = PEEK(inbuf& + kk)
  158.     tt$ = tt$ + CHR$(tt%)
  159.  NEXT   
  160.     
  161. IF tt$ = "BMHD" THEN  'BitMap header 
  162.    foundBMHD = 1
  163.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  164.    iWidth%  = PEEKW(inbuf&)
  165.    iHeight% = PEEKW(inbuf& + 2)
  166.    iDepth%  = PEEK(inbuf& + 8)  
  167.    iCompr%  = PEEK(inbuf& + 10)
  168.    scrWidth%  = PEEKW(inbuf& + 16)
  169.    scrHeight% = PEEKW(inbuf& + 18)
  170.  
  171.    iRowBytes% = iWidth% /8
  172.    scrRowBytes% = scrWidth% / 8
  173.    nColors%  = 2^(iDepth%)
  174.  
  175.    REM - Enough free ram to display ?
  176.    AvailRam& = FRE(-1)
  177.    NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
  178.    IF AvailRam& < NeededRam& THEN
  179.       loadError$ = "Not enough free ram."
  180.       GOTO Lcleanup
  181.    END IF
  182.  
  183.    kk = 1
  184.    IF scrWidth% > 320 THEN kk = kk + 1
  185.    IF scrHeight% > 200  THEN kk = kk + 2
  186.    SCREEN 2,scrWidth%,scrHeight%,iDepth%,kk
  187.    WINDOW 3,"LoadACBM",,7,2
  188.  
  189.    REM - Get addresses of structures
  190.    GOSUB GetScrAddrs
  191.  
  192.    REM - Black out screen
  193.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  194.  
  195.  
  196. ELSEIF tt$ = "CMAP" THEN  'ColorMap
  197.    foundCMAP = 1
  198.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  199.  
  200.    REM - Build Color Table
  201.    FOR kk = 0 TO nColors% - 1
  202.       red% = PEEK(cbuf&+(kk*3))
  203.       gre% = PEEK(cbuf&+(kk*3)+1)
  204.       blu% = PEEK(cbuf&+(kk*3)+2)
  205.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  206.       POKEW(ctab&+(2*kk)),regTemp%
  207.    NEXT
  208.  
  209.  
  210. ELSEIF tt$ = "CAMG" THEN 'Amiga ViewPort Modes
  211.    foundCAMG = 1
  212.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  213.    camgModes& = PEEKL(inbuf&)
  214.  
  215.  
  216. ELSEIF tt$ = "CCRT" THEN 'Graphicraft color cycle info
  217.    foundCCRT = 1
  218.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  219.    ccrtDir%    = PEEKW(inbuf&)
  220.    ccrtStart%  = PEEK(inbuf& + 2)
  221.    ccrtEnd%    = PEEK(inbuf& + 3)
  222.    ccrtSecs&   = PEEKL(inbuf& + 4)
  223.    ccrtMics&   = PEEKL(inbuf& + 8)
  224.  
  225.  
  226. ELSEIF tt$ = "ABIT" THEN  'Contiguous BitMap 
  227.    foundABIT = 1
  228.  
  229.    REM - This only handles full size BitMaps, not brushes
  230.    REM - Very fast - reads in entire BitPlanes
  231.    plSize& = (scrWidth%/8) * scrHeight%
  232.    FOR pp = 0 TO iDepth% -1
  233.       rLen& = xRead&(fHandle&,bPlane&(pp),plSize&)   
  234.    NEXT
  235.  
  236.  
  237. ELSE 
  238.    REM - Reading unknown chunk  
  239.    FOR kk = 1 TO icLen&
  240.       rLen& = xRead&(fHandle&,inbuf&,1)
  241.    NEXT
  242.    REM - If odd length, read 1 more byte
  243.    IF (icLen& OR 1) = icLen& THEN 
  244.       rLen& = xRead&(fHandle&,inbuf&,1)
  245.    END IF
  246.       
  247. END IF
  248.  
  249.  
  250. REM - Done if got all chunks 
  251. IF foundBMHD AND foundCMAP AND foundABIT THEN
  252.    GOTO GoodLoad
  253. END IF
  254.  
  255. REM - Good read, get next chunk
  256. IF rLen& > 0 THEN GOTO ChunkLoop
  257.  
  258. IF rLen& < 0 THEN  'Read error
  259.    loadError$ = "Read error"
  260.    GOTO Lcleanup
  261. END IF   
  262.  
  263. REM - rLen& = 0 means EOF
  264. IF (foundBMHD=0) OR (foundABIT=0) OR (foundCMAP=0) THEN
  265.    loadError$ = "Needed ILBM chunks not found"
  266.    GOTO Lcleanup
  267. END IF
  268.  
  269.  
  270. GoodLoad:
  271. loadError$ =""
  272.  
  273. REM  Load proper Colors
  274. IF foundCMAP THEN 
  275.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  276. END IF
  277.  
  278. Lcleanup:
  279. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  280. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  281.  
  282. RETURN
  283.  
  284.  
  285. GetScrAddrs:
  286. REM - Get addresses of screen structures
  287.    sWindow&   = WINDOW(7)
  288.    sScreen&   = PEEKL(sWindow& + 46)
  289.    sViewPort& = sScreen& + 44
  290.    sRastPort& = sScreen& + 84
  291.    sColorMap& = PEEKL(sViewPort& + 4)
  292.    colorTab&  = PEEKL(sColorMap& + 4)
  293.    sBitMap&   = PEEKL(sRastPort& + 4)
  294.  
  295.    REM - Get screen parameters
  296.    scrWidth%  = PEEKW(sScreen& + 12)
  297.    scrHeight% = PEEKW(sScreen& + 14)
  298.    scrDepth%  = PEEK(sBitMap& + 5)
  299.    nColors%   = 2^scrDepth%
  300.  
  301.    REM - Get addresses of Bit Planes 
  302.    FOR kk = 0 TO scrDepth% - 1
  303.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  304.    NEXT
  305. RETURN
  306.  
  307.  
  308.