Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
W
wolf3d
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Container registry
Model registry
Operate
Environments
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
GitLab community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Hugo Hörnquist
wolf3d
Commits
10e8d8bf
Commit
10e8d8bf
authored
6 years ago
by
Hugo Hörnquist
Browse files
Options
Downloads
Patches
Plain Diff
Further work on parsing graphics. Add huff->dot.
parent
df0c1790
Branches
Branches containing commit
No related tags found
No related merge requests found
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
parse-graphics.scm
+43
-26
43 additions, 26 deletions
parse-graphics.scm
with
43 additions
and
26 deletions
parse-graphics.scm
+
43
−
26
View file @
10e8d8bf
...
...
@@ -31,6 +31,7 @@
(
-
(
bytevector-length
bv
)
count
)))
;; taken from Common Lisp
(
define-syntax-rule
(
begin1
first
rest
...
)
(
let
((
return
first
))
rest
...
...
...
@@ -109,6 +110,22 @@
get-bytevector-all
#
:binary
#t
)))
(
define
(
huff-tree->graphviz
huff-tree
port
)
(
format
port
"digraph {~%"
)
(
let
loop
((
tree
huff-tree
)
(
path
""
))
(
let
((
name
(
gensym
)))
(
if
(
pair?
tree
)
(
let
((
child-0
(
loop
(
car
tree
)
(
string-append
path
"0"
)))
(
child-1
(
loop
(
cdr
tree
)
(
string-append
path
"1"
))))
(
format
port
"\"~a\" [label=\"\", color=gray];~%"
name
)
(
format
port
"\"~a\" -> \"~a\" [label=~a0];~%"
name
child-0
path
)
(
format
port
"\"~a\" -> \"~a\" [color=red, label=~a1];~%"
name
child-1
path
)
)
(
format
port
"\"~a\" [label=~a];"
name
tree
))
name
))
(
format
port
"}~%"
))
;; #ifdef THREE_BYTE_GR_STARTS
(
define
FILEPOSSIZE
3
)
...
...
@@ -223,6 +240,7 @@
(
chdir
"/home/hugo/wolf/full/"
)
;; read and build the huffman tree
;; ID_CA.C, 887
(
define
huff-tree
(
read-huff-file
"VGADICT.WL6"
))
...
...
@@ -232,7 +250,9 @@
;; read the table off offsets into the data
;; in VGAGRAPH.
(
define
chunk-table
;; TODO why not gr-starts?
;; ID_CA.C, 893
(
define
gr-starts
(
call-with-input-file
"VGAHEAD.WL6"
get-bytevector-all
#
:binary
#t
))
...
...
@@ -241,11 +261,31 @@
(
*
FILEPOSSIZE
(
1+
NUMCHUNKS
))
;; => 450
(
define
gr-file-pos
(
map
(
lambda
(
i
)
(
chunk-start
gr-starts
i
))
(
iota
(
-
(
/
(
bytevector-length
gr-starts
)
3
)
2
))))
;; open the actual graphics file
;; ID_CA.C, 915
(
define
gr-handle
(
open-input-file
"VGAGRAPH.WL6"
#
:binary
#t
))
;; seek to start of STRUCTPIC (usually 0)
(
seek
gr-handle
(
chunk-start
chunk-table
STRUCTPIC
)
SEEK_SET
)
(
define
structpic-size
(
u32vector-ref
(
get-bytevector-n
gr-handle
4
)
0
))
;; (seek gr-handle (chunk-start chunk-table STRUCTPIC) SEEK_SET)
(
seek
gr-handle
(
list-ref
gr-file-pos
STRUCTPIC
)
SEEK_SET
)
(
define
structpic-size
(
s32vector-ref
(
get-bytevector-n
gr-handle
4
)
0
))
(
define
chunk-compressed-length
(
-
(
list-ref
gr-file-pos
(
1+
STRUCTPIC
))
(
list-ref
gr-file-pos
STRUCTPIC
)
4
))
(
define
compressed-data
(
get-bytevector-n
gr-handle
chunk-compressed-length
))
(
define
dest-bv
(
make-bytevector
structpic-size
))
;; Huff-expand fails, it REALLY shouldn't
(
huffman-expand
compressed-data
dest-bv
huff-tree
)
;; @example
;; struct pictabletype {
...
...
@@ -296,26 +336,3 @@
;; this looks far from good
;; => (41 7192 -26214 7453 7709 4608 19753 7453 13086 2048 25856 23016 23016 11234 -8919 13056 11550 10537 28416 -26643 200 11752 41 -5502 5916 7453 0 12288 -7168 5916 7453 12303 19 41 10541 4937 10496 11520 18729 18761 18761 18761 -25088 0 6626 13056 2078 18729 2078 18729 -7650 10541 -13056 10541 -13056 10541 -13056 10541 -13056 10541 -13056 10541 -26861 10623 32617 41 24296 15 41 21992 21986 6626 1821 -26214 15 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 -5225 12303 41 -26769 4075 10544 28416 16279 5916 32663 48 -25639 25615 25615 18703 9472 -8960 10745 2048 7680 7704 18703 22016 37 6174 6400 7465 205 10649 11550 41 11725 41 11725 41 11725 41 -26879 7231 -26857 12415 256 16279 5916 32663 48 -26879 7231 -26857 12415 256 16279 5916 32663 48 -26879 7231 23 -18135 19 41 10541 4937 10496 11520 18729 19 41 10541 4937 10496 11520 18729 19 41 10541 4937 10496 11520 18729 19 41 10541 4937 10496 11520 18729 19 41 10541 4937 10496 11520 18729 19 41 10541 4937 10496 16384 10623 24832 7465 31458 -5888 107 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
(
define-syntax-rule
(
comment
c
...
)
#f
)
(
comment
(
begin
(
sdl-init
)
(
define
w
(
make-window
))
(
define
r
(
make-renderer
w
))
(
let
((
x
0
)
(
y
0
))
(
for-each
(
lambda
(
c
)
(
apply
set-render-draw-color
r
c
)
(
render-draw-point
r
x
y
)
(
set!
x
(
1+
x
))
(
when
(
=
x
48
)
(
set!
x
0
)
(
set!
y
(
1+
y
))))
colors
)
(
format
#t
"~ax~a~%"
x
y
))
(
present-renderer
)
))
;; => #t
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment