home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HISOFT.LZH / HISOFT_A.MSA / HGT / IMAGE.BAS < prev    next >
BASIC Source File  |  1992-10-05  |  8KB  |  350 lines
  1.     library "bios"
  2. ' Palette reading changed 15.4.92
  3. ' Colour Degasde-cimpressed properly 18.5.92
  4. ' Fixes for 'odd' size IMG files 19.5.92
  5. ' NEO/Degas files for TT resolutions added 5.6.92
  6.  
  7. 'Image handling routines
  8. ' The structure of an image header
  9. CONST imh_vrsn=0,imh_hdlen=1,imh_nplanes=2,imh_patlen=3,imh_pixelw=4
  10. CONST imh_pixelh=5,imh_width=6,imh_height=7,imh_size=16
  11.  
  12. ' The MFDB structure
  13. CONST fd_addr=0,fd_w=2,fd_h=3,fd_wdwidth=4,fd_stand=5,fd_nplanes=6
  14. CONST fd_r1=7,fd_r2=8,fd_r3=9,fd_size=9
  15.  
  16. 'NEO chrome header
  17. CONST neo_ver=0,neo_mode=1,neo_palette=2,neo_size=128
  18.  
  19. 'DEGAS header
  20. CONST deg_mode=0,deg_palette=1,deg_size=34
  21.  
  22. SUB res_to_wh(BYVAL res,w,h)
  23. SELECT CASE res
  24. CASE 0 : w=320: h=200
  25. CASE 1 : w=640: h=200
  26. CASE 2 : w=640: h=400
  27. CASE 4 : w=1280 : h=960
  28. CASE 5 : w=640: h=480
  29. CASE 7 : w=320: h=480
  30. CASE ELSE: AbortProgram " Can't cope with this resolution NEO file"
  31. END SELECT
  32. END SUB
  33.  
  34.  
  35. SUB    vr_image_load(BYVAL addr&,BYVAL bytes)
  36. SHARED fx$,fx&
  37. blockmove SADD(fx$)+fx&,addr&,bytes
  38. fx&=fx&+bytes
  39. END SUB
  40.  
  41. FUNCTION vr_image_load_one
  42. SHARED fx$,fx&
  43. vr_image_load_one=PEEKB(SADD(fx$)+fx&)
  44. INCR fx&
  45. END FUNCTION
  46.  
  47. FUNCTION imglin(BYVAL dest&,BYVAL bytes,BYVAL patlen, patbuf(1))
  48. STATIC c,byte
  49.     DO WHILE bytes>0
  50.         c=vr_image_load_one
  51.         IF c=0 THEN
  52.             c=vr_image_load_one
  53.             IF c=0 THEN
  54.                 IF vr_image_load_one=255 THEN
  55.                     imglin=vr_image_load_one
  56.                     EXIT FUNCTION
  57.                 ELSE
  58.                     AbortProgram "unknown escape"
  59.                 END IF
  60.             ELSE
  61.                 vr_image_load VARPTR(patbuf(0)),patlen
  62.                 bytes=bytes-c*patlen
  63.                 DO WHILE c>0
  64.                     blockmove VARPTR(patbuf(0)),dest&,patlen
  65.                     dest&=dest&+patlen
  66.                     DECR c
  67.                 LOOP
  68.             END IF
  69.         ELSEIF c=128 THEN
  70.             c=vr_image_load_one
  71.             vr_image_load dest&,c
  72.             bytes=bytes-c
  73.             dest&=dest&+c
  74.         ELSE
  75.             IF c>128 THEN
  76.                 byte=255
  77.                 c=c-128
  78.             ELSE
  79.                 byte=0
  80.             END IF
  81.             bytes=bytes-c
  82.             WHILE c>0
  83.                 POKEB dest&,byte
  84.                 INCR dest&
  85.                 DECR c
  86.             WEND
  87.         END IF
  88.     LOOP
  89.     imglin=0
  90. END FUNCTION
  91.  
  92. SUB DegasLine(BYVAL dest&,BYVAL bytes)
  93. STATIC c,byte
  94.     DO WHILE bytes>0
  95.         c=vr_image_load_one
  96.         IF c<127 THEN
  97.             vr_image_load dest&,c+1: dest&=dest&+c+1
  98.             bytes=bytes-c-1
  99.         ELSEIF c>128 THEN
  100.             byte=vr_image_load_one
  101.             c=257-c
  102.             bytes=bytes-c
  103.             WHILE c>0
  104.                 POKEB dest&,byte
  105.                 INCR dest&
  106.                 DECR c
  107.             WEND
  108.         END IF
  109.     WEND
  110. END SUB
  111.  
  112.  
  113. CONST im_img=0,im_neo=1,im_degas=2
  114. SUB LoadImage(BYVAL index,BYVAL im_type,BYVAL header_size,BYVAL mode_offset, BYVAL palette_offset)
  115.  
  116. SHARED images(2),palettes(2),palettes_used,fx&,fxmax&
  117. STATIC rast&,patbuf(1),junk(1)
  118. STATIC sce_planes,pwidth,nlines,patlen,bytes
  119. STATIC plane_index&(1)
  120. STATIC rastlen&,sce_mode,dest_mode
  121. STATIC extra_header,rept,i,plane,dest&
  122. STATIC a$,c,dest_planes,destrast&
  123. STATIC monopic,compressed
  124. STATIC ms(1),md(1),hdr(1),x(1)
  125.  
  126.     REDIM ms(fd_size),md(fd_size),hdr(neo_size\2)
  127.  
  128.  
  129.     vr_image_load VARPTR(hdr(0)),header_size
  130.     IF palettes_used THEN palettes(index,0)=0    'ie. unused
  131.     monopic=0
  132.     dest_planes=PEEKW(SYSTAB)
  133.     SELECT CASE im_type
  134.     CASE im_img:
  135.         extra_header=hdr(imh_hdlen)*2-imh_size
  136.         IF extra_header>0 THEN
  137.             REDIM junk(extra_header\2)
  138.             vr_image_load VARPTR(junk(0)),extra_header
  139.             IF palettes_used THEN
  140.                 IF junk(0)= &h80THEN
  141.                     'HyperPaint hardware palette
  142.                     FOR i=1 TO 16
  143.                         palettes(index,i)=junk(i)
  144.                     NEXT i
  145.                     palettes(index,0)=-1    'i.e. used
  146.                 END IF
  147.             END IF
  148.             ERASE junk
  149.         END IF
  150.         nlines=hdr(imh_height)
  151.         pwidth=hdr(imh_width)
  152.         sce_planes=hdr(imh_nplanes)
  153.         ms(fd_stand)=1
  154.         patlen=hdr(imh_patlen)
  155.         IF dest_planes<>sce_planes OR sce_planes=1 THEN
  156.             IF sce_planes<>1 THEN
  157.                 AbortProgram "this image is designed for the wrong resolution"
  158.             END IF
  159.             monopic=1
  160.         END IF
  161.         compressed=-1
  162.         REDIM patbuf(patlen\2)
  163.     CASE im_neo,im_degas:
  164.         compressed=0
  165.         sce_mode=hdr(mode_offset)
  166.         IF sce_mode<0 THEN    
  167.             compressed=-1
  168.             sce_mode=sce_mode AND &h7FFF
  169.             ms(fd_stand)=1
  170.         END IF
  171.         res_to_wh sce_mode,pwidth,nlines
  172.         dest_mode=getrez
  173.         IF dest_mode<>sce_mode THEN
  174.             IF (sce_mode=2) OR (sce_mode=6) THEN
  175.                 'its mono
  176.                 monopic=1
  177.                 sce_planes=1
  178.                 ms(fd_stand)=1
  179.             ELSE
  180.                 AbortProgram "this image is designed for the wrong resolution"
  181.             END IF
  182.         ELSE
  183.             sce_planes=PEEKW(SYSTAB)
  184.             IF palettes_used THEN
  185.                 palettes(index,0)=-1    'i.e. used
  186.                 FOR i=1 TO 16
  187.                     palettes(index,i)=hdr(palette_offset+i-1)
  188.                 NEXT i
  189.             END IF
  190.         END IF
  191.     END SELECT
  192.  
  193.     ms(fd_w)=pwidth
  194.     ms(fd_h)=nlines
  195.     ms(fd_wdwidth)= (ms(fd_w)+15)>>4
  196.     ms(fd_nplanes)=sce_planes
  197.     
  198.  
  199.     FOR i=0 TO fd_size:    md(i)=ms(i): NEXT i
  200.  
  201.     md(fd_stand)=0
  202.     md(fd_nplanes)=dest_planes
  203.     
  204.     rastlen&=CLNG(ms(fd_wdwidth))*nlines*2
  205.     rast&=Malloc&(rastlen&*sce_planes)
  206.     IF rast&=0 THEN AbortProgram "out of memory - panic!"
  207.     POKEL VARPTR(ms(fd_addr)),rast&
  208.  
  209.     IF compressed OR monopic THEN
  210.         destrast&=Malloc&(rastlen&*dest_planes)    
  211.         IF destrast&=0 THEN AbortProgram "out of memory - panic!"
  212.     ELSE        destrast&=rast&
  213.     END IF
  214.     
  215.     POKEL VARPTR(md(fd_addr)),destrast&
  216.         
  217.     
  218.     REDIM plane_index&(sce_planes-1)
  219.     IF compressed THEN
  220.         FOR i=0 TO sce_planes-1
  221.             plane_index&(i)=rast&+rastlen&*i
  222.         NEXT i
  223.         bytes= (ms(fd_w)+7)>>3
  224.              WHILE nlines>0 AND (fx&<fxmax&)
  225.             rept=0
  226.             FOR plane=0 TO sce_planes-1
  227.                 dest&=plane_index&(plane)
  228.                 IF im_type=im_img THEN
  229.                     IF rept=0 THEN
  230.                         rept=imglin(dest&,bytes,patlen,patbuf())
  231.                     END IF
  232.                     IF rept THEN
  233.                         junk=imglin(dest&,bytes,patlen,patbuf())
  234.                     END IF
  235.                     dest&=dest&+ms(fd_wdwidth)*2
  236.                     FOR i=1 TO rept-1
  237.                         BLOCKMOVE plane_index&(plane),dest&,bytes
  238.                         dest&=dest&+ms(fd_wdwidth)*2
  239.                     NEXT i
  240.                 ELSE
  241.                     DegasLine dest&,bytes
  242.                     dest&=dest&+ms(fd_wdwidth)*2
  243.                 END IF    
  244.                 plane_index&(plane)=dest&
  245.             NEXT plane
  246.             IF rept THEN nlines=nlines-rept ELSE DECR nlines
  247.         WEND
  248.  
  249.  
  250.         FOR plane=0 TO sce_planes-1
  251.             dest&=plane_index&(plane)
  252.             WHILE nlines>0
  253.             ' clear out any junk at the end
  254.                 c=bytes
  255.                 WHILE c>0
  256.                     POKEB dest&,0
  257.                     INCR dest&
  258.                     DECR c
  259.                 WEND
  260.                 DECR nlines
  261.             WEND
  262.         NEXT plane
  263.     
  264.     ELSE
  265. ' not compressed
  266.  
  267.         vr_image_load rast&,rastlen&*sce_planes
  268.     END IF
  269.     
  270.     IF monopic OR compressed THEN
  271.         IF monopic THEN
  272.             REDIM x(7)
  273.             x(0)=0: x(1)=0: x(2)=ms(fd_w)-1: x(3)=ms(fd_h)-1
  274.             x(4)=0: x(5)=0: x(6)=x(2): x(7)=x(3)
  275.              vrt_cpyfm 1,x(),VARPTR(ms(0)),VARPTR(md(0)),1,0
  276.         ELSEIF compressed THEN
  277.             vr_trnfm VARPTR(ms(0)),VARPTR(md(0))
  278.         END IF
  279.         junk=Mfree(rast&)
  280.     END IF
  281.     FOR i=0 TO fd_size
  282.          images(index,i)=md(i)
  283.     NEXT i
  284.  
  285. END SUB
  286.  
  287.  
  288.  
  289. SUB LoadPicture(fname$,index)
  290. SHARED fxmax&,fx$,fx&,images_used
  291. STATIC fp,ext$
  292.     images_used=-1
  293.     fp=FREEFILE
  294.     IF NOT FEXISTS(fname$) THEN 
  295.         Debug "file not found": EXIT SUB
  296.     END IF
  297.     BusyBee 1
  298.  
  299.     OPEN fname$ FOR INPUT AS #fp
  300.     fxmax&=LOF(fp)
  301.     fx$=INPUT$(fxmax&,#fp)
  302.     fx&=0
  303.     CLOSE #fp
  304.  
  305.     ext$=UCASE$(MID$(fname$,LEN(fname$)-3,3))
  306.     SELECT CASE ext$
  307.     CASE ".PI",".PC": LoadImage index,im_degas,deg_size,deg_mode,deg_palette
  308.     CASE ".IM": LoadImage index,im_img,imh_size,0,0
  309.     CASE ".NE": LoadImage index,im_neo,neo_size,neo_mode,neo_palette
  310.     END SELECT
  311.     BusyBee 0
  312. END SUB
  313.  
  314. SUB DisplayImage(BYVAL index,BYVAL x,BYVAL y)
  315. STATIC i,local_mfdb(1),x(1),pal(1)
  316. SHARED images(2),mscr(1),palettes(2),palettes_used
  317.     REDIM local_mfdb(fd_size),mscr(fd_size),x(8),pal(15)
  318.     IF palettes_used THEN
  319.         IF palettes(index,0) THEN
  320.             FOR i=0 TO 15
  321.                 pal(i)=palettes(index,i+1)
  322.             NEXT i
  323.             setpalette pal()
  324.         END IF
  325.     END IF
  326.  
  327.     FOR i=0 TO fd_size:     local_mfdb(i)=images(index,i): NEXT i
  328.     x(0)=0: x(1)=0: x(2)=local_mfdb(fd_w)-1: x(3)=local_mfdb(fd_h)-1
  329.     x(4)=x: x(5)=y: x(6)=x(2)+x: x(7)=x(3)+y
  330.     vro_cpyfm 3,x(),VARPTR(local_mfdb(0)),VARPTR(mscr(0))
  331. END SUB
  332.  
  333. SUB CloseImage(BYVAL index)
  334. SHARED images(2)
  335. junk=Mfree(PEEKL(VARPTR(images(index,0))))
  336. POKEL VARPTR(images(index,0)),0 
  337. END SUB
  338.  
  339. SUB CloseAllImages
  340. SHARED images(2),images_used
  341. STATIC i
  342. IF images_used THEN
  343.     FOR i=LBOUND(images,1) TO UBOUND(images,1)
  344.         IF images(i,0)<>0 OR images(i,1)<>0 THEN
  345.             CloseImage i
  346.         END IF
  347.     NEXT i
  348. END IF
  349. END SUB
  350.