home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / ST_USER / 1989 / USER1289.MSA / LISTINGS_IMGPRINT.BAS < prev    next >
BASIC Source File  |  1989-09-28  |  3KB  |  176 lines
  1. REM Display an IMG file
  2. REM By R.A.Waddilove
  3. REM HiSoft Basic
  4. REM 2/4/89
  5.  
  6. LIBRARY "GEMAES"
  7. LIBRARY "XBIOS"
  8.  
  9. WINDOW FULLW 2
  10. CLEARW 2
  11.  
  12. maxy&=2000 : 'assumes width=100 bytes
  13. buffer$=STRING$(100*maxy&+100,0)
  14. file$=FNfilename$
  15. OPEN "I",#1,file$,1
  16. version%=FNword
  17. header%=FNword
  18. planes%=FNword
  19. patlen%=FNword
  20. widthpix%=FNword
  21. heightpix%=FNword
  22. width%=FNword
  23. height%=FNword
  24. IF height%>maxy& THEN height%=maxy&
  25. CLOSE #1
  26.  
  27. OPEN "I",#1,file$,1
  28. FOR i%=1 TO header%*2
  29.     dummy$=INPUT$(1,#1)
  30. NEXT
  31.  
  32. buffer&=(SADD(buffer$)+1) AND &HFFFFFFFE
  33. y&=0:repcount%=0
  34. DO
  35.     dummy$=INKEY$
  36.     A&=buffer&+100*y&
  37.     F%=ASC(INPUT$(1,#1))
  38.     IF F%=0 THEN
  39.         F%=ASC(INPUT$(1,#1))
  40.         IF F% THEN CALL pattern_run ELSE dummy$=INPUT$(1,#1):repcount%=ASC(INPUT$(1,#1))
  41.     ELSE
  42.         CALL scanline
  43.         IF repcount% THEN CALL copy:repcount%=0
  44.     END IF
  45. LOOP UNTIL y&>=height%
  46. CLOSE #1
  47. CALL display
  48. CALL picsave
  49. SYSTEM
  50.  
  51. SUB picsave
  52. SHARED file$
  53. alert$="[2][Save Degas picture][Yes|No]"
  54. MOUSE 0
  55. button%=FNform_alert%(1,alert$)
  56. MOUSE -1
  57. IF button%=2 THEN EXIT SUB
  58. screen&=FNlogbase&
  59. i%=INSTR(file$,".")
  60. file$=LEFT$(file$,i%)+"PI3"
  61. OPEN "R",#1,file$,1
  62. FIELD #1,1 AS pad$
  63. LSET pad$=CHR$(0) : PUT #1
  64. LSET pad$=CHR$(2) : PUT #1
  65. LSET pad$=CHR$(7) : PUT #1
  66. LSET pad$=CHR$(119) : PUT #1
  67. FOR i&=4 to 33
  68.     LSET pad$=CHR$(0) : PUT #1
  69. NEXT
  70. FOR i&=screen& TO screen&+31999
  71.     LSET pad$=CHR$(PEEKB(i&)) : PUT #1
  72. NEXT
  73. CLOSE #1
  74. END SUB
  75.  
  76. SUB scanline
  77. SHARED x%,F%,width%,y&
  78. x%=0
  79. DO
  80.     IF F%=0 THEN CALL pattern_run
  81.     IF F%=&H80 THEN CALL bit_string
  82.     IF F%>0 AND F%<>&H80 THEN CALL solid_run
  83.     IF (x%<width%\8) THEN F%=ASC(INPUT$(1,#1))
  84. LOOP UNTIL x%>=(width%\8)
  85. INCR y&
  86. END SUB
  87.  
  88. SUB copy
  89. SHARED y&,repcount%,x%,A&,buffer&,height%
  90. DECR y&
  91. FOR I%=1 TO repcount%
  92.     FOR i&=A& TO A&+99
  93.         POKEB i&+100,PEEKB(i&)
  94.     NEXT
  95.     IF y&<height% THEN INCR y&
  96.     A&=buffer&+100*y&
  97. NEXT
  98. END SUB
  99.  
  100. SUB pattern_run
  101. SHARED A&,x%
  102. runlen%=ASC(INPUT$(1,#1))
  103. patbyte1%=ASC(INPUT$(1,#1))
  104. patbyte2%=ASC(INPUT$(1,#1))
  105. FOR i%=1 TO runlen%
  106.     POKEB A&+x%,patbyte1%
  107.     POKEB A&+x%+1,patbyte2%
  108.     x%=x%+2
  109. NEXT
  110. END SUB
  111.  
  112. SUB bit_string
  113. SHARED A&,x%
  114. runlen%=ASC(INPUT$(1,#1))
  115. FOR x%=x% TO x%+runlen%-1
  116.     byte%=ASC(INPUT$(1,#1))
  117.     POKEB A&+x%,byte%
  118. NEXT
  119. END SUB
  120.  
  121. SUB solid_run
  122. SHARED F%,A&,x%
  123. IF (F% AND &H80) THEN byte%=&HFF ELSE byte%=0
  124. count%=F% AND 127
  125. FOR x%=x% TO x%+count%-1
  126.     POKEB A&+x%,byte%
  127. NEXT
  128. END SUB
  129.  
  130. DEF FNword
  131. FNword=256*ASC(INPUT$(1,#1))+ASC(INPUT$(1,#1))
  132. END DEF
  133.  
  134. SUB display
  135. SHARED buffer&,height%,width%
  136. DIM code%(25)
  137. mcode&=VARPTR(code%(0))
  138. FOR i%=0 TO 43
  139.     READ byte$
  140.     POKEB mcode&+i%,VAL("&H"+byte$)
  141. NEXT
  142. y&=0:x&=0
  143. DO
  144.     buf&=buffer&+100*y&+x&
  145.     CALL LOC mcode&,buf&
  146.     key%=INP(2)
  147.     IF key%=200 AND (y&+392)<height% THEN y&=y&+8
  148.     IF key%=208 AND y&>0 THEN y&=y&-8
  149.     IF key%=205 AND x&>0 THEN x&=x&-2
  150.     IF key%=203 AND (x&+80)<(width%\8) THEN x&=x&+2
  151. LOOP UNTIL key%=115 OR key%=83
  152. END SUB
  153.  
  154. DATA "3F","3C","00","02","4E","4E"
  155. DATA "54","8F","22","40","20","6F"
  156. DATA "00","06","20","50","30","3C"
  157. DATA "01","8F","24","48","32","3C"
  158. DATA "00","13","22","DA","51","C9"
  159. DATA "FF","FC","D1","FC","00","00"
  160. DATA "00","64","51","C8","FF","EC"
  161. DATA "4E","75"
  162.  
  163. DEF FNfilename$
  164. MOUSE 0
  165. path$="A:\*.*"
  166. name$=""
  167. ok%=0
  168. fsel_input path$,name$,ok%
  169. WHILE right$(path$,1)<>"\"
  170.     path$=LEFT$(path$,LEN(path$)-1)
  171. WEND
  172. MOUSE -1
  173. CLEARW 2
  174. FNfilename$=path$+name$
  175. END DEF
  176.