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