-
Notifications
You must be signed in to change notification settings - Fork 0
/
RASVIEWX.BAS
150 lines (129 loc) · 3.88 KB
/
RASVIEWX.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
'Sun Rasterfile (.RAS) viewer for MODE-X by Dmitry Brant
'
'me@dmitrybrant.com
'http://dmitrybrant.com
'
'
'IMPORTANT: To run this program, you must start QuickBasic with the
'following command line:
'
'QB /L MODEX.QLB
'
'Freeware. Use freely.
'No warranty of any kind.
'Read disclaimer information at the above-mentioned web site.
'$INCLUDE: 'modex.bi' 'Must be in the same directory
DECLARE FUNCTION GetDword& (filenum%)
DECLARE FUNCTION PutRAS% (file$, x0%, y0%)
DEFINT A-Z
COMMON SHARED ScreenWidth, ScreenHeight
CLS
FILES "*.RAS": PRINT
INPUT "Enter a valid .RAS image file name: ", filename$
PRINT
PRINT "Select Mode-X Resolution:"
PRINT " 0: 320 x 200"
PRINT " 1: 320 x 400"
PRINT " 2: 360 x 200"
PRINT " 3: 360 x 400"
PRINT " 4: 320 x 240"
PRINT " 5: 320 x 480"
PRINT " 6: 360 x 240"
PRINT " 7: 360 x 480"
DO
r$ = INKEY$
SELECT CASE r$
CASE CHR$(27)
SYSTEM
CASE "0": ScreenWidth = 320: ScreenHeight = 200: EXIT DO
CASE "1": ScreenWidth = 320: ScreenHeight = 400: EXIT DO
CASE "2": ScreenWidth = 360: ScreenHeight = 200: EXIT DO
CASE "3": ScreenWidth = 360: ScreenHeight = 400: EXIT DO
CASE "4": ScreenWidth = 320: ScreenHeight = 240: EXIT DO
CASE "5": ScreenWidth = 320: ScreenHeight = 480: EXIT DO
CASE "6": ScreenWidth = 360: ScreenHeight = 240: EXIT DO
CASE "7": ScreenWidth = 360: ScreenHeight = 480: EXIT DO
END SELECT
LOOP
SCREEN 13
IF SetModeX(VAL(r$)) = 0 THEN PRINT "Unable to set Mode-X": SYSTEM
IF PutRAS(filename$, 0, 0) THEN SCREEN 0: WIDTH 80, 25: PRINT "Unable to display .RAS image.": SYSTEM
SLEEP
SCREEN 0: WIDTH 80, 25
SYSTEM
FUNCTION GetDword& (filenum)
a$ = " "
GET #filenum, , a$: d& = ASC(a$) * 16777216
GET #filenum, , a$: d& = d& + ASC(a$) * 65536
GET #filenum, , a$: d& = d& + ASC(a$) * 256
GET #filenum, , a$: d& = d& + ASC(a$)
GetDword& = d&
END FUNCTION
FUNCTION PutRAS (file$, x0, y0)
f = FREEFILE
OPEN file$ FOR BINARY AS #f
IF LOF(f) = 0 THEN CLOSE #f: KILL file$: PutRAS = 1: EXIT FUNCTION
a$ = " "
GET #f, , a$
IF a$ <> "Y¦j•" THEN CLOSE : PutRAS = 1: EXIT FUNCTION
wid = GetDword(f)
hgt = GetDword(f)
bpp = GetDword(f)
length& = GetDword(f)
typ& = GetDword(f)
maptype = GetDword(f)
maplen& = GetDword(f)
IF x0 >= ScreenWidth OR y0 >= ScreenHeight THEN CLOSE #f: EXIT FUNCTION
IF x0 + wid < 0 OR y0 + hgt < 0 THEN CLOSE #f: EXIT FUNCTION
a$ = " "
IF maptype > 0 THEN
OUT &H3C8, 0
FOR i = 0 TO 255
GET #f, , a$
SEEK #f, SEEK(f) + 255
OUT &H3C9, ASC(a$) \ 4
GET #f, , a$
SEEK #f, SEEK(f) + 255
OUT &H3C9, ASC(a$) \ 4
GET #f, , a$
SEEK #f, SEEK(f) - 512
OUT &H3C9, ASC(a$) \ 4
NEXT i
SEEK #f, SEEK(f) + 512
END IF
DEF SEG = &HA000
IF bpp = 8 THEN
IF wid MOD 2 THEN a$ = SPACE$(wid + 1) ELSE a$ = SPACE$(wid)
IF x0 + wid >= ScreenWidth THEN wid = ScreenWidth - x0
start = 0
IF x0 < 0 THEN wid = wid + x0: start = -x0: x0 = 0
xc = x0: yc = y0
DO UNTIL EOF(f) OR yc >= ScreenHeight OR yc > hgt + y0
GET #f, , a$
FOR i = 1 TO wid
IF yc >= 0 THEN SetPoint xc, yc, ASC(MID$(a$, i + start, 1))
xc = xc + 1
NEXT i
xc = x0
yc = yc + 1
LOOP
ELSEIF bpp = 1 THEN
xc = x0: yc = y0
a$ = " "
DO UNTIL EOF(f) OR yc >= ScreenHeight OR yc > hgt + y0
GET #f, , a$
d = ASC(a$)
FOR i = 7 TO 0 STEP -1
IF xc - x0 = wid - 1 AND wid MOD 2 THEN xc = x0: yc = yc + 1: EXIT FOR
IF xc > 0 AND yc > 0 AND xc < ScreenWidth THEN
IF d AND 2 ^ i THEN SetPoint xc, yc, 15 ELSE SetPoint xc, yc, 0
END IF
xc = xc + 1
IF xc - x0 > wid THEN xc = x0: yc = yc + 1: EXIT FOR
NEXT i
LOOP
END IF
DEF SEG
CLOSE #f
PutRAS = 0
END FUNCTION