-
Notifications
You must be signed in to change notification settings - Fork 2
/
IMG2ANS-25-NOICE.BAS
220 lines (203 loc) · 8.19 KB
/
IMG2ANS-25-NOICE.BAS
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
''
' IMG2ANS-25-NOICE
'
' Convert any QB64 supported image into ANSI block art
' (as long as the image is using EGA palette colors)
'
' This version will remove iCE colors.
'
' @author Rick Christy ([email protected])
' @link https://youtube.com/grymmjack
' @version 0.1.1
'
'$INCLUDE:'../../include/SAUCE/SAUCE.BI'
DIM AS LONG CANVAS, SRC_IMAGE
DIM AS INTEGER SRC_W, SRC_H, x, y, z, fz, bz
DIM AS STRING SRC_FILE, ans
CONST E = 27 ' ESCAPE - The ANSI escape code
CONST B = 219 '█ BLOCK CHARACTER - Full block foreground
CONST FT = 223 '▀ HALF BLOCK Top FG Bottom BG
CONST FB = 220 '▄ HALF BLOCK Top BG Bottom FG
' Maps RGB32 _UNSIGNED LONG colors (from POINT(x,y)) to ANSI Escape Color Codes
TYPE ANSI_MAP
RGBC AS _UNSIGNED LONG
FG_CODE AS STRING
BG_CODE AS STRING
END TYPE
DIM A(15) AS ANSI_MAP
' BLACK
A(0).FG_CODE$ = "0;30" : A(0).RGBC~& = &HFF000000 : A(0).BG_CODE$ = "40"
' BLUE
A(1).FG_CODE$ = "0;34" : A(1).RGBC~& = &HFF0000AA : A(1).BG_CODE$ = "44"
' GREEN
A(2).FG_CODE$ = "0;32" : A(2).RGBC~& = &HFF00AA00 : A(2).BG_CODE$ = "42"
' CYAN
A(3).FG_CODE$ = "0;36" : A(3).RGBC~& = &HFF00AAAA : A(3).BG_CODE$ = "46"
' RED
A(4).FG_CODE$ = "0;31" : A(4).RGBC~& = &HFFAA0000 : A(4).BG_CODE$ = "41"
' PURPLE
A(5).FG_CODE$ = "0;35" : A(5).RGBC~& = &HFFAA00AA : A(5).BG_CODE$ = "45"
' BROWN
A(6).FG_CODE$ = "0;33" : A(6).RGBC~& = &HFFAA5500 : A(6).BG_CODE$ = "43"
' WHITE
A(7).FG_CODE$ = "0;37" : A(7).RGBC~& = &HFFAAAAAA : A(7).BG_CODE$ = "47"
' BRIGHT BLACK
A(8).FG_CODE$ = "1;30" : A(8).RGBC~& = &HFF555555 : A(8).BG_CODE$ = "5;40"
' BRIGHT BLUE
A(9).FG_CODE$ = "1;34" : A(9).RGBC~& = &HFF5555FF : A(9).BG_CODE$ = "5;44"
' BRIGHT GREEN
A(10).FG_CODE$ = "1;32" : A(10).RGBC~& = &HFF55FF55 : A(10).BG_CODE$ = "5;42"
' BRIGHT CYAN
A(11).FG_CODE$ = "1;36" : A(11).RGBC~& = &HFF55FFFF : A(11).BG_CODE$ = "5;46"
' BRIGHT RED
A(12).FG_CODE$ = "1;31" : A(12).RGBC~& = &HFFFF5555 : A(12).BG_CODE$ = "5;41"
' BRIGHT PURPLE
A(13).FG_CODE$ = "1;35" : A(13).RGBC~& = &HFFFF55FF : A(13).BG_CODE$ = "5;45"
' BRIGHT YELLOW
A(14).FG_CODE$ = "1;33" : A(14).RGBC~& = &HFFFFFF55 : A(14).BG_CODE$ = "5;43"
' BRIGHT WHITE
A(15).FG_CODE$ = "1;37" : A(15).RGBC~& = &HFFFFFFFF : A(15).BG_CODE$ = "5;47"
' Choose an image file with dialog
SRC_FILE$ = _OPENFILEDIALOG$( _
"Choose an image", _
, _
"*.jpg|*.jpeg|*.png|*.tga|*.bmp|*.psd|*.gif|*.pcx|*.svg|*.qoi", _
"Image Files", _
-1 _
)
IF SRC_FILE$ = "" THEN SYSTEM ' image is required...
SRC_FILE$ = SRC_FILE$ + "|"
DIM AS INTEGER i, l, ch
DIM AS STRING filename, char
l% = LEN(SRC_FILE$)
FOR i%=0 TO l%
IF i%+1 <= l% THEN ' At end of file list, do nothing
ch% = ASC(SRC_FILE$, i%+1)
IF CHR$(ch%) = "|" THEN ' File found
' Load the image into the canvas at the same size
SRC_IMAGE& = _LOADIMAGE(filename$, 32)
SRC_W% = _WIDTH(SRC_IMAGE&) : SRC_H% = _HEIGHT(SRC_IMAGE&)
CANVAS& = _NEWIMAGE(SRC_W%, SRC_H%, 32)
SCREEN CANVAS&
_SOURCE SRC_IMAGE& : _DEST CANVAS&
_PUTIMAGE
' Parse the image into ansi color blocks
ans$ = ""
FOR y% = 0 TO SRC_H%
IF (y% = 0) OR (y% MOD 2 = 0) THEN ' do every other row
FOR x% = 0 TO SRC_W% - 1
char$ = CHR$(FT) ' default to top 1/2 block
DIM AS _UNSIGNED LONG TopColor, BottomColor
' Extract colors
TopColor~& = POINT(x%, y%) ' top pixel
IF y%+1 < SRC_H% THEN
BottomColor~& = POINT(x%, y%+1) ' pixel under
ELSE
BottomColor~& = _RGB32(0, 0, 0)
TopColor~& = _RGB32(0, 0, 0)
END IF
DIM AS STRING FG_CODE, BG_CODE
' Set defaults in case not found
FG_CODE$ = A(0).FG_CODE$
BG_CODE$ = A(0).BG_CODE$
FOR z% = 0 TO UBOUND(A) ' Get FG Color Code
IF TopColor~& = A(z%).RGBC~& THEN
FG_CODE$ = A(z%).FG_CODE$
fz% = z%
EXIT FOR
END IF
NEXT z%
FOR z% = 0 TO UBOUND(A) ' Get BG Color Code
IF BottomColor~& = A(z%).RGBC~& THEN
BG_CODE$ = A(z%).BG_CODE$
bz% = z%
EXIT FOR
END IF
NEXT z%
' Check if iCE colors needed if not, make non-iCE
DIM ice AS _UNSIGNED _BYTE
ice~%% = 1
IF bz% > 7 AND fz% < 8 THEN ' bg and fg can swap
FG_CODE$ = A(bz%).FG_CODE$
BG_CODE$ = A(fz%).BG_CODE$
char$ = CHR$(FB) ' use bottom 1/2 block (swap)
ice~%% = 0
END IF
IF bz% > 7 AND bz% = fz% THEN ' bg in range and same fg
BG_CODE$ = A(0).BG_CODE$
char$ = CHR$(B)
ice~%% = 0
END IF
IF fz% = bz% THEN ' bg same as fg use block on black bg
FG_CODE$ = A(fz%).FG_CODE$
BG_CODE$ = A(0).BG_CODE$
char$ = CHR$(B)
ice~%% = 0
END IF
IF ice~%% = 1 THEN ' if ice is STILL on, remove it
IF bz% >= 8 THEN bz% = bz% - 8
IF bz% < 0 THEN bz% = 0
BG_CODE$ = A(bz%).BG_CODE$
END IF
ans$ = ans$ _
+ CHR$(E) _
+ "[0m" _
+ CHR$(E) _
+ "[" _
+ FG_CODE$ _
+ ";" _
+ BG_CODE$ _
+ "m" _
+ char$
NEXT x%
END IF
NEXT y%
SCREEN 0
CLS
' Write the output.ans file
PRINT ans$
OPEN filename$ + "-25-NOICE.ans" FOR OUTPUT AS #1
PRINT #1, ans$
CLOSE #1
OPEN filename$ + "-25-NOICE.ans" FOR APPEND AS #1
PRINT #1, CHR$(&H1A) ' EOF
CLOSE #1
OPEN filename$ + "-25-NOICE.ans" FOR BINARY AS #1
SEEK #1, LOF(1)
SAUCE.InitPacket
SauceRecord.ID$ = "SAUCE"
SauceRecord.Version$ = "00"
DIM slash AS STRING
slash$ = "/" : IF _OS$ = "WINDOWS" THEN slash$ = "\"
s$ = MID$(filename$, _INSTRREV(filename$, slash$) + 1)
MID$(SauceRecord.Title$, 1, LEN(s$)) = s$
s$ = "grymmjack"
MID$(SauceRecord.Author$, 1, LEN(s$)) = s$
s$ = "MiSTiGRiS"
MID$(SauceRecord.Group$, 1, LEN(s$)) = s$
s$ = "20231231"
MID$(SauceRecord.Date$, 1, LEN(s$)) = s$
SauceRecord.FileSize~& = LOF(1)-1
SauceRecord.DataType~%% = 1
SauceRecord.FileType~%% = 1
SauceRecord.TInfo1~% = SRC_W%
SauceRecord.TInfo2~% = SRC_H% \ 2
SauceRecord.TInfo3~% = 0
SauceRecord.TInfo4~% = 0
SauceRecord.Comments~%% = 0
SauceRecord.TFlags~%% = 2 '8px iCE Color
s$ = "IBM VGA"
MID$(SauceRecord.TInfoS$, 1, LEN(s$)) = s$
SAUCE.FillPacket
PUT #1, LOF(1)-1, SauceRecord
CLOSE #1
filename$ = ""
ELSE ' Not at end of filename yet concat...
filename$ = filename$ + CHR$(ch%)
END IF
END IF
NEXT i%
' Clean up
_FREEIMAGE SRC_IMAGE&
_FREEIMAGE CANVAS&
'$INCLUDE:'../../include/SAUCE/SAUCE.BM'